( uxncli tgachr.rom file.tga ) |00 @System &vector $2 &pad $6 &r $2 &g $2 &b $2 |10 @Console &vector $2 &read $1 &pad $5 &write $1 |20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 |80 @Controller &vector $2 &button $1 &key $1 |90 @Mouse &vector $2 &x $2 &y $2 &state $1 &chord $1 |a0 @File1 &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 |b0 @File2 &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 |0000 @src $40 @dst $40 @image &id-length $1 &color-map $1 &image-type $1 &map $5 &x $2 &y $2 &w $2 &h $2 &depth $1 &descriptor $1 |0100 @on-reset ( -> ) ( | theme ) #26ae .System/r DEO2 #26ae .System/g DEO2 #26ae .System/b DEO2 ( | size ) #0080 .Screen/width DEO2 #0100 .Screen/height DEO2 ( | wait ) ;await-src .Console/vector DEO2 BRK ( @|vectors ) @await-src ( -> ) .Console/read DEI .src skey ?on-ready BRK @on-ready ( -> ) ;src ;dst scpy ;&chr-ext ;dst scap scpy ;dst .File2/name DEO2 ;src ;dst / #0a18 DEO BRK &chr-ext ".chr $1 ( @|tga ) @ ( path* -- ) ( | header ) DUP2 .File1/name DEO2 #0012 .File1/length DEO2 ;image .File1/read DEO2 ( | flip endianness ) ;image/w STH2k LDA2 SWP STH2r STA2 ;image/h STH2k LDA2 SWP STH2r STA2 ( | resize ) ;image/w LDA2 #0040 ADD2 .Screen/width DEO2 ;image/h LDA2 #0040 ADD2 .Screen/height DEO2 ;image/w LDA2 #43 SFT2 .File2/length DEO2 ( | print details ) ;src-txt / [ LIT2 "( 18 ] DEO #00 ;image/image-type LDA #10 SFT ;image-types ADD2 LDA2 / [ LIT2 ") 18 ] DEO #0a18 DEO ( | get parser ) ;image/image-type LDA #02 NEQk NIP ?{ ;pixel-raw-true #0004 parse-tga POP JMP2r } #03 NEQk NIP ?{ ;pixel-raw-bw #0001 parse-tga POP JMP2r } ( | error ) ;&err #0a18 DEO JMP2r &err "Unsupported 20 "tga-type: 20 $1 @parse-tga ( filter* length* -- ) #0020 .Screen/x DEO2 #0020 .Screen/y DEO2 ;image/w LDA2 NIP #10 SFT #10 SUB #f0 AND #06 ORA .Screen/auto DEO .File1/length DEO2 ,&filter STR2 #0000 ,&x STR2 #0000 ,&y STR2 &stream ( -- ) ;&pixel STH2k .File1/read DEO2 [ LIT2 &x $2 ] [ LIT2 &y $2 ] #0007 AND2 STH2r [ LIT2 &filter $2 ] JSR2 ( chr ) set-pixel ( on linebreak ) ,&x LDR2 INC2 DUP2 ,&x STR2 ;image/w LDA2 NEQ2 ?&no-line #0000 ,&x STR2 ,&y LDR2 INC2 ,&y STR2 ( on row ) ,&y LDR2 #0007 AND2 ORA ?&no-row ;buffer DUP2 .Screen/addr DEO2 .File2/write DEO2 #81 .Screen/sprite DEO &no-row &no-line .File1/success DEI2 ORA ?&stream JMP2r &pixel $4 ( @|tools ) @set-pixel ( x* y* color -- ) STH OVR2 SWP2 ( | get addr ) DUP2 #0007 AND2 SWP2 #83 SFT2 ADD2 SWP2 #43 SFT2 ADD2 ;buffer ADD2 ( ch1 ) OVR2 OVR2 STHkr #00 toggle-pixel ( ch2 ) #0008 ADD2 STHr #01 toggle-pixel JMP2r @toggle-pixel ( x* addr* color -- ) STH2 LDAk STH SWP2 NIP STHr SWP STH2r SFT #01 AND ?{ ( mask ) #0107 ROT #07 AND SUB #40 SFT SFT #ff EOR AND ( save ) ROT ROT STA JMP2r } ( mask ) #0107 ROT #07 AND SUB #40 SFT SFT ORA ( save ) ROT ROT STA JMP2r @pixel-raw-true ( pixel* -- color ) LDAk ,&b STR INC2 LDAk ,&g STR INC2 LDAk ,&r STR INC2 LDA ,&a STR [ LIT2 00 &r $1 ] [ LIT2 00 &g $1 ] [ LIT2 00 &b $1 ] ADD2 ADD2 ( ) #0003 DIV2 NIP [ LIT &a $1 ] POP #06 SFT JMP2r @pixel-raw-bw ( pixel* -- color ) ( res ) LDA JMP2r ( @|stdlib ) @ ( str* -- ) &w ( -- ) LDAk #18 DEO INC2 & LDAk ?&w POP2 JMP2r @skey ( key buf -- proc ) OVR #21 LTH ?{ #00 SWP sput #00 JMP2r } POP2 #01 JMP2r @scap ( str* -- end* ) LDAk #00 NEQ [ JMP JMP2r ] &w ( -- ) INC2 LDAk ?&w JMP2r @sput ( chr str* -- ) scap STA JMP2r @slen ( str* -- len* ) DUP2 scap SWP2 SUB2 JMP2r @scpy ( src* dst* -- ) STH2 &w ( -- ) LDAk STH2kr STA INC2r INC2 LDAk ?&w POP2 #00 STH2r STA JMP2r ( @|assets ) @src-txt "Parsing 20 $1 @image-types-txts &no-image "no-data $1 &raw-color "RAW-color $1 &raw-true "RAW-true $1 &raw-bw "RAW-bw $1 &rle-color "RLE-color $1 &rle-true "RLE-true $1 &rle-bw "RLE-bw $1 &unknown "unknown $1 @image-types [ =image-types-txts/no-image =image-types-txts/raw-color =image-types-txts/raw-true =image-types-txts/raw-bw =image-types-txts/unknown =image-types-txts/unknown =image-types-txts/unknown =image-types-txts/unknown =image-types-txts/unknown =image-types-txts/rle-color =image-types-txts/rle-true =image-types-txts/rle-bw ] @buffer ( A row chr tiles for the width of the image )