Repurposing the oquonie machin
This commit is contained in:
neauoire
parent
750a30c685
commit
a80dfd2b04
|
|
@ -1,180 +1,233 @@
|
||||||
( uxncli tgachr.rom file.tga )
|
( uxncli tgachr.rom file.tga )
|
||||||
|
|
||||||
|10 @Console &vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1
|
|00 @System &vector $2 &pad $6 &r $2 &g $2 &b $2
|
||||||
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $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
|
|0000
|
||||||
|
|
||||||
@src $40
|
@src $40
|
||||||
|
@dst $40
|
||||||
|
|
||||||
|0100
|
@image
|
||||||
|
&id-length $1
|
||||||
|
&color-map $1
|
||||||
|
&image-type $1
|
||||||
|
&map $5
|
||||||
|
&x $2 &y $2
|
||||||
|
&w $2 &h $2
|
||||||
|
&depth $1
|
||||||
|
&descriptor $1
|
||||||
|
|
||||||
@on-reset ( -> )
|
|0100 @on-reset ( -> )
|
||||||
.Console/type DEI ?{
|
|
||||||
;dict/usage <perr>
|
( theme )
|
||||||
#010f DEO
|
#26ae .System/r DEO2
|
||||||
BRK }
|
#26ae .System/g DEO2
|
||||||
|
#26ae .System/b DEO2
|
||||||
|
( size )
|
||||||
|
#0080 .Screen/width DEO2
|
||||||
|
#0100 .Screen/height DEO2
|
||||||
|
( wait )
|
||||||
;await-src .Console/vector DEO2
|
;await-src .Console/vector DEO2
|
||||||
|
|
||||||
BRK
|
BRK
|
||||||
|
|
||||||
|
(
|
||||||
|
@|vectors )
|
||||||
|
|
||||||
@await-src ( -> )
|
@await-src ( -> )
|
||||||
.Console/read DEI .src skey ?on-ready
|
|
||||||
|
.Console/read DEI .src skey
|
||||||
|
?on-ready
|
||||||
|
|
||||||
BRK
|
BRK
|
||||||
|
|
||||||
@on-ready ( -> )
|
@on-ready ( -> )
|
||||||
;src <pstr>
|
|
||||||
#0a18 DEO
|
|
||||||
#800f DEO
|
|
||||||
BRK
|
|
||||||
|
|
||||||
@<save> ( -- )
|
;src ;dst scpy
|
||||||
JMP2r
|
;&chr-ext ;dst scap scpy
|
||||||
|
;dst .File2/name DEO2
|
||||||
|
;src file-open-tga
|
||||||
|
;dst pstr #0a18 DEO
|
||||||
|
|
||||||
|
BRK
|
||||||
|
&chr-ext ".chr $1
|
||||||
|
|
||||||
(
|
(
|
||||||
@|tga )
|
@|tga )
|
||||||
|
|
||||||
@<open-tga> ( name* -- )
|
@file-open-tga ( path* -- )
|
||||||
.File/name DEO2
|
|
||||||
#0012 .File/length DEO2
|
( header )
|
||||||
;tga .File/read DEO2
|
DUP2 .File1/name DEO2
|
||||||
( | update name )
|
#0012 .File1/length DEO2
|
||||||
;src ;dict/chr-ext OVR2 scap/ #0004 SUB2 <scpy>
|
;image .File1/read DEO2
|
||||||
( | flip endianness )
|
( flip endianness )
|
||||||
;tga/x STH2k LDA2 SWP STH2r STA2
|
;image/w STH2k LDA2 SWP STH2r STA2
|
||||||
;tga/y STH2k LDA2 SWP STH2r STA2
|
;image/h STH2k LDA2 SWP STH2r STA2
|
||||||
;tga/w STH2k LDA2 SWP STH2r STA2
|
|
||||||
;tga/h STH2k LDA2 SWP STH2r STA2
|
;image/w LDA2 #43 SFT2 .File2/length DEO2
|
||||||
( | get parser )
|
|
||||||
;tga/image-type LDA
|
( print details )
|
||||||
( ) DUP #02 EQU ?&rawt
|
;src-txt pstr
|
||||||
( ) DUP #03 EQU ?&rawm
|
pstr
|
||||||
POP
|
LIT "( #18 DEO #00
|
||||||
( | error )
|
;image/image-type LDA #10 SFT ;image-types ADD2 LDA2 pstr
|
||||||
;&error-txt <pstr>/
|
LIT ") #18 DEO #0a18 DEO
|
||||||
#00 ;tga/image-type LDA DUP ADD ;tga-types ADD2 LDA2 <pstr>/
|
|
||||||
#0a18 DEO
|
( get parser )
|
||||||
|
;image/image-type LDA
|
||||||
|
#02 NEQk NIP ?&no-raw-true
|
||||||
|
;pixel-raw-true #0004 parse-tga POP JMP2r
|
||||||
|
&no-raw-true
|
||||||
|
#03 NEQk NIP ?&no-raw-bw
|
||||||
|
;pixel-raw-bw #0001 parse-tga POP JMP2r
|
||||||
|
&no-raw-bw
|
||||||
|
|
||||||
|
( error )
|
||||||
|
;&err pstr #0a18 DEO
|
||||||
|
|
||||||
JMP2r
|
JMP2r
|
||||||
&rawt ( type -- )
|
&err "Unsupported 20 "tga-type: 20 $1
|
||||||
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* -- )
|
@parse-tga ( filter* length* -- )
|
||||||
( | cache size )
|
|
||||||
.File/length DEO2
|
#0020 .Screen/x DEO2
|
||||||
,&filter STR2
|
#0040 .Screen/y DEO2
|
||||||
;tga/w LDA2 ,&w STR2
|
#76 .Screen/auto DEO
|
||||||
( | paint )
|
|
||||||
#0000 [ LIT2r 0000 ]
|
.File1/length DEO2 ,&filter STR2
|
||||||
&stream ( -- )
|
#0000 ,&x STR2
|
||||||
;&pixel feof ?&end
|
#0000 ,&y STR2
|
||||||
STH2kr ;&pixel [ LIT2 &filter $2 ] JSR2 <set-pixel>
|
&stream
|
||||||
POP2 INC2 DUP2 [ LIT2 &w $2 ] NEQ2 ?&stream
|
;&pixel STH2k .File1/read DEO2
|
||||||
( lb ) POP2 #0000 INC2r !&stream
|
[ LIT2 &x $2 ] [ LIT2 &y $2 ] #0007 AND2
|
||||||
&end POP2 POP2r !<save>
|
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
|
&pixel $4
|
||||||
|
|
||||||
@tga-types-txts &null "missing-type $1
|
( tools )
|
||||||
&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 [
|
@set-pixel ( x* y* color -- )
|
||||||
=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 ]
|
|
||||||
|
|
||||||
(
|
STH
|
||||||
@|filters )
|
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 -- )
|
||||||
|
|
||||||
@tga-rawt ( rgba* -- color )
|
|
||||||
STH2
|
STH2
|
||||||
( b ) #00 LDAkr STHr INC2r
|
LDAk
|
||||||
( g ) #00 LDAkr STHr INC2r
|
STH SWP2 NIP
|
||||||
( r ) #00 LDAr STHr
|
STHr SWP
|
||||||
( res ) ADD2 ADD2 #0003 DIV2 NIP #06 SFT #03 SWP SUB JMP2r
|
STH2r SFT #01 AND ?&do-set
|
||||||
|
( mask ) #0107 ROT #07 AND SUB #40 SFT SFT #ff EOR AND
|
||||||
|
( save ) ROT ROT STA
|
||||||
|
JMP2r
|
||||||
|
&do-set
|
||||||
|
( mask ) #0107 ROT #07 AND SUB #40 SFT SFT ORA
|
||||||
|
( save ) ROT ROT STA
|
||||||
|
|
||||||
@tga-rawm ( grey* -- color )
|
JMP2r
|
||||||
( res ) LDA #06 SFT 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 )
|
@|stdlib )
|
||||||
|
|
||||||
@scap ( str* -- end* )
|
@pstr ( str* -- ) &w LDAk #18 DEO INC2 LDAk ?&w POP2 JMP2r
|
||||||
&w ( -- )
|
@phex ( short* -- ) SWP ,&b JSR &b ( byte -- ) DUP #04 SFT ,&c JSR &c ( char -- ) #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO JMP2r
|
||||||
INC2 & LDAk ?&w
|
@skey ( key buf -- proc ) OVR #21 LTH ?&eval #00 SWP sput #00 JMP2r &eval POP2 #01 JMP2r
|
||||||
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* -- )
|
||||||
|
|
||||||
@<scpy> ( src* dst* -- )
|
|
||||||
STH2
|
STH2
|
||||||
&w ( -- )
|
&w
|
||||||
LDAk #00 STH2kr STA2
|
LDAk STH2kr STA INC2r
|
||||||
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
|
INC2 LDAk ?&w
|
||||||
POP2 JMP2r
|
POP2
|
||||||
|
#00 STH2r STA
|
||||||
|
|
||||||
@<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
|
JMP2r
|
||||||
|
|
||||||
(
|
(
|
||||||
@|memory )
|
@|assets )
|
||||||
|
|
||||||
@dict &usage "usage: 20 "checksum.rom 20 "input.bin 0a $1
|
@src-txt "Parsing 20 $1
|
||||||
&icn-ext ".icn $1
|
|
||||||
&chr-ext ".chr $1
|
|
||||||
&tga-ext ".tga $1
|
|
||||||
|
|
||||||
@tga &id-length $1
|
@image-types-txts
|
||||||
&color-map $1
|
&no-image "no-data $1
|
||||||
&image-type $1
|
&raw-color "RAW-color $1
|
||||||
&map $5
|
&raw-true "RAW-true $1
|
||||||
&position &x $2
|
&raw-bw "RAW-bw $1
|
||||||
&y $2
|
&rle-color "RLE-color $1
|
||||||
&size &w $2
|
&rle-true "RLE-true $1
|
||||||
&h $2
|
&rle-bw "RLE-bw $1
|
||||||
&depth $1
|
&unknown "unknown $1
|
||||||
&descriptor $1
|
|
||||||
|
|
||||||
@pict
|
@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 )
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue