Cleanup
This commit is contained in:
neauoire
parent
65bac442c5
commit
552341125d
|
|
@ -5,27 +5,18 @@
|
|||
|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
|
||||
@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
|
||||
|
||||
@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 ( -> )
|
||||
|0100
|
||||
|
||||
@on-reset ( -> )
|
||||
( | theme )
|
||||
#26ae .System/r DEO2
|
||||
#26ae .System/g DEO2
|
||||
|
|
@ -35,35 +26,26 @@
|
|||
#0100 .Screen/height DEO2
|
||||
( | wait )
|
||||
;await-src .Console/vector DEO2
|
||||
|
||||
BRK
|
||||
BRK
|
||||
|
||||
(
|
||||
@|vectors )
|
||||
|
||||
@await-src ( -> )
|
||||
|
||||
.Console/read DEI .src skey
|
||||
?on-ready
|
||||
|
||||
BRK
|
||||
.Console/read DEI .src skey ?on-ready
|
||||
BRK
|
||||
|
||||
@on-ready ( -> )
|
||||
|
||||
;src ;dst scpy
|
||||
;&chr-ext ;dst scap scpy
|
||||
;dst .File2/name DEO2
|
||||
;src file-open-tga
|
||||
;dst pstr #0a18 DEO
|
||||
|
||||
BRK
|
||||
&chr-ext ".chr $1
|
||||
;src ;dst scpy ;&chr-ext ;dst scap scpy ;dst .File2/name DEO2
|
||||
;src <file-open-tga>
|
||||
;dst <pstr>/
|
||||
#0a18 DEO
|
||||
BRK &chr-ext ".chr $1
|
||||
|
||||
(
|
||||
@|tga )
|
||||
|
||||
@file-open-tga ( path* -- )
|
||||
|
||||
@<file-open-tga> ( path* -- )
|
||||
( | header )
|
||||
DUP2 .File1/name DEO2
|
||||
#0012 .File1/length DEO2
|
||||
|
|
@ -76,138 +58,122 @@ BRK
|
|||
;image/h LDA2 #0040 ADD2 .Screen/height DEO2
|
||||
;image/w LDA2 #43 SFT2 .File2/length DEO2
|
||||
( | print details )
|
||||
;src-txt pstr
|
||||
pstr
|
||||
LIT "( #18 DEO #00
|
||||
;image/image-type LDA #10 SFT ;image-types ADD2 LDA2 pstr
|
||||
LIT ") #18 DEO #0a18 DEO
|
||||
|
||||
;src-txt <pstr>
|
||||
<pstr>/
|
||||
[ LIT2 "( 18 ] DEO
|
||||
#00 ;image/image-type LDA #10 SFT ;image-types ADD2 LDA2 <pstr>/
|
||||
[ LIT2 ") 18 ] DEO
|
||||
#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
|
||||
|
||||
;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 pstr #0a18 DEO
|
||||
|
||||
JMP2r
|
||||
;&err <pstr>
|
||||
#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
|
||||
.File1/length DEO2
|
||||
,&filter STR2
|
||||
#0000 ,&x STR2
|
||||
#0000 ,&y STR2
|
||||
&stream
|
||||
&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
|
||||
[ 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 )
|
||||
(
|
||||
@|tools )
|
||||
|
||||
@set-pixel ( x* y* color -- )
|
||||
|
||||
STH
|
||||
OVR2 SWP2
|
||||
( | get addr )
|
||||
DUP2 #0007 AND2
|
||||
SWP2 #83 SFT2 ADD2
|
||||
SWP2 #43 SFT2 ADD2
|
||||
;buffer ADD2
|
||||
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
|
||||
( ch2 ) #0008 ADD2 STHr #01 toggle-pixel JMP2r
|
||||
|
||||
@toggle-pixel ( x* addr* color -- )
|
||||
|
||||
STH2
|
||||
LDAk
|
||||
STH SWP2 NIP
|
||||
STHr SWP
|
||||
STH2r SFT #01 AND ?&do-set
|
||||
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
|
||||
&do-set
|
||||
( mask ) #0107 ROT #07 AND SUB #40 SFT SFT ORA
|
||||
( save ) ROT ROT STA
|
||||
|
||||
JMP2r
|
||||
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
|
||||
|
||||
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
|
||||
( res ) LDA JMP2r
|
||||
|
||||
(
|
||||
@|stdlib )
|
||||
|
||||
@pstr ( str* -- ) &w LDAk #18 DEO INC2 LDAk ?&w POP2 JMP2r
|
||||
@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
|
||||
@skey ( key buf -- proc ) OVR #21 LTH ?&eval #00 SWP sput #00 JMP2r &eval 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
|
||||
@<pstr> ( 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
|
||||
&w ( -- )
|
||||
LDAk STH2kr STA
|
||||
INC2r INC2 LDAk ?&w
|
||||
POP2 #00 STH2r STA
|
||||
JMP2r
|
||||
|
||||
(
|
||||
@|assets )
|
||||
|
||||
@src-txt "Parsing 20 $1
|
||||
@src-txt
|
||||
"Parsing 20 $1
|
||||
|
||||
@image-types-txts
|
||||
&no-image "no-data $1
|
||||
@image-types-txts &no-image "no-data $1
|
||||
&raw-color "RAW-color $1
|
||||
&raw-true "RAW-true $1
|
||||
&raw-bw "RAW-bw $1
|
||||
|
|
@ -217,18 +183,13 @@ JMP2r
|
|||
&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 ]
|
||||
=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