538 lines
12 KiB
Tal
538 lines
12 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 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|
|
|
|
|0000
|
|
|
|
@input $80
|
|
@token $40
|
|
@p &ptr $2 &len $2
|
|
@l &ptr $2
|
|
|
|
|0100 ( -> )
|
|
|
|
( theme )
|
|
#0f5f .System/r DEO2
|
|
#0fcd .System/g DEO2
|
|
#0fa3 .System/b DEO2
|
|
#15 .Screen/auto DEO
|
|
( vectors )
|
|
;on-button .Controller/vector DEO2
|
|
|
|
( load prefabs )
|
|
;prefabs/play-note-txt ;add-label JSR2
|
|
;prefabs/draw-line-txt ;add-label JSR2
|
|
;prefabs/list-files-txt ;add-label JSR2
|
|
;prefabs/load-file-txt ;add-label JSR2
|
|
|
|
( draw )
|
|
#01 ;draw-input JSR2
|
|
#01 ;draw-stack JSR2
|
|
#01 ;draw-program JSR2
|
|
#01 ;draw-labels JSR2
|
|
|
|
#010e DEO
|
|
|
|
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* -- )
|
|
|
|
#00 ;draw-stack JSR2
|
|
|
|
&while
|
|
LDAk #20 GTH ,&no-space JCN
|
|
;do-token JSR2
|
|
,&continue JMP
|
|
&no-space
|
|
LDAk ;token ;sput JSR2
|
|
&continue
|
|
INC2 LDAk ,&while JCN
|
|
POP2
|
|
#01 ;draw-program JSR2
|
|
|
|
( set return )
|
|
;&end ;write-litshort JSR2 #2c ;write-byte JSR2
|
|
( time to evaluate program )
|
|
( borrow wst ) #ff .System/wst DEO
|
|
;dst JMP2
|
|
&end
|
|
( released wst ) #00 .System/wst DEO
|
|
#01 ;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
|
|
|
|
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
|
|
|
|
@add-label ( label* -- )
|
|
|
|
#aaaa .l/ptr LDZ2 ;labels ADD2 STA2
|
|
|
|
.l/ptr LDZ2k INC2 INC2 ROT STZ2
|
|
|
|
DUP2
|
|
.l/ptr LDZ2 ;labels ADD2 ;scpy JSR2
|
|
;slen JSR2 INC2 STH2
|
|
|
|
.l/ptr LDZ2k STH2r ADD2 ROT STZ2
|
|
#0a18 DEO
|
|
|
|
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-labels ( color -- )
|
|
|
|
POP
|
|
#0020 .Screen/x DEO2
|
|
#00d0 .Screen/y DEO2
|
|
;symbols-txt #02 ;draw-str JSR2
|
|
.Screen/y DEI2k #0010 ADD2 ROT DEO2
|
|
|
|
;labels
|
|
&while
|
|
LDA2k #03 ;draw-short JSR2
|
|
.Screen/x DEI2k #0008 ADD2 ROT DEO2
|
|
DUP2 INC2 INC2 #01 ;draw-str JSR2
|
|
.Screen/x DEI2k #0008 ADD2 ROT DEO2
|
|
;scap JSR2 INC2 LDA2k #0000 NEQ2 ,&while JCN
|
|
POP2
|
|
|
|
JMP2r
|
|
|
|
@draw-input ( color -- )
|
|
|
|
STH
|
|
( flower )
|
|
#0010 .Screen/x DEO2
|
|
#0020 .Screen/y DEO2
|
|
;flowers-icn #00 ;input ;slen JSR2 ADD #06 DIVk MUL SUB #50 SFT2 ADD2 .Screen/addr DEO2
|
|
#81 .Screen/sprite DEO
|
|
#00 .Screen/sprite DEO
|
|
;prompt-txt #02 ;draw-str JSR2
|
|
;input #01 STHr MUL ;draw-str JSR2
|
|
|
|
JMP2r
|
|
|
|
@draw-stack ( color -- )
|
|
|
|
STH
|
|
( position )
|
|
#0020 .Screen/x DEO2
|
|
#0050 .Screen/y DEO2
|
|
;stack-txt #02 ;draw-str JSR2
|
|
#ffff LDA #ff00 STHr ,draw-memory JSR
|
|
|
|
JMP2r
|
|
|
|
@draw-program ( color -- )
|
|
|
|
STH
|
|
#0020 .Screen/x DEO2
|
|
#0090 .Screen/y DEO2
|
|
;program-txt #02 ;draw-str JSR2
|
|
#10 ;dst STHr ,draw-memory JSR
|
|
|
|
JMP2r
|
|
|
|
@draw-memory ( length addr* color -- )
|
|
|
|
STH
|
|
,&addr STR2
|
|
.Screen/x DEI2 ,&anchor STR2
|
|
#00
|
|
&loop
|
|
DUP #07 AND ,&no-lb JCN
|
|
[ LIT2 &anchor $2 ] .Screen/x DEO2
|
|
.Screen/y DEI2k #0010 ADD2 ROT DEO2
|
|
&no-lb
|
|
#00 OVR [ LIT2 &addr $2 ] ADD2 LDA #01 STHkr MUL ,draw-byte JSR
|
|
.Screen/x DEI2k #0008 ADD2 ROT DEO2
|
|
INC GTHk ,&loop JCN
|
|
POP2
|
|
POPr
|
|
|
|
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 #40 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 )
|
|
|
|
@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
|
|
|
|
@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
|
|
|
|
@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
|
|
|
|
@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 )
|
|
|
|
@prompt-txt "Do 20 $1
|
|
@stack-txt "Stack 20 $1
|
|
@program-txt "Program 20 $1
|
|
@symbols-txt "Symbols 20 $1
|
|
|
|
@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
|
|
|
|
( prefabs )
|
|
|
|
@prefabs
|
|
&play-note-txt "play-note $1
|
|
&draw-line-txt "draw-line $1
|
|
&list-files-txt "list-files $1
|
|
&load-file-txt "load-file $1
|
|
|
|
@flowers-icn ( by elioat )
|
|
0000 0020 1408 0810 40a0 4205 0200 40a0
|
|
0810 103c 7e7e 3c18 4205 0234 7e7e 3c18
|
|
0000 0020 100c 0818 0040 a042 0522 5024
|
|
0008 083c 7e7e 3c18 0a04 002c 7e7e 3c18
|
|
0000 0000 0000 000c 0000 0000 0000 0000
|
|
1c10 083c 7e7e 3c18 0000 002c 7e7e 3c18
|
|
0000 0000 0000 0004 0000 0000 0002 0502
|
|
0810 103c 7e7e 3c18 0000 0034 7e7e 3c18
|
|
0000 0000 0000 0010 0000 0000 0020 5225
|
|
080c 083c 7e7e 3c18 0200 002c 7e7e 3c18
|
|
0000 0000 0800 1800 0000 040a 2450 240a
|
|
1010 103c 7e7e 3c18 0400 0034 7e7e 3c18
|
|
|
|
@font ( msx816 )
|
|
0000 0000 0000 0000 0000 0000 0000 0000
|
|
0000 0020 2020 2020 2020 0000 2020 0000
|
|
0000 006c 6c24 4800 0000 0000 0000 0000
|
|
0000 0044 44fe 4444 4444 44fe 4444 0000
|
|
0000 1010 7c92 9290 7c12 9292 7c10 1000
|
|
0000 0040 a0a2 4408 1020 448a 0a04 0000
|
|
0000 0070 8888 8850 2050 8a84 8c72 0000
|
|
0000 0030 3010 2000 0000 0000 0000 0000
|
|
0000 0004 0808 1010 1010 1008 0804 0000
|
|
0000 0040 2020 1010 1010 1020 2040 0000
|
|
0000 0000 0000 1054 3854 1000 0000 0000
|
|
0000 0000 0010 1010 fe10 1010 0000 0000
|
|
0000 0000 0000 0000 0000 0030 3010 2000
|
|
0000 0000 0000 0000 fe00 0000 0000 0000
|
|
0000 0000 0000 0000 0000 0000 3030 0000
|
|
0000 0000 0002 0408 1020 4080 0000 0000
|
|
( numbers )
|
|
0000 0038 4482 8292 9292 8282 4438 0000
|
|
0000 0010 3050 1010 1010 1010 1038 0000
|
|
0000 0038 4482 8202 0c30 4080 80fe 0000
|
|
0000 0038 4482 0204 3804 0282 4438 0000
|
|
0000 0004 0c14 1424 2444 44fe 0404 0000
|
|
0000 00fc 8080 80b8 c402 0282 4438 0000
|
|
0000 0038 4482 80b8 c482 8282 4438 0000
|
|
0000 00fe 8284 0808 1010 1010 1010 0000
|
|
0000 0038 4482 8244 3844 8282 4438 0000
|
|
0000 0038 4482 8282 463a 0282 4438 0000
|
|
0000 0000 0000 3030 0000 0030 3000 0000
|
|
0000 0000 0000 3030 0000 0030 3010 2000
|
|
0000 0000 0408 1020 4020 1008 0400 0000
|
|
0000 0000 0000 00fe 0000 fe00 0000 0000
|
|
0000 0000 4020 1008 0408 1020 4000 0000
|
|
0000 0038 4482 8202 0c10 1000 1010 0000
|
|
0000 0038 4482 0262 9292 9292 926c 0000
|
|
0000 0010 2844 8282 8282 fe82 8282 0000
|
|
0000 00f8 8482 8284 f884 8282 84f8 0000
|
|
0000 0038 4482 8080 8080 8082 4438 0000
|
|
0000 00f8 4442 4242 4242 4242 44f8 0000
|
|
0000 00fe 8080 8080 fc80 8080 80fe 0000
|
|
0000 00fe 8080 8080 fc80 8080 8080 0000
|
|
0000 0038 4482 8080 8e82 8282 463a 0000
|
|
0000 0082 8282 8282 fe82 8282 8282 0000
|
|
0000 0038 1010 1010 1010 1010 1038 0000
|
|
0000 000e 0404 0404 0404 0484 8870 0000
|
|
0000 0082 8488 90a0 c0a0 9088 8482 0000
|
|
0000 0040 4040 4040 4040 4040 407e 0000
|
|
0000 0082 c6aa 9292 8282 8282 8282 0000
|
|
0000 0082 c2a2 a292 928a 8a86 8282 0000
|
|
0000 0038 4482 8282 8282 8282 4438 0000
|
|
0000 00f8 8482 8282 84f8 8080 8080 0000
|
|
0000 0038 4482 8282 8282 bac6 443a 0000
|
|
0000 00f8 8482 8284 f890 8884 8482 0000
|
|
0000 0038 4482 8040 3804 0282 4438 0000
|
|
0000 00fe 1010 1010 1010 1010 1010 0000
|
|
0000 0082 8282 8282 8282 8282 827c 0000
|
|
0000 0082 8282 8282 8282 8244 2810 0000
|
|
0000 0082 8282 8282 9292 aaaa 4444 0000
|
|
0000 0082 8282 4428 1028 4482 8282 0000
|
|
0000 0082 8282 4428 1010 1010 1010 0000
|
|
0000 00fe 0202 0408 1020 4080 80fe 0000
|
|
0000 001c 1010 1010 1010 1010 101c 0000
|
|
0000 0082 4428 10fe 1010 fe10 1010 0000
|
|
0000 0070 1010 1010 1010 1010 1070 0000
|
|
0000 0010 2844 8200 0000 0000 0000 0000
|
|
0000 0000 0000 0000 0000 0000 00fe 0000
|
|
0000 0060 6020 1000 0000 0000 0000 0000
|
|
0000 0000 0000 7884 047c 8484 8c74 0000
|
|
0000 0040 4040 5864 4242 4242 6458 0000
|
|
0000 0000 0000 3844 8280 8082 4438 0000
|
|
0000 0004 0404 344c 8484 8484 4c34 0000
|
|
0000 0000 0000 3844 82fe 8082 4438 0000
|
|
0000 0018 2420 7820 2020 2020 2020 0000
|
|
0000 0000 0000 3a46 8282 8246 3a82 4438
|
|
0000 0040 4040 5864 4242 4242 4242 0000
|
|
0000 0010 1000 0010 1010 1010 1010 0000
|
|
0000 0008 0800 0008 0808 0808 0808 4830
|
|
0000 0040 4040 4244 4850 7048 4442 0000
|
|
0000 0030 1010 1010 1010 1010 1010 0000
|
|
0000 0000 0000 ec92 9292 9292 9292 0000
|
|
0000 0000 0000 5c62 4242 4242 4242 0000
|
|
0000 0000 0000 3844 8282 8282 4438 0000
|
|
0000 0000 0000 5864 4242 4242 6458 4040
|
|
0000 0000 0000 344c 8484 8484 4c34 0404
|
|
0000 0000 0000 5864 4040 4040 4040 0000
|
|
0000 0000 0000 7c82 807c 0202 827c 0000
|
|
0000 0020 2020 f820 2020 2020 2418 0000
|
|
0000 0000 0000 8484 8484 8484 8c74 0000
|
|
0000 0000 0000 8282 4444 2828 1010 0000
|
|
0000 0000 0000 8282 8292 92aa 4444 0000
|
|
0000 0000 0000 8244 2810 1028 4482 0000
|
|
0000 0000 0000 4242 4242 4222 1408 1060
|
|
0000 0000 0000 fe04 0810 2040 80fe 0000
|
|
0000 000c 1010 1010 2010 1010 100c 0000
|
|
0000 1010 1010 0000 0000 1010 1010 0000
|
|
0000 0060 1010 1010 0810 1010 1060 0000
|
|
0000 0060 920c 0000 0000 0000 0000 0000
|
|
|
|
@dst $1000
|
|
|
|
( addr* label[length] )
|
|
|
|
@labels
|