461 lines
9.0 KiB
Tal
461 lines
9.0 KiB
Tal
( REPL )
|
|
|
|
|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &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 @File &vector $2 &success $2 &offset $2 &pad $2 &name $2 &length $2 &load $2 &save $2
|
|
|
|
|0000
|
|
|
|
@input $80
|
|
@token $40
|
|
@p &ptr $2 &len $2
|
|
|
|
|0100 ( -> )
|
|
|
|
( theme )
|
|
#f0f7 .System/r DEO2
|
|
#50f7 .System/g DEO2
|
|
#60f7 .System/b DEO2
|
|
( vectors )
|
|
;on-button .Controller/vector DEO2
|
|
( draw )
|
|
#fe00 ;draw-stack JSR2
|
|
|
|
BRK
|
|
|
|
@on-button ( -> )
|
|
|
|
.Controller/key DEI
|
|
[ #0d ] EQUk NIP ,&validate JCN
|
|
[ #08 ] EQUk NIP ,&erase JCN
|
|
[ #20 ] LTHk NIP ,&end JCN
|
|
[ #7e ] GTHk NIP ,&end JCN
|
|
;input ;slen JSR2 NIP #80 LTH ,&append JCN
|
|
&end
|
|
POP
|
|
|
|
BRK
|
|
&append ( char -> ) #00 ;draw-input JSR2 ;input ;sput JSR2 #01 ;draw-input JSR2 BRK
|
|
&erase ( char -> ) #00 ;draw-input JSR2 ;input ;spop JSR2 #01 ;draw-input JSR2 BRK
|
|
&validate ( char -> ) #00 ;draw-input JSR2 ;input ;sput JSR2 ;input ;parse JSR2 ;input #0080 ;mclr JSR2 BRK
|
|
|
|
@parse ( addr* -- )
|
|
|
|
&while
|
|
LDAk #20 GTH ,&no-space JCN
|
|
;do-token JSR2
|
|
,&continue JMP
|
|
&no-space
|
|
LDAk ;token ;sput JSR2
|
|
&continue
|
|
INC2 LDAk ,&while JCN
|
|
POP2
|
|
|
|
( set return )
|
|
;&end ;write-litshort JSR2 #2c ;write-byte JSR2
|
|
( time to evaluate program )
|
|
( borrow wst ) #fe .System/wst DEO
|
|
;dst JMP2
|
|
&end
|
|
( released wst ) #00 .System/wst DEO
|
|
#fe00 ;draw-stack JSR2
|
|
|
|
;dst .p/len LDZ2 #0004 ADD2 ;mclr JSR2
|
|
#0000 .p/len STZ2
|
|
#0000 .p/ptr STZ2
|
|
|
|
JMP2r
|
|
|
|
@do-token ( -- )
|
|
|
|
;token LDAk LIT '# NEQ ,&no-lithex JCN
|
|
DUP2 INC2 ;do-lithex JSR2 ,&end JMP
|
|
&no-lithex
|
|
DUP2 ;is-opcode JSR2 #00 EQU ,&no-opcode JCN
|
|
DUP2 ;find-opcode JSR2 ;write-byte JSR2
|
|
&no-opcode
|
|
&end
|
|
POP2
|
|
|
|
;token #0040 ;mclr JSR2
|
|
|
|
;draw-program JSR2
|
|
|
|
JMP2r
|
|
|
|
@is-opcode ( string* -- flag )
|
|
|
|
DUP2 ;opcodes/brk ,scmp3 JSR ,find-opcode/on-brk JCN
|
|
|
|
@find-opcode ( name* -- byte )
|
|
|
|
STH2
|
|
#2000
|
|
&loop
|
|
#00 OVR #03 MUL ;opcodes ADD2 STH2kr ,scmp3 JSR ,&on-found JCN
|
|
INC GTHk ,&loop JCN
|
|
POP2 POP2r #00
|
|
|
|
JMP2r
|
|
&on-found NIP STH2r ,find-mode JSR ADD JMP2r
|
|
&on-brk POP2 #01 JMP2r
|
|
|
|
@find-mode ( mode* -- byte )
|
|
|
|
LITr 00
|
|
;opcodes OVR2 ,scmp3 JSR #70 SFT STH ADDr
|
|
INC2 INC2 INC2
|
|
LDAk #00 EQU ,&end JCN
|
|
&while
|
|
LDAk LIT '2 EQU #50 SFT STH ADDr
|
|
LDAk LIT 'r EQU #60 SFT STH ADDr
|
|
LDAk LIT 'k EQU #70 SFT STH ADDr
|
|
INC2 LDAk ,&while JCN
|
|
&end
|
|
POP2 STHr
|
|
|
|
JMP2r
|
|
|
|
@scmp3 ( a[3]* b[3]* -- flag )
|
|
|
|
LDA2k STH2 INC2 INC2 SWP2
|
|
LDA2k STH2 INC2 INC2 EQU2r
|
|
LDA STH LDA STH EQUr
|
|
ANDr STHr
|
|
|
|
JMP2r
|
|
|
|
@do-lithex ( t* -- )
|
|
|
|
DUP2 ;slen JSR2 #0004 EQU2 ,&on-short JCN
|
|
DUP2 ;slen JSR2 #0002 EQU2 ,&on-byte JCN
|
|
|
|
;err/lithx ;print-err JMP2
|
|
|
|
&on-short ;sshort JSR2 ;write-litshort JMP2
|
|
&on-byte ;sbyte JSR2 ;write-litbyte JMP2
|
|
|
|
@write-litbyte ( byte -- )
|
|
|
|
( LITk ) #80 SWP ,write-short JMP
|
|
|
|
@write-litshort ( short* -- )
|
|
|
|
( LIT2k ) #a0 ,write-byte JSR
|
|
|
|
@write-short ( short -- )
|
|
|
|
SWP ,write-byte JSR
|
|
|
|
@write-byte ( byte -- )
|
|
|
|
;dst .p/ptr LDZ2 STH2k ADD2 STA
|
|
INC2r STH2kr .p/ptr STZ2
|
|
STH2r .p/len STZ2
|
|
|
|
JMP2r
|
|
|
|
( drawing )
|
|
|
|
@draw-input ( color -- )
|
|
|
|
STH
|
|
#0020 .Screen/x DEO2
|
|
#0010 .Screen/y DEO2
|
|
#3e #02 STHkr MUL ;draw-char JSR2
|
|
;input #01 STHr MUL ;draw-str JSR2
|
|
|
|
JMP2r
|
|
|
|
@draw-stack ( addr* -- )
|
|
|
|
( position )
|
|
#0020 .Screen/x DEO2
|
|
#0020 .Screen/y DEO2
|
|
STH2k
|
|
#00ff ADD2 LDA ,&length STR
|
|
#01 .Screen/auto DEO
|
|
.Screen/x DEI2 ,&anchor STR2
|
|
#00
|
|
&loop
|
|
( linebreak )
|
|
DUP #0f AND ,&skip JCN
|
|
[ LIT2 &anchor $2 ] .Screen/x DEO2
|
|
.Screen/y DEI2k #000a ADD2 ROT DEO2
|
|
&skip
|
|
( byte ) #00 OVR STH2kr ADD2 LDA
|
|
( color ) OVR [ LIT &length $1 ] STH2k LTH INC STH2r EQU #02 MUL ADD
|
|
;draw-byte JSR2
|
|
.Screen/x DEI2k #0002 ADD2 ROT DEO2
|
|
INC DUP ,&loop JCN
|
|
POP
|
|
POP2r
|
|
|
|
JMP2r
|
|
|
|
@draw-program ( -- )
|
|
|
|
#0020 .Screen/x DEO2
|
|
.Screen/height DEI2 #0020 SUB2 .Screen/y DEO2
|
|
#10 ;dst ;draw-memory JSR2
|
|
|
|
JMP2r
|
|
|
|
@draw-memory ( length addr* -- )
|
|
|
|
STH2
|
|
#01 .Screen/auto DEO
|
|
.Screen/x DEI2 ,&anchor STR2
|
|
#00
|
|
&loop
|
|
( linebreak )
|
|
DUP #0f AND ,&skip JCN
|
|
[ LIT2 &anchor $2 ] .Screen/x DEO2
|
|
.Screen/y DEI2k #000a ADD2 ROT DEO2
|
|
&skip
|
|
( byte ) #00 OVR STH2kr ADD2 LDA #01 ;draw-byte JSR2
|
|
.Screen/x DEI2k #0002 ADD2 ROT DEO2
|
|
INC GTHk ,&loop JCN
|
|
POP2
|
|
POP2r
|
|
|
|
JMP2r
|
|
|
|
@draw-short ( short* color -- )
|
|
|
|
STH SWP STHkr ,draw-byte JSR STHr
|
|
|
|
@draw-byte ( byte color -- )
|
|
|
|
STH DUP #04 SFT STHkr ,draw-hex JSR #0f AND STHr
|
|
|
|
@draw-hex ( char color -- )
|
|
|
|
SWP #0f AND [ DUP #09 GTH #07 MUL ADD #30 ADD ] SWP
|
|
|
|
@draw-char ( char color -- )
|
|
|
|
SWP #20 SUB #00 SWP #30 SFT2 ;font ADD2 .Screen/addr DEO2
|
|
.Screen/sprite DEO
|
|
|
|
JMP2r
|
|
|
|
@draw-str ( text* color -- )
|
|
|
|
STH
|
|
&while
|
|
LDAk STHkr ,draw-char JSR
|
|
INC2 LDAk ,&while JCN
|
|
POP2
|
|
POPr
|
|
|
|
JMP2r
|
|
|
|
( utils )
|
|
|
|
@scat ( src* dst* -- )
|
|
|
|
DUP2 ,slen JSR ADD2
|
|
|
|
@scpy ( src* dst* -- )
|
|
|
|
STH2
|
|
&while
|
|
LDAk STH2kr STA INC2r
|
|
INC2 LDAk ,&while JCN
|
|
POP2
|
|
#00 STH2r STA
|
|
|
|
JMP2r
|
|
|
|
@slen ( str* -- len* )
|
|
|
|
DUP2 ,scap JSR SWP2 SUB2
|
|
|
|
JMP2r
|
|
|
|
@scap ( str* -- end* )
|
|
|
|
LDAk #00 NEQ JMP JMP2r
|
|
&while INC2 LDAk ,&while JCN
|
|
|
|
JMP2r
|
|
|
|
@sput ( char str* -- )
|
|
|
|
,scap JSR STA
|
|
|
|
JMP2r
|
|
|
|
@spop ( str* -- )
|
|
|
|
LDAk ,&no-null JCN
|
|
POP2 JMP2r &no-null
|
|
#00 ROT ROT ,scap JSR #0001 SUB2 STA
|
|
|
|
JMP2r
|
|
|
|
@shex ( str* -- short* )
|
|
|
|
LIT2r 0000
|
|
&while
|
|
LITr 40 SFT2r
|
|
LITr 00
|
|
LDAk ,chex JSR STH ADD2r
|
|
INC2 LDAk ,&while JCN
|
|
POP2 STH2r
|
|
|
|
JMP2r
|
|
|
|
@chex ( char -- value )
|
|
|
|
DUP #2f GTH OVR #3a LTH AND ,&number JCN
|
|
DUP #60 GTH OVR #67 LTH AND ,&lc JCN
|
|
POP #00
|
|
|
|
JMP2r
|
|
&number #30 SUB JMP2r
|
|
&lc #57 SUB JMP2r
|
|
|
|
@mclr ( addr* len* -- )
|
|
|
|
OVR2 ADD2 SWP2
|
|
&loop
|
|
STH2k #00 STH2r STA
|
|
INC2 GTH2k ,&loop JCN
|
|
POP2 POP2
|
|
|
|
JMP2r
|
|
|
|
@mcpy ( src* dst* len* -- )
|
|
|
|
SWP2 STH2
|
|
OVR2 ADD2 SWP2
|
|
&loop
|
|
LDAk STH2kr STA INC2r
|
|
INC2 GTH2k ,&loop JCN
|
|
POP2 POP2
|
|
POP2r
|
|
|
|
JMP2r
|
|
|
|
@print ( short* -- )
|
|
|
|
&short ( short* -- ) SWP ,&byte JSR
|
|
&byte ( byte -- ) DUP #04 SFT ,&char JSR
|
|
&char ( char -- ) #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
|
|
|
|
JMP2r
|
|
|
|
@sshort ( str* -- short* )
|
|
|
|
INC2k INC2 ,sbyte JSR STH
|
|
,sbyte JSR STHr
|
|
|
|
JMP2r
|
|
|
|
@sbyte ( str* -- byte )
|
|
|
|
LDAk ,chex JSR STH
|
|
INC2 LDA ,chex JSR
|
|
STHr #40 SFT ADD
|
|
|
|
JMP2r
|
|
|
|
@print-err ( token* err* -- )
|
|
|
|
LIT '! .Console/write DEO
|
|
SWP2 ,print-str JSR #2018 DEO
|
|
|
|
@print-str ( str* -- )
|
|
|
|
&while
|
|
LDAk #18 DEO
|
|
INC2 LDAk ,&while JCN
|
|
POP2
|
|
|
|
JMP2r
|
|
|
|
( assets )
|
|
|
|
@opcodes
|
|
"LIT "INC "POP "DUP "NIP "SWP "OVR "ROT
|
|
"EQU "NEQ "GTH "LTH "JMP "JCN "JSR "STH
|
|
"LDZ "STZ "LDR "STR "LDA "STA "DEI "DEO
|
|
"ADD "SUB "MUL "DIV "AND "ORA "EOR "SFT
|
|
&brk "BRK
|
|
|
|
@err
|
|
&lithx "LITHX $1 &label "LABEL $1 &token "TOKEN $1 &reslv "RESLV $1
|
|
|
|
@font ( acorn8 )
|
|
0000 0000 0000 0000 1818 1818 1800 1800
|
|
3636 3600 0000 0000 3636 7f36 7f36 3600
|
|
0c3f 683e 0b7e 1800 0063 660c 1833 6300
|
|
386c 6c38 6d66 3b00 0c0c 0c00 0000 0000
|
|
060c 1818 180c 0600 3018 0c0c 0c18 3000
|
|
0066 3cff 3c66 0000 000c 0c3f 0c0c 0000
|
|
0000 0000 0018 1830 0000 007f 0000 0000
|
|
0000 0000 0018 1800 0003 060c 1830 6000
|
|
3e63 676b 7363 3e00 0c1c 0c0c 0c0c 3f00
|
|
3e63 031e 3060 7f00 3e63 030e 0363 3e00
|
|
0e1e 3666 7f06 0600 7f60 7e03 0363 3e00
|
|
1e30 607e 6363 3e00 7f03 060c 1818 1800
|
|
3e63 633e 6363 3e00 3e63 633f 0306 3c00
|
|
0000 1818 0018 1800 0000 1818 0018 1830
|
|
060c 1830 180c 0600 0000 7f00 7f00 0000
|
|
3018 0c06 0c18 3000 3e63 030e 1800 1800
|
|
3c66 6e6a 6e60 3c00 3e63 637f 6363 6300
|
|
7e63 637e 6363 7e00 1e33 6060 6033 1e00
|
|
7c66 6363 6366 7c00 7f60 607c 6060 7f00
|
|
7f60 607c 6060 6000 1e33 6067 6333 1e00
|
|
6363 637f 6363 6300 3f0c 0c0c 0c0c 3f00
|
|
7f0c 0c0c 0c6c 3800 6366 6c78 6c66 6300
|
|
6060 6060 6060 7f00 6377 7f6b 6b63 6300
|
|
6373 7b6f 6763 6300 3e63 6363 6363 3e00
|
|
7e63 637e 6060 6000 3e63 6363 6566 3b00
|
|
7e63 637e 6663 6300 3e63 603e 0363 3e00
|
|
3f0c 0c0c 0c0c 0c00 6363 6363 6363 3e00
|
|
6363 6363 6336 1c00 6363 6b6b 7f77 6300
|
|
6336 1c1c 3663 6300 6363 633e 0c0c 0c00
|
|
7f06 0c18 3060 7f00 3e30 3030 3030 3e00
|
|
0060 3018 0c06 0300 7c0c 0c0c 0c0c 7c00
|
|
1c36 6300 0000 0000 0000 0000 0000 00ff
|
|
3018 0c00 0000 0000 0000 3e03 3f63 3f00
|
|
6060 7e63 6363 7e00 0000 3e63 6063 3e00
|
|
0303 3f63 6363 3f00 0000 3e63 7f60 3e00
|
|
0f18 183e 1818 1800 0000 3f63 633f 033e
|
|
6060 7e63 6363 6300 0c00 1c0c 0c0c 3f00
|
|
0600 1e06 0606 063c 6060 6366 7c66 6300
|
|
1c0c 0c0c 0c0c 1e00 0000 367f 6b6b 6300
|
|
0000 7e63 6363 6300 0000 3e63 6363 3e00
|
|
0000 7e63 637e 6060 0000 3f63 633f 0302
|
|
0000 6e7b 6060 6000 0000 3f60 3e03 7e00
|
|
1818 3f18 1818 0f00 0000 6363 6363 3f00
|
|
0000 6363 6336 1c00 0000 636b 6b7f 3600
|
|
0000 6336 1c36 6300 0000 6363 633f 033e
|
|
0000 7f06 1c30 7f00 060c 0c38 0c0c 0600
|
|
0c0c 0c0c 0c0c 0c00 3018 180e 1818 3000
|
|
316b 4600 0000 0000 0303 0606 761c 0c00
|
|
f090 f01f 1f1f 1f00 e0e0 e01f 1111 1f00
|
|
fe92 92f2 8282 fe00 6699 8142 8199 6600
|
|
fcfc ffe1 e121 3f00 0000 3c66 6066 3cff
|
|
6060 7c66 6666 66ff 1828 4f81 4f28 1800
|
|
1814 f281 f214 1800 3c24 24e7 4224 1800
|
|
1824 42e7 2424 3c00 3030 7c30 3030 1cff
|
|
0000 3c66 7e60 3cff 0000 6c76 6060 60ff
|
|
0000 3e60 3c06 7cff 0000 0018 1800 00ff
|
|
0000 3c06 3e66 3eff 0000 6c76 6060 60ff
|
|
0000 3c66 7e60 3cff 0000 0018 1800 00ff
|
|
0000 7c66 6666 66ff 0000 3c66 6666 3cff
|
|
3030 7c30 3030 1cff 0000 0018 1800 00ff
|
|
0606 3e66 6666 3eff 0000 3c66 7e60 3cff
|
|
1c30 307c 3030 30ff 1800 3818 1818 3cff
|
|
0000 7c66 6666 66ff 0000 3c66 7e60 3cff
|
|
0606 3e66 6666 3eff 0000 0000 0000 0000
|
|
|
|
@dst
|