181 lines
3.2 KiB
Tal
181 lines
3.2 KiB
Tal
|
( uxncli tgachr.rom file.tga )
|
||
|
|
|
||
|
|
|10 @Console &vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1
|
||
|
|
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|
||
|
|
|
||
|
|
|0000
|
||
|
|
|
||
|
|
@src $40
|
||
|
|
|
||
|
|
|0100
|
||
|
|
|
||
|
|
@on-reset ( -> )
|
||
|
|
.Console/type DEI ?{
|
||
|
|
;dict/usage <perr>
|
||
|
|
#010f DEO
|
||
|
|
BRK }
|
||
|
|
;await-src .Console/vector DEO2
|
||
|
|
BRK
|
||
|
|
|
||
|
|
@await-src ( -> )
|
||
|
|
.Console/read DEI .src skey ?on-ready
|
||
|
|
BRK
|
||
|
|
|
||
|
|
@on-ready ( -> )
|
||
|
|
;src <pstr>
|
||
|
|
#0a18 DEO
|
||
|
|
#800f DEO
|
||
|
|
BRK
|
||
|
|
|
||
|
|
@<save> ( -- )
|
||
|
|
JMP2r
|
||
|
|
|
||
|
|
(
|
||
|
|
@|tga )
|
||
|
|
|
||
|
|
@<open-tga> ( name* -- )
|
||
|
|
.File/name DEO2
|
||
|
|
#0012 .File/length DEO2
|
||
|
|
;tga .File/read DEO2
|
||
|
|
( | update name )
|
||
|
|
;src ;dict/chr-ext OVR2 scap/ #0004 SUB2 <scpy>
|
||
|
|
( | flip endianness )
|
||
|
|
;tga/x STH2k LDA2 SWP STH2r STA2
|
||
|
|
;tga/y STH2k LDA2 SWP STH2r STA2
|
||
|
|
;tga/w STH2k LDA2 SWP STH2r STA2
|
||
|
|
;tga/h STH2k LDA2 SWP STH2r STA2
|
||
|
|
( | get parser )
|
||
|
|
;tga/image-type LDA
|
||
|
|
( ) DUP #02 EQU ?&rawt
|
||
|
|
( ) DUP #03 EQU ?&rawm
|
||
|
|
POP
|
||
|
|
( | error )
|
||
|
|
;&error-txt <pstr>/
|
||
|
|
#00 ;tga/image-type LDA DUP ADD ;tga-types ADD2 LDA2 <pstr>/
|
||
|
|
#0a18 DEO
|
||
|
|
JMP2r
|
||
|
|
&rawt ( type -- )
|
||
|
|
POP ;tga-rawt #0004 !parse-tga
|
||
|
|
&rawm ( type -- )
|
||
|
|
POP ;tga-rawm #0001 !parse-tga
|
||
|
|
&error-txt ( err )
|
||
|
|
"Unsupported 20 "image-type: 20 $1
|
||
|
|
|
||
|
|
@parse-tga ( filter* length* -- )
|
||
|
|
( | cache size )
|
||
|
|
.File/length DEO2
|
||
|
|
,&filter STR2
|
||
|
|
;tga/w LDA2 ,&w STR2
|
||
|
|
( | paint )
|
||
|
|
#0000 [ LIT2r 0000 ]
|
||
|
|
&stream ( -- )
|
||
|
|
;&pixel feof ?&end
|
||
|
|
STH2kr ;&pixel [ LIT2 &filter $2 ] JSR2 <set-pixel>
|
||
|
|
POP2 INC2 DUP2 [ LIT2 &w $2 ] NEQ2 ?&stream
|
||
|
|
( lb ) POP2 #0000 INC2r !&stream
|
||
|
|
&end POP2 POP2r !<save>
|
||
|
|
&pixel $4
|
||
|
|
|
||
|
|
@tga-types-txts &null "missing-type $1
|
||
|
|
&rawc "RAW-color $1
|
||
|
|
&rawt "RAW-true $1
|
||
|
|
&rawm "RAW-mono $1
|
||
|
|
&rlec "RLE-color $1
|
||
|
|
&rlet "RLE-true $1
|
||
|
|
&rlem "RLE-mono $1
|
||
|
|
&void "unknown-type $1
|
||
|
|
|
||
|
|
@tga-types [
|
||
|
|
=tga-types-txts/null =tga-types-txts/rawc
|
||
|
|
=tga-types-txts/rawt =tga-types-txts/rawm
|
||
|
|
=tga-types-txts/void =tga-types-txts/void
|
||
|
|
=tga-types-txts/void =tga-types-txts/void
|
||
|
|
=tga-types-txts/void =tga-types-txts/rlec
|
||
|
|
=tga-types-txts/rlet =tga-types-txts/rlem ]
|
||
|
|
|
||
|
|
(
|
||
|
|
@|filters )
|
||
|
|
|
||
|
|
@tga-rawt ( rgba* -- color )
|
||
|
|
STH2
|
||
|
|
( b ) #00 LDAkr STHr INC2r
|
||
|
|
( g ) #00 LDAkr STHr INC2r
|
||
|
|
( r ) #00 LDAr STHr
|
||
|
|
( res ) ADD2 ADD2 #0003 DIV2 NIP #06 SFT #03 SWP SUB JMP2r
|
||
|
|
|
||
|
|
@tga-rawm ( grey* -- color )
|
||
|
|
( res ) LDA #06 SFT JMP2r
|
||
|
|
|
||
|
|
(
|
||
|
|
@|stdlib )
|
||
|
|
|
||
|
|
@scap ( str* -- end* )
|
||
|
|
&w ( -- )
|
||
|
|
INC2 & LDAk ?&w
|
||
|
|
JMP2r
|
||
|
|
|
||
|
|
@<scpy> ( src* dst* -- )
|
||
|
|
STH2
|
||
|
|
&w ( -- )
|
||
|
|
LDAk #00 STH2kr STA2
|
||
|
|
INC2r INC2 LDAk ?&w
|
||
|
|
POP2 POP2r JMP2r
|
||
|
|
|
||
|
|
@sput ( chr str* -- )
|
||
|
|
scap ROT #00 SWP2 STA2
|
||
|
|
JMP2r
|
||
|
|
|
||
|
|
@skey ( key buf -- proc )
|
||
|
|
OVR #21 LTH ?&eval
|
||
|
|
#00 SWP sput #00 JMP2r
|
||
|
|
&eval POP2 #01 JMP2r
|
||
|
|
|
||
|
|
@feof ( buf* -- eof )
|
||
|
|
.File/read DEO2
|
||
|
|
.File/success DEI2 #0000 EQU2 JMP2r
|
||
|
|
|
||
|
|
@<pstr> ( str* -- )
|
||
|
|
&w ( -- )
|
||
|
|
LDAk #18 DEO
|
||
|
|
INC2 & LDAk ?&w
|
||
|
|
POP2 JMP2r
|
||
|
|
|
||
|
|
@<perr> ( str* -- )
|
||
|
|
&w ( -- )
|
||
|
|
LDAk #19 DEO
|
||
|
|
INC2 LDAk ?&w
|
||
|
|
POP2 JMP2r
|
||
|
|
|
||
|
|
@<emit-long> ( a* b* -> )
|
||
|
|
SWP2 <emit-long>/s
|
||
|
|
&s ( -- )
|
||
|
|
SWP <emit-long>/b
|
||
|
|
&b ( -- )
|
||
|
|
DUP #04 SFT <emit-long>/c
|
||
|
|
&c ( -- )
|
||
|
|
#0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
|
||
|
|
JMP2r
|
||
|
|
|
||
|
|
(
|
||
|
|
@|memory )
|
||
|
|
|
||
|
|
@dict &usage "usage: 20 "checksum.rom 20 "input.bin 0a $1
|
||
|
|
&icn-ext ".icn $1
|
||
|
|
&chr-ext ".chr $1
|
||
|
|
&tga-ext ".tga $1
|
||
|
|
|
||
|
|
@tga &id-length $1
|
||
|
|
&color-map $1
|
||
|
|
&image-type $1
|
||
|
|
&map $5
|
||
|
|
&position &x $2
|
||
|
|
&y $2
|
||
|
|
&size &w $2
|
||
|
|
&h $2
|
||
|
|
&depth $1
|
||
|
|
&descriptor $1
|
||
|
|
|
||
|
|
@pict
|
||
|
|
|
||
|
|
|