commit 127cb207d62b7f23449be0e2bf2585278a2454d1
parent 0bf6fc74c42f2bdfe3c7dfcdcb5290ee72efe99c
Author: Devine Lu Linvega <aliceffekt@gmail.com>
Date: Sat, 9 Aug 2025 12:09:28 -0700
Removed old examples
Diffstat:
5 files changed, 0 insertions(+), 2019 deletions(-)
diff --git a/projects/examples/exercises/pig.tal b/projects/examples/exercises/pig.tal
@@ -1,70 +0,0 @@
-( Pig:
- Each turn you roll a die and add the total to your points.
- You can stop at any time and keep that total, or keep rolling.
- If you ever roll a 1 you lose all the points you accrued. )
-
-|10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1
-
-|0000 @t $1 ( Total saved )
-
-|0100 @game ( -> )
-
- #00 .t STZ
- ;input-main .Console/vector DEO2
- ,input-main/main JMP
-
-@roll ( -- dice )
-
- [ LIT2 &r f793 ]
- ( 5*R+35 ) #0005 MUL2 #0023 ADD2
- ( R-R/6547*6547 ) DUP2 #1993 DIV2 #1993 MUL2 SUB2
- DUP2 #c5 DEI2 ADD2 ,&r STR2 ADD ( mod ) #06 DIVk MUL SUB
-
-JMP2r
-
-@input-main ( -> )
-
- .Console/read DEI
- LIT "0 EQUk NIP ,&no JCN
- LIT "1 EQUk NIP ,&yes JCN
- ( ignore other inputs )
- POP
-
-BRK
- &no ( char -- )
- POP ;score-txt ,pstr JSR .t LDZ ,pdec JSR ;byte-txt ,&halt JMP
- &yes ( char -- )
- POP ,roll JSR ;rolled-txt ,pstr JSR INCk ,pdec/d JSR DUP ,¬-bust JCN
- &bust ( char -- )
- POP ;bust-txt
- &halt ( msg* -- )
- ,pstr JSR #0a .Console/write DEO #010f DEO BRK
- ¬-bust ( dice -- )
- INC .t LDZ ADD .t STZ
- &main ( -- )
- ;total-txt ,pstr JSR .t LDZ ,pdec JSR ;roll-txt ,pstr JSR BRK
-
-@pdec ( value -- )
-
- DUP #0a DIV ,&emit JSR
- &d #0a DIVk MUL SUB ,&emit JSR
- #0a .Console/write DEO
-
-JMP2r
- &emit #30 ADD .Console/write DEO JMP2r
-
-@pstr ( str* -- )
-
- &while
- LDAk DUP LIT "_ EQU #3f MUL SUB .Console/write DEO
- INC2 LDAk ,&while JCN
- POP2
-
-JMP2r
-
-@total-txt "Your_current_total_is:_ $1
-@roll-txt "Would_you_like_to_roll?_(0_no,_1_yes)_ $1
-@score-txt "Your_score_is:_ $1
-@rolled-txt "You_rolled:_ $1
-@bust-txt "Busted! $1
-@byte-txt "Goodbye. $1
diff --git a/projects/library/asma.tal b/projects/library/asma.tal
@@ -1,962 +0,0 @@
-(
- Asma - an in-Uxn assembler
-
- This assembler aims to be binary compatible with the output from
- src/uxnasm.c, but unlike that assembler this one can be run inside Uxn
- itself!
-
- Asma is designed to be able to be copy-pasted inside another project, so
- all its routines are prefixed with "asma-" to prevent clashes with labels
- used in the incorporating project. The reset vector contains a couple of
- examples of asma's usage and can be discarded.
-)
-
-(
- Asma's public interface.
- These routines are what are expected to be called from programs that bundle
- Asma into bigger projects.
-)
-
-@asma-assemble-file ( src-filename* dest-filename* -- )
- #01 .File/append DEO
- DUP2 .File/name DEO2
- #01 .File/delete DEO
- ;asma/dest-filename STA2 ;asma/src-filename STA2
-
- ;asma-init-first-pass JSR2
- ;asma-flush-ignore ;asma/flush-fn STA2
- ;asma/src-filename LDA2 ;asma-assemble-file-pass JSR2
- ;asma/error LDA2 ORA ,&error JCN
-
- ;asma-init-next-pass JSR2
- ;asma-flush-to-file ;asma/flush-fn STA2
- ;asma/dest-filename LDA2 ORA ,&filename-present JCN
- ;asma-flush-to-console ;asma/flush-fn STA2
- &filename-present
- ;asma/src-filename LDA2 ;asma-assemble-file-pass JSR2
- ;asma/error LDA2 ORA ,&error JCN
-
- ( flush output buffer )
- ;asma-output/ptr LDA2 ;asma-write-buffer SUB2 ;asma/flush-fn LDA2 JSR2
-
- ;asma-trees/labels ;asma-print-labels JSR2 ( DEBUG )
- ;asma-print-line-count JSR2 ( DEBUG )
- ;asma-print-heap-usage JSR2 ( DEBUG )
- JMP2r
-
- &error
- ;asma-print-error JSR2 ( DEBUG )
- JMP2r
-
-(
- Debugging routines. These all output extra information to the Console.
- These can be stripped out to save space, once the references to them are
- removed. Look for the word DEBUG above to find these references: the lines
- that contain that word can be deleted to strip out the functionality
- cleanly.
-)
-
-@asma-print-error ( -- )
- .File/name DEI2 ;asma-print-string JSR2
- ;&line ;asma-print-string JSR2
- ;asma/line LDA2 ;asma-print-short JSR2
- #3a .Console/error DEO
- #20 .Console/error DEO
- ;asma/error LDA2 ;asma-print-string JSR2
- #3a .Console/error DEO
- #20 .Console/error DEO
- ;asma/orig-token LDA2 ;asma-print-string JSR2
- #2e .Console/error DEO
- #0a .Console/error DEO
- JMP2r
-
- &line 20 "line 20 00
-
-@asma-print-line-count ( -- )
- ;asma/log-level LDA #01 AND #00 EQU ,&skip JCN
- ;asma/lines LDA2 ;asma-print-short JSR2
- ;&lines ;asma-print-string JSR2
- &skip
- JMP2r
-
- &lines [ 20 "lines 20 "of 20 "source 20 "code. 0a 00 ]
-
-@asma-print-heap-usage ( -- )
- ;asma/log-level LDA #08 AND #00 EQU ,&skip JCN
- ;heap LDA2 ;asma-heap SUB2 ;asma-print-short JSR2
- ;&str1 ;asma-print-string JSR2
- ;asma-heap/end ;heap LDA2 SUB2 ;asma-print-short JSR2
- ;&str2 ;asma-print-string JSR2
- &skip
- JMP2r
-
- &str1 [ 20 "bytes 20 "of 20 "heap 20 "used, 20 00 ]
- &str2 [ 20 "bytes 20 "free. 0a 00 ]
-
-@asma-print-sublabels ( incoming-ptr* -- )
- LDA2
- ORAk ,&valid-incoming-ptr JCN
- POP2 JMP2r
-
- &valid-incoming-ptr
- ( left node )
- DUP2 ,asma-print-sublabels JSR
- ( here )
- #09 .Console/error DEO
- DUP2 #0004 ADD2
- &loop
- DUP2 INC2 SWP2 LDA
- DUP #00 EQU ,&end JCN
- .Console/error DEO
- ,&loop JMP
- &end
- POP
- #09 .Console/error DEO
- LDA2 ;asma-print-short JSR2
- #0a .Console/error DEO
-
- ( right node )
- #0002 ADD2 ,asma-print-sublabels JSR
- JMP2r
-
-@asma-print-labels ( incoming-ptr* -- )
- ;asma/log-level LDA #04 AND #00 EQU ,&skip JCN
- LDA2
- ORAk ,&valid-incoming-ptr JCN
- &skip
- POP2 JMP2r
-
- &valid-incoming-ptr
- ( left node )
- DUP2 ,asma-print-labels JSR
- ( here )
- DUP2 #0004 ADD2
- LDAk LIT "A LTH ,&loop JCN
- LDAk LIT "Z GTH ,&loop JCN
- POP2
- ,&skip-device-label JMP
- &loop
- DUP2 INC2 SWP2 LDA
- DUP #00 EQU ,&end JCN
- .Console/error DEO
- ,&loop JMP
- &end
- POP
- #09 .Console/error DEO
- LDA2k ;asma-print-short JSR2
- #0a .Console/error DEO
- ( subtree )
- #0002 ADD2 ;asma-print-sublabels JSR2
-
- &skip-device-label
- ( right node )
- #0002 ADD2 ,asma-print-labels JSR
- JMP2r
-
-@asma-print-string ( ptr* -- )
- LDAk DUP ,&keep-going JCN
- POP POP2 JMP2r
-
- &keep-going
- .Console/error DEO
- INC2
- ,asma-print-string JMP
-
-@asma-print-short ( short* -- )
- LIT "0 .Console/error DEO
- LIT "x .Console/error DEO
- OVR #04 SFT ,&hex JSR
- SWP #0f AND ,&hex JSR
- DUP #04 SFT ,&hex JSR
- #0f AND ,&hex JMP
-
- &hex
- #30 ADD DUP #3a LTH ,¬-alpha JCN
- #27 ADD
- ¬-alpha
- .Console/error DEO
- JMP2r
-
-(
- Initialise the assembler state before loading a file or chunk.
-)
-
-@asma-init-first-pass ( -- )
- LIT2 POP2 POP EOR ;asma-parse-opcode/short-flag STA
- LIT2 POPr POP EOR ;asma-parse-opcode/return-flag STA
- LIT2 POPk POP EOR ;asma-parse-opcode/keep-flag STA
- #ff ;asma/pass STA
- #0000 DUP2k
- ;asma/error STA2
- ;asma-trees/labels STA2
- ;asma-trees/macros STA2
- ;asma-opcodes/_entry ;asma-trees/opcodes STA2
- ( fall through )
-
-@asma-init-next-pass ( -- )
- ;asma/pass LDA INC ;asma/pass STA
- ;asma-write-buffer ;asma-output/ptr STA2
- #0100 DUP2 DUP ( 0100 0100 00 )
- ;asma/state STA
- ;asma/addr STA2
- ;asma/written-addr STA2
- ;&preamble-end ;&preamble SUB2k ;asma-assemble-chunk JSR2 POP2 POP2
- JMP2r
-
- &preamble
- "%BRK 20 "{ 20 "00 20 "} 20
- "%[ 20 "{ 20 "} 20
- "%] 20 "{ 20 "} 20
- "@on-reset 20
- &preamble-end
-
-(
- Divide a file up into chunks, and pass each chunk to asma-assemble-chunk.
-)
-
-@asma-assemble-file-pass ( filename-ptr* -- )
- ;asma-assemble-chunk #0000 ROT2 ( func* line^ filename* )
- ;asma-read-buffer DUP2 ;asma-read-buffer/end ROT2 SUB2 ( func* line^ filename* buf* size^ )
- ROT2 ( func* line^ buf* size^ filename* )
- ,file-read-chunks JSR
-
- ;asma/error LDA2 ORA ,&error JCN
-
- &error
- POP2 POP2 POP2 POP2 POP2
- JMP2r
-
-@file-read-chunks ( func* udata* buf* size* filename* -- func* udata'* buf* size* filename* )
-
- #0000 DUP2 ( F* U* B* SZ* FN* OL* OH* / )
- &resume
- ROT2 STH2 ( F* U* B* SZ* OL* OH* / FN* )
- ROT2 ( F* U* B* OL* OH* SZ* / FN* )
-
- &loop
- STH2kr .File/name DEO2 ( F* U* B* OL* OH* SZ* / FN* )
- STH2k ,ffwd/length STR2 ( F* U* B* OL* OH* / FN* SZ* )
- STH2 ( F* U* B* OL* / FN* SZ* OH* )
- STH2k ,ffwd/offset STR2 ( F* U* B* / FN* SZ* OH* OL* )
- DUP2 ,ffwd/addr STR2
- ,ffwd JSR
- SWP2 ( F* B* U* / FN* SZ* OH* OL* )
- ROT2k NIP2 ( F* B* U* B* F* / FN* SZ* OH* OL* )
- OVR2 .File/read DEO2 ( F* B* U* B* F* / FN* SZ* OH* OL* )
- .File/success DEI2 SWP2 ( F* B* U* B* length* F* / FN* SZ* OH* OL* )
- JSR2 ( F* B* U'* done-up-to* / FN* SZ* OH* OL* )
- ROT2 SWP2 ( F* U'* B* done-up-to* / FN* SZ* OH* OL* )
- SUB2k NIP2 ( F* U'* B* -done-length* / FN* SZ* OH* OL* )
- ORAk ,¬-end JCN ( F* U'* B* -done-length* / FN* SZ* OH* OL* )
-
- POP2 POP2r POP2r ( F* U'* B* / FN* SZ* )
- STH2r STH2r ( F* U'* B* SZ* FN* / )
- JMP2r
-
- ¬-end
- STH2r SWP2 ( F* U'* B* OL* -done-length* / FN* SZ* OH* )
- LTH2k JMP INC2r ( F* U'* B* OL* -done-length* / FN* SZ* OH'* )
- SUB2 ( F* U'* B* OL'* / FN* SZ* OH'* )
- STH2r STH2r ( F* U'* B* OL'* OH'* SZ* / FN* )
- ,&loop JMP
-
-@ffwd
- LIT2 &length $2
- LIT2 &offset $2
-
- &coarse ( length* offset* )
- GTH2k ,&fine JCN
- OVR2 .File/length DEO2
- ,&addr LDR2 .File/read DEO2
- OVR2 SUB2
- ,&coarse JMP
-
- &fine ( length* offset* )
- .File/length DEO2 ( length* )
- ,&addr LDR2 .File/read DEO2
- .File/length DEO2 ( )
- JMP2r
-
- &addr $2
-
-
-(
- Assemble a chunk of source code, which begins with whitespace or the start
- of a token and is divided up into tokens separated by whitespace. If the
- chunk ends with whitespace, assembled-up-to-ptr* will equal ptr* + len* and
- every token in the chunk will have been assembled. If the chunk ends with a
- non-whitespace character, assembled-up-to-ptr* will point to the beginning
- of the last token in the chunk.
-)
-
-@asma-assemble-chunk ( line^ chunk* len^ -- line^ assembled-up-to-chunk* )
- ROT2 STH2 ( chunk* len^ / line^ )
- OVR2 ADD2 ( chunk* end-chunk* / line^ )
- OVR2 ;asma-read-buffer EQU2 STH
- DUP2 ;asma-read-buffer/end NEQ2
- STHr AND ;asma/eof STA
- SWP2 STH2k ( end-chunk* chunk* / line^ start-of-token* )
-
- &loop ( end-chunk* char* / line^ start-of-token* )
- LDAk #21 LTH ,&whitespace JCN
- INC2 ,&loop JMP
-
- &whitespace ( end-chunk* ws-char* / line^ start-of-token* )
- GTH2k ,&within-chunk JCN
- ;asma/eof LDA ,&eof JCN
-
- ( reached the end of the chunk, start-of-token* is where we assembled up to )
- POP2 POP2 STH2r STH2r SWP2 JMP2r
-
- &within-chunk ( end-chunk* ws-char* / line^ start-of-token* )
- LDAk #0a NEQ ( end-chunk* ws-char* not-newline / line^ start-of-token* )
- #00 OVR2 STA
- STH2r ,asma-assemble-token JSR ( end-chunk* ws-char* not-newline / line^ )
- ;asma/error LDA2 ORA ,&error JCN
- ,¬-newline JCN
- ,asma/lines LDR2 INC2 ,asma/lines STR2
- ¬-newline ( end-chunk* ws-char* / line^ )
- ;asma/break LDA ,&break JCN
- INC2 STH2k ( end-chunk* start-of-token* / line^ start-of-token* )
- ,&loop JMP
-
- &break ( end-chunk* ws-char* / line^ )
- ( the read buffer has been invalidated, ws-char* plus one is where we assembled up to )
- ;asma/break LDA #01 SUB ;asma/break STA
- INC2 NIP2 ( assembled-up-to-ptr* / line^ )
- STH2r SWP2 JMP2r
-
- &error ( end-chunk* ws-char* not-newline / line^ )
- ( return no progress with assembly to make file-read-chunks exit )
- POP POP2 POP2
- STH2kr ;asma/line STA2
- STH2r ;asma-read-buffer
- JMP2r
-
- &eof ( end-chunk* ws-char* / line^ start-of-token* )
- ( reached the end of file, end-chunk* is safe to write since the buffer is bigger )
- ( return no progress with assembly to make file-read-chunks exit )
- POP2 ( end-chunk* / line^ start-of-token* )
- #00 ROT ROT STA ( / line^ start-of-token* )
- STH2r ,asma-assemble-token JSR ( / line^ )
- STH2r ;asma-read-buffer JMP2r
-
-@asma [
- &pass $1 &state $1 &line $2 &lines $2 &break $1 &eof $1
- &comment-level $1
- &token $2 &orig-token $2
- &addr $2 &written-addr $2 &flush-fn $2
- &src-filename $2 &dest-filename $2
- &error $2 &log-level $1
-]
-@asma-trees [ &labels $2 ¯os $2 &opcodes $2 &scope $2 ]
-
-(
- The main routine to assemble a single token.
- asma/state contains several meaningful bits:
- 0x02 we are in a comment,
- 0x04 we are in a macro body,
- 0x08 we are in a macro body that we are ignoring
- (because the macro was already defined in a previous pass).
- Since 0x08 never appears without 0x04, the lowest bit set in asma/state is
- always 0x00, 0x02, or 0x04, which is very handy for use with jump tables.
- The lowest bit set can be found easily by #00 (n) SUBk AND.
-)
-
-@asma-assemble-token ( string-ptr* -- )
- DUP2 ;asma/token STA2
- DUP2 ;asma/orig-token STA2
- LDAk ,¬-empty JCN
- POP2
- JMP2r
-
- ¬-empty ( token* / )
- ( truncate to one char long )
- INC2 ( end* / )
- STH2k LDAkr ( end* / end* char )
- STH2k ( end* / end* char end* )
- LITr 00 STH2 ( / end* char end* 00 end* )
- STAr ( / end* char end* )
-
- #00 ;asma/state LDA SUBk AND ( tree-offset* / end* )
- DUP2 ;&first-char-trees ADD2 ( tree-offset* incoming-ptr* / end* )
- ;asma-traverse-tree JSR2
-
- ( restore truncated char )
- STAr
-
- ,¬-found JCN
-
- ( tree-offset* token-routine-ptr* / end* )
- STH2r ;asma/token STA2
- NIP2 LDA2
- JMP2 ( tail call )
-
- ¬-found ( tree-offset* dummy* / end* )
- POP2 POP2r
- ;&body-routines ADD2 LDA2
- JMP2 ( tail call )
-
- &first-char-trees
- :asma-first-char-normal/_entry
- :asma-first-char-comment/_entry
- :asma-first-char-macro/_entry
-
- &body-routines
- :asma-normal-body
- :asma-ignore
- :asma-macro-body
-
-@asma-parse-hex-digit ( charcode -- 00-0f if valid hex
- OR 10-ff otherwise )
- DUP #3a LTH ,&digit JCN
- DUP #60 GTH ,&letter JCN
- JMP2r
-
- &digit
- #30 SUB
- JMP2r
-
- &letter
- #57 SUB
- JMP2r
-
-@asma-parse-hex-string ( strict -- value* 06 if valid hex and (length == 4 or (length == 3 and not strict))
- OR value* 03 if valid hex and (length == 2 or (length == 1 and not strict))
- OR 00 otherwise )
- STH
- ;asma/token LDA2 DUP2 ,strlen JSR ( token* length^ )
- DUP STHr AND ,&fail2 JCN
- DUP2 #0004 GTH2 ,&fail2 JCN
- ORAk #00 EQU ,&fail2 JCN
- #0002 GTH2 ROT ROT
- LIT2r 0000
-
- &loop
- LDAk
- DUP ,¬-end JCN
- POP POP2
- STH2r ROT INC DUPk ADD ADD
- JMP2r
-
- ¬-end
- ,asma-parse-hex-digit JSR
- DUP #f0 AND ,&fail JCN
- LITr 40 SFT2r
- LITr 00 STH ADD2r
- INC2
- ,&loop JMP
-
- &fail
- POP2r
- &fail2
- POP2 POP2
- #00
- JMP2r
-
-~projects/library/string.tal
-
-@asma-traverse-tree ( incoming-ptr* -- binary-ptr* 00 if key found
- OR node-incoming-ptr* 01 if key not found )
- ;asma/token LDA2
- ( fall through to traverse-tree )
-
-~projects/library/binary-tree.tal
-
-@asma-parse-opcode ( -- byte 00 if valid opcode
- OR 01 otherwise )
- ;asma/token LDA2
- DUP2 ,strlen JSR #0003 LTH2 ,&too-short JCN
-
- ( truncate to three chars long )
- #0003 ADD2 ( end* / )
- STH2k LDAkr ( end* / end* char )
- STH2k ( end* / end* char end* )
- LITr 00 STH2 ( / end* char end* 00 end* )
- STAr ( / end* char end* )
-
- ;asma-trees/opcodes ;asma-traverse-tree JSR2
- STAr
- ,¬-found JCN
-
- ;asma-opcodes/_disasm SUB2 #03 SFT2 ( 00 byte / end* )
- DUP #00 EQU ,&set-keep JCN ( force keep flag for LIT )
- &loop
- LDAkr STHr LIT2r 0001 ADD2r ( 00 byte char / end* )
- DUP ,¬-end JCN
- POP POP2r
- SWP
- JMP2r
-
- ¬-end
- DUP LIT "2 NEQ ,¬-two JCN
- POP LIT &short-flag $1 ORA ,&loop JMP
-
- ¬-two
- DUP LIT "r NEQ ,¬-return JCN
- POP LIT &return-flag $1 ORA ,&loop JMP
-
- ¬-return
- LIT "k NEQ ,¬-keep JCN
- &set-keep LIT &keep-flag $1 ORA ,&loop JMP
-
- ¬-keep ( 00 byte / end* )
- ¬-found ( incoming-ptr* / end* )
- POP2r
- &too-short ( token* / )
- POP2 #01
- JMP2r
-
-@asma-write-lit ( byte -- )
- LIT LIT ,asma-write-byte JSR
- ,asma-write-byte JSR
- JMP2r
-
-@asma-advance-addr ( delta* -- )
- ;asma/addr LDA2k ( delta* ptr* value* )
- ROT2 ADD2 ( ptr* new-value* )
- SWP2 STA2
- JMP2r
-
-@asma-write-short ( short -- )
- SWP
- ,asma-write-byte JSR
- ( fall through )
-
-@asma-write-byte ( byte -- )
- ;asma/addr LDA2 ;asma/written-addr LDA2
- LTH2k ,&rewound JCN
- &loop
- EQU2k ,&ready JCN
- #00 ,&write JSR
- INC2
- ,&loop JMP
-
- &rewound
- ;asma-msg-rewound ;asma/error STA2
- POP2 POP2 POP JMP2r
-
- &ready
- POP2 INC2
- DUP2 ;asma/addr STA2
- ;asma/written-addr STA2
-
- &write
- ,asma-output/ptr LDR2
- DUP2 ;asma-write-buffer/end EQU2 ,&flush JCN
- &after-flush
- STH2k STA
- STH2r INC2 ,asma-output/ptr STR2
- JMP2r
-
- &flush ( ptr* -- start-of-buffer* )
- ;asma-write-buffer SUB2k ( ptr* start* len* )
- ;asma/flush-fn LDA2 JSR2
- NIP2 ( start* )
- ,&after-flush JMP
-
-@asma-output [ &ptr $2 ]
-
-@asma-flush-ignore ( len* -- )
- POP2
- JMP2r
-
-@asma-flush-to-file ( len* -- )
- .File/length DEO2
- ;asma/dest-filename LDA2 .File/name DEO2
- ;asma-write-buffer .File/write DEO2
- JMP2r
-
-@asma-flush-to-console ( len* -- )
- ORAk ,¬-empty JCN
- POP2 JMP2r
-
- ¬-empty
- ;asma-write-buffer DUP2 ROT2 ADD2 SWP2 ( end* ptr* )
- &loop ( end* ptr* )
- LDAk .Console/write DEO
- INC2
- GTH2k ,&loop JCN
-
- POP2 POP2
- JMP2r
-
-~projects/library/heap.tal
-
-(
- First character routines.
- The following routines (that don't have a FORTH-like signature) are called
- to deal with tokens that begin with particular first letters, or (for
- -body routines) tokens that fail to match any first letter in their tree.
-)
-
-@asma-comment-more
- ;asma/token LDA2 ;strlen JSR2 ORA ,asma-ignore JCN
-@asma-comment-start
- ;asma/comment-level LDAk INC ROT ROT STA
- ;asma/state LDA #02 ORA ;asma/state STA
-@asma-ignore
- JMP2r
-
-@asma-comment-less
- ;asma/token LDA2 ;strlen JSR2 ORA ,asma-ignore JCN
- ;asma/comment-level LDAk #01 SUB DUP SWP2 STA ,asma-ignore JCN
-@asma-comment-end
- ;asma/state LDA #0c AND ;asma/state STA
- JMP2r
-
-@asma-macro-define
- ;asma/pass LDA ,&ignore-macro JCN
-
- ;asma-trees/macros ;asma-traverse-tree JSR2 ,¬-exist JCN
- POP2
- ;asma-msg-macro ;asma/error STA2
- JMP2r
-
- ¬-exist ( incoming-ptr* )
- ( define macro by creating new node )
- ;heap LDA2 SWP2 STA2
- #0000 ;append-heap-short JSR2 ( less-than pointer )
- #0000 ;append-heap-short JSR2 ( greater-than pointer )
- ;asma/token LDA2 ;append-heap-string JSR2 ( key )
- ;asma/state LDA #04 ORA ;asma/state STA
- JMP2r
-
- &ignore-macro
- ;asma/state LDA #0c ORA ;asma/state STA
- JMP2r
-
-@asma-macro-body
- ;asma/state LDA #08 AND ,&skip JCN
- ;asma/token LDA2 ;append-heap-string JSR2
- &skip
- JMP2r
-
-@asma-macro-end
- #00 ;append-heap-byte JSR2
- ;asma/state LDA #02 AND ;asma/state STA
- JMP2r
-
-@asma-label-define
- ;asma-trees/labels ,asma-label-helper JSR
- ,&already-existed JCN
-
- #0000 ;append-heap-short JSR2 ( data2: subtree incoming ptr )
-
- &already-existed
- #0002 ADD2 ;asma-trees/scope STA2
- JMP2r
-
-@asma-sublabel-define
- ;asma-trees/scope LDA2 ,asma-label-helper JSR
- POP POP2
- JMP2r
-
-@asma-label-helper ( incoming-ptr* -- binary-ptr* 01 if label existed already
- OR binary-ptr* 00 if label was created )
- ;asma-traverse-tree JSR2
- ,&new-label JCN
-
- ( label already exists )
- LDA2k ;asma/addr LDA2 EQU2 ,&address-match JCN
- ;asma-msg-redefined ;asma/error STA2
-
- &address-match
- #01 JMP2r
-
- &new-label ( incoming-ptr* )
- ( define label by creating new node )
- ;heap LDA2 SWP2 STA2
- #0000 ;append-heap-short JSR2 ( less-than pointer )
- #0000 ;append-heap-short JSR2 ( greater-than pointer )
- ;asma/token LDA2 ;append-heap-string JSR2 ( key )
-
- ;heap LDA2
-
- ;asma/addr LDA2 ;append-heap-short JSR2 ( data1: address )
- #00 JMP2r
-
-@asma-pad-absolute
- #0000 ;asma/addr STA2
- ( fall through )
-
-@asma-pad-relative
- #00 ;asma-parse-hex-string JSR2
- ,&valid JCN
-
- ;asma-msg-hex ;asma/error STA2
- JMP2r
-
- &valid
- ;asma-advance-addr JMP2 ( tail call )
-
-@asma-raw-word
- ;asma/token LDA2
-
- &loop
- LDAk
- DUP ,¬-end JCN
-
- POP POP2
- JMP2r
-
- ¬-end
- ;asma-write-byte JSR2
- INC2
- ,&loop JMP
-
-@asma-literal-abs-addr
- LIT LIT2 ;asma-write-byte JSR2
- ( fall through )
-
-@asma-abs-addr
- ,asma-addr-helper JSR
- ;asma-write-short JMP2 ( tail call )
-
-@asma-literal-zero-addr
- LIT LIT ;asma-write-byte JSR2
- ( fall through )
-
-@asma-zero-addr
- ,asma-addr-helper JSR
- ;asma-write-byte JSR2
-
- ,¬-zero-page JCN
- JMP2r
-
- ¬-zero-page
- ;asma/pass LDA #00 EQU
- ;asma/error LDA2 ORA
- ORA ,&ignore-error JCN
- ;asma-msg-zero-page ;asma/error STA2
- &ignore-error
- JMP2r
-
-@asma-jci
- #20 ,asma-jxi JMP ( tail call )
-
-@asma-jmi
- #40
- ( fall through )
-
-@asma-jxi
- ;asma-write-byte JSR2
- ,asma-addr-helper JSR
- ;asma/addr LDA2 SUB2
- #0002 SUB2
- ;asma-write-short JMP2 ( tail call )
-
-@asma-literal-rel-addr
- LIT LIT ;asma-write-byte JSR2
- ( fall through )
-
-@asma-rel-addr
- ,asma-addr-helper JSR
- ;asma/addr LDA2 SUB2
- #0002 SUB2
-
- DUP2 #0080 LTH2 STH
- DUP2 #ff7f GTH2 STHr ORA ,&in-bounds JCN
-
- POP2
- ;asma-msg-relative ;asma/error STA2
- JMP2r
-
- &in-bounds
- ;asma-write-byte JSR2
- POP
- JMP2r
-
-@asma-addr-helper ( -- addr* )
- ;asma/token LDA2 LDAk #26 NEQ ,¬-local JCN
- INC2 ;asma/token STA2
- ;asma-trees/scope LDA2
- ,&final-lookup JMP
-
- ¬-local ( token* )
- LDAk
- DUP ,¬-end JCN
- POP POP2
- ;asma-trees/labels
- ,&final-lookup JMP
-
- ¬-end ( token* char )
- #2f EQU ,&found-slash JCN
- INC2
- ,¬-local JMP
-
- &found-slash ( token* )
- DUP2 #00 ROT ROT STA
- ;asma-trees/labels ;asma-traverse-tree JSR2 STH
- SWP2 DUP2 #2f ROT ROT STA
- STHr ,¬-found2 JCN
- ( token* binary-ptr* )
- INC2 ;asma/token STA2
- #0002 ADD2
-
- &final-lookup ( addr-offset* incoming-ptr* )
- ;asma-traverse-tree JSR2
- ,¬-found JCN
- LDA2
- JMP2r
-
- ¬-found2 ( dummy* dummy* )
- POP2
- ¬-found ( dummy* )
- POP2
-
- ;asma/pass LDA #00 EQU ,&ignore-error JCN
- ;asma-msg-label ;asma/error STA2
- &ignore-error
-
- ;asma/addr LDA2
- JMP2r
-
-@asma-literal-hex
- #01 ;asma-parse-hex-string JSR2 JMP
- ( hex invalid ) ,&invalid JMP
- ( hex byte ) ,asma-byte-helper JMP
- ( hex short ) ,asma-short-helper JMP
-
- &invalid
- ;asma-msg-hex ;asma/error STA2
- JMP2r
-
-@asma-byte-helper ( dummy value -- )
- ;asma-write-lit JSR2
- POP
- JMP2r
- &raw
- ;asma-write-byte JSR2
- POP
- JMP2r
-
-@asma-short-helper ( value* -- )
- LIT LIT2 ;asma-write-byte JSR2
- &raw
- ;asma-write-short JMP2 ( tail call )
-
-@asma-normal-body
- ;asma-parse-opcode JSR2 ,¬-opcode JCN
- ;asma-write-byte JMP2 ( tail call )
-
- ¬-opcode
- #01 ;asma-parse-hex-string JSR2 JMP
- ( hex invalid ) ,¬-hex JMP
- ( hex byte ) ,asma-byte-helper/raw JMP
- ( hex short ) ,asma-short-helper/raw JMP
-
- ¬-hex
- ;asma-trees/macros ;asma-traverse-tree JSR2 ,¬-macro JCN
-
- ¯o-loop
- LDAk ,&keep-going JCN
- POP2
- JMP2r
-
- &keep-going
- DUP2k ;strlen JSR2 INC2 ADD2
- SWP2 ;asma-assemble-token JSR2 ;asma/error LDA2 ORA ,¯o-error JCN
- ,¯o-loop JMP
-
- ¯o-error
- POP2
- JMP2r
-
- ¬-macro
- POP2
- #60 ;asma-jxi JMP2 ( tail call )
-
-@asma-include
- ;heap LDA2
- ;asma/token LDA2 ;append-heap-string JSR2
- ;asma-assemble-file-pass JSR2
- ;asma/break LDAk INC ROT ROT STA
- JMP2r
-
-( Error messages )
-
-@asma-msg-hex "Invalid 20 "hexadecimal 00
-@asma-msg-zero-page "Address 20 "not 20 "in 20 "zero 20 "page 00
-@asma-msg-relative "Address 20 "outside 20 "range 00
-@asma-msg-label "Label 20 "not 20 "found 00
-@asma-msg-macro "Macro 20 "already 20 "exists 00
-@asma-msg-rewound "Memory 20 "overwrite 00
-@asma-msg-redefined "Label 20 "redefined 00
-
-( trees )
-
-( --- 8< ------- 8< --- cut here --- 8< ------- 8< --- )
-( automatically generated code below )
-( see etc/asma.moon for instructions )
-
-( label less greater key binary
- than than string data )
-
-@asma-first-char-comment
- &28 $2 $2 "( 00 :asma-comment-more
- &_entry :&28 $2 ") 00 :asma-comment-less
-
-@asma-first-char-macro
- &28 $2 $2 "( 00 :asma-comment-start
- &29 :&28 $2 ") 00 :asma-comment-end
- &_entry :&29 :&7d "{ 00 :asma-ignore
- &7d $2 $2 "} 00 :asma-macro-end
-
-@asma-first-char-normal
- &21 $2 $2 "! 00 :asma-jmi
- &22 :&21 $2 "" 00 :asma-raw-word
- &23 :&22 :&25 "# 00 :asma-literal-hex
- &24 $2 $2 "$ 00 :asma-pad-relative
- &25 :&24 $2 "% 00 :asma-macro-define
- &26 :&23 :&2c 26 00 ( & ) :asma-sublabel-define
- &28 $2 $2 "( 00 :asma-comment-start
- &29 :&28 $2 ") 00 :asma-comment-end
- &2c :&29 :&2d ", 00 :asma-literal-rel-addr
- &2d $2 $2 "- 00 :asma-zero-addr
- &_entry :&26 :&5f ". 00 :asma-literal-zero-addr
- &3a $2 $2 ": 00 :asma-abs-addr
- &3b :&3a $2 "; 00 :asma-literal-abs-addr
- &3d :&3b :&40 "= 00 :asma-abs-addr
- &3f $2 $2 "? 00 :asma-jci
- &40 :&3f $2 "@ 00 :asma-label-define
- &5f :&3d :&7d "_ 00 :asma-rel-addr
- &7b $2 $2 "{ 00 :asma-ignore
- &7c :&7b $2 "| 00 :asma-pad-absolute
- &7d :&7c :&7e "} 00 :asma-ignore
- &7e $2 $2 "~ 00 :asma-include
-
-@asma-opcodes
- &_entry :>H :&ROT &_disasm "LIT 00
- &INC $2 $2 "INC 00
- &POP $2 $2 "POP 00
- &NIP :&MUL :&OVR "NIP 00
- &SWP $2 $2 "SWP 00
- &ROT :&NIP :&STR "ROT 00
- &DUP $2 $2 "DUP 00
- &OVR :&ORA :&POP "OVR 00
- &EQU $2 $2 "EQU 00
- &NEQ $2 $2 "NEQ 00
- >H :&DIV :&JSR "GTH 00
- <H $2 $2 "LTH 00
- &JMP $2 $2 "JMP 00
- &JCN :&INC :&JMP "JCN 00
- &JSR :&JCN :&LDR "JSR 00
- &STH $2 $2 "STH 00
- &LDZ $2 $2 "LDZ 00
- &STZ $2 $2 "STZ 00
- &LDR :&LDA :&LDZ "LDR 00
- &STR :&STA :&SUB "STR 00
- &LDA $2 $2 "LDA 00
- &STA :&SFT :&STH "STA 00
- &DEI :&AND :&DEO "DEI 00
- &DEO $2 $2 "DEO 00
- &ADD $2 $2 "ADD 00
- &SUB :&STZ :&SWP "SUB 00
- &MUL :<H :&NEQ "MUL 00
- &DIV :&DEI :&EOR "DIV 00
- &AND :&ADD $2 "AND 00
- &ORA $2 $2 "ORA 00
- &EOR :&DUP :&EQU "EOR 00
- &SFT $2 $2 "SFT 00
-
diff --git a/projects/library/heap.tal b/projects/library/heap.tal
@@ -1,52 +0,0 @@
-(
- heap functions
-
- The heap is an area of memory that is written from the bottom up. These
- are a few convenience functions to do that writing.
-
- There is a global short called "heap" that must be written to before using
- these functions, otherwise the zero page and program memory could be
- overwritten.
-
- A simple program could use all unallocated memory for the heap like so:
-
- |0100 @reset
- ;my-heap ;heap STA2
-
- (the rest of your code)
-
- @my-heap
-
- Note that if there is a risk that the heap may overflow its bounds, it is
- strongly recommended to check where it is writing to. ";heap LDA2" will
- tell you where the next byte is written.
-)
-
-@heap $2
-
-@append-heap-byte ( byte -- )
- ,heap LDR2 ( byte heap* )
- INC2k ,heap STR2
- STA
- JMP2r
-
-@append-heap-short ( short^ -- )
- ,heap LDR2 ( short^ heap* )
- INC2k INC2 ,heap STR2
- STA2
- JMP2r
-
-@append-heap-string ( string* -- )
- ( copies a null-terminated string onto the heap, including the null )
- STH2 ,heap LDR2 ( heap* / string* )
- #01 JMP ( skip past INC2r )
-
- &loop
- INC2r ( heap* / string* )
- LDAkr DUPr STH2k STAr ( heap* / string* byte )
- INC2
- LITr f7 JCNr ( f7 is the value ",&loop" would produce )
- POP2r ( heap* )
- ,heap STR2
- JMP2r
-
diff --git a/projects/library/helpers.tal b/projects/library/helpers.tal
@@ -1,243 +0,0 @@
-%BYE { #01 .System/halt DEO BRK }
-%DEBUG { #ab .System/debug DEO }
-%IN-RANGE { ROT INCk SWP SUB2 GTH }
-%MOD { DIVk MUL SUB }
-%MOD2 { DIV2k MUL2 SUB2 }
-%NL { #0a .Console/write DEO }
-%SP { #20 .Console/write DEO }
-
-@print-string ( string* -- )
- LDAk ,¬-end JCN
- POP2 JMP2r
- ¬-end
- LDAk .Console/write DEO
- INC2
- ,print-string JMP
-
-@print-short-decimal ( short* -- )
- #03e8 DIV2k
- DUP ,print-byte-decimal/second JSR
- MUL2 SUB2
- #0064 DIV2k
- DUP ,print-byte-decimal/third JSR
- MUL2 SUB2
- NIP ,print-byte-decimal/second JMP
-
-@print-byte-decimal ( byte -- )
- #64 DIVk DUP #30 ADD .Console/write DEO MUL SUB
- &second
- #0a DIVk DUP #30 ADD .Console/write DEO MUL SUB
- &third
- #30 ADD .Console/write DEO
- JMP2r
-
-@print-32z-hex ( 32-zp -- )
- #00 SWP
- ,print-32-hex JMP
-
-@print-64z-hex ( 64-zp -- )
- #00 SWP
- ( fall through )
-
-@print-64-hex ( 64-ptr* -- )
- DUP2 #0004 ADD2 SWP2 ( lo32-ptr* hi32-ptr* )
- ,print-32-hex JSR
- ( fall through )
-
-@print-32-hex ( 32-ptr* -- )
- INC2k INC2 SWP2 ( lo-ptr* hi-ptr* )
- LDA2 ,print-short-hex JSR
- LDA2 ( fall through )
-
-@print-short-hex ( short* -- )
- SWP ,print-byte-hex JSR
- ( fall through )
-
-@print-byte-hex ( byte -- )
- DUP #04 SFT ,print-nibble-hex JSR
- #0f AND ( fall through )
-
-@print-nibble-hex ( nibble -- )
- #30 ADD DUP #39 GTH #07 MUL ADD .Console/write DEO
- JMP2r
-
-@next-input-byte ( -- number 00
- OR 01 at end of file )
- ,next-input-short JSR ,&eof JCN
- NIP #00
- JMP2r
-
- &eof
- #01
- JMP2r
-
-@next-input-short ( -- number* 00
- OR 01 at end of file )
- LIT2 &ptr :heap
- LIT2r 0000
- &ffwd
- LDAk #3039 IN-RANGE ,&number JCN
- INC2k SWP2 LDA ,&ffwd JCN
- ( eof )
- POP2 POP2r
- ;heap ,&ptr STR2
- #01 JMP2r
-
- &number
- LIT2r 000a MUL2r
- LDAk #30 SUB LITr 00 STH ADD2r
- INC2
- LDAk #3039 IN-RANGE ,&number JCN
-
- ,&ptr STR2
- STH2r #00
- JMP2r
-
-@add64 ( dest-ptr* src-ptr* -- carry )
- OVR2 #0004 ADD2 OVR2 #0004 ADD2
- ,add32 JSR
- ( fall through )
-
-@adc32 ( dest-ptr* src-ptr* carry -- carry )
- STH
- OVR2 #0002 ADD2 OVR2 #0002 ADD2
- STHr ,adc16 JSR
- ,adc16 JMP ( tail call )
-
-@add64z ( dest-zp src-zp -- carry )
- OVR #04 ADD OVR #04 ADD
- ,add32z JSR
- ( fall through )
-
-@adc32z ( dest-zp src-zp carry -- carry )
- STH
- OVR #02 ADD OVR #02 ADD
- STHr ,adc16z JSR
- ,adc16z JMP ( tail call )
-
-@add32z-short ( dest-zp src* -- carry )
- #00 SWP SWP2 ROT
- ( fall through )
-
-@add32-short ( dest-ptr* src* -- carry )
- ,&short STR2
- ;&src ,add32 JMP ( tail call )
-
- &src 0000 &short 0000
-
-@add32 ( dest-ptr* src-ptr* -- carry )
- OVR2 #0002 ADD2 OVR2 #0002 ADD2
- ,add16 JSR
- ( fall through )
-
-@adc16 ( dest-ptr* src-ptr* carry -- carry )
- #00 EQU ,add16 JCN
- OVR2 ;&one ,add16 JSR STH
- ,add16 JSR
- STHr ORA
- JMP2r
-
- &one 0001
-
-@add16 ( dest-ptr* src-ptr* -- carry )
- OVR2 LDA2 DUP2 ROT2 LDA2 ( dest-ptr* dest* dest* src* )
- ADD2 GTH2k STH NIP2 ( dest-ptr* sum* / carry )
- SWP2 STA2 STHr ( carry )
- JMP2r
-
-@add32z ( dest-zp src-zp -- carry )
- OVR #02 ADD OVR #02 ADD
- ,add16z JSR
- ( fall through )
-
-@adc16z ( dest-zp src-zp carry -- carry )
- #00 EQU ,add16z JCN
- OVR #00 SWP ;adc16/one ,add16 JSR STH
- ,add16z JSR
- STHr ORA
- JMP2r
-
-@add16z ( dest-zp src-zp -- carry )
- OVR LDZ2 ROT LDZ2 OVR2 ( dest-zp dest* src* dest* )
- ADD2 GTH2k STH NIP2 ( dest-zp sum* / carry )
- ROT STZ2 STHr ( carry )
- JMP2r
-
-@gth64 ( left-ptr* right-ptr* -- 01 if left > right
- OR 00 otherwise )
- OVR2 OVR2 ,gth32 JSR ,&greater JCN
- OVR2 OVR2 SWP2 ,gth32 JSR ,&less JCN
- #0004 ADD2 SWP2 #0004 ADD2 SWP2 ,gth32 JMP ( tail call )
-
- &greater POP2 POP2 #01 JMP2r
- &less POP2 POP2 #00 JMP2r
-
-@gth32z ( left-zp* right-zp* -- 01 if left > right
- OR 00 otherwise )
- #00 ROT ROT #00 SWP
- ( fall through )
-
-@gth32 ( left-ptr* right-ptr* -- 01 if left > right
- OR 00 otherwise )
- OVR2 LDA2 OVR2 LDA2 ( left-ptr* right-ptr* left* right* )
- EQU2k ,&lo JCN
- GTH2 NIP2 NIP NIP
- JMP2r
-
- &lo
- POP2 POP2
- INC2 INC2 LDA2 SWP2 INC2 INC2 LDA2 ( right-lo* left-lo* )
- LTH2
- JMP2r
-
-@add32z-short-short-mul ( dest-zp a* b* -- carry )
- STH2 STH2 #00 SWP STH2r STH2r
- ( fall through )
-
-@add32-short-short-mul ( dest-ptr* a* b* -- carry )
- LITr 00 STH LITr 00 STH ( dest-ptr* a* / blo* bhi* )
- #00 ROT ROT #00 SWP ( dest-ptr* ahi* alo* / blo* bhi* )
- STH2kr OVR2 MUL2 ,&alo-bhi STR2
- OVR2 STH2r MUL2 ,&ahi-bhi STR2 ( dest-ptr ahi* alo* / blo* )
- STH2kr MUL2 ,&alo-blo STR2 ( dest-ptr* ahi* / blo* )
- STH2r MUL2 ,&ahi-blo STR2 ( dest-ptr* )
- DUP2 ;&sum1 ;add32 JSR2 STH
- DUP2 ;&sum2 ;add32 JSR2 STH
- ;&sum3 ;add32 JSR2
- STH2r ORA ORA
- JMP2r
-
- &sum1 &ahi-bhi 0000 &alo-blo 0000
- &sum2 00 &ahi-blo 0000 00
- &sum3 00 &alo-bhi 0000 00
-
-@zero64 ( ptr* -- )
- #08 ,zero JMP ( tail call )
-
-@zero32z ( zp -- )
- #00 SWP
- ( fall through )
-
-@zero32 ( ptr* -- )
- #04
- ( fall through )
-
-@zero ( ptr* len -- )
- #00 SWP ADD2k NIP2 SWP2
- &loop
- DUP2 #00 ROT ROT STA
- INC2
- GTH2k ,&loop JCN
- POP2 POP2
- JMP2r
-
-@is-nonzero64 ( ptr* -- flag )
- DUP2 ,is-nonzero32 JSR STH
- #0004 ADD2 ,is-nonzero32 JSR STHr ORA
- JMP2r
-
-@is-nonzero32 ( ptr* -- flag )
- LDA2k ORA STH
- INC2 INC2 LDA2 ORA STHr ORA
- JMP2r
-
diff --git a/projects/software/calc.tal b/projects/software/calc.tal
@@ -1,692 +0,0 @@
-( simple graphical calculator )
-
-|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1
-|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
-|30 @Audio0 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
-|80 @Controller &vector $2 &button $1 &key $1
-|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &wheel $1
-|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
-
-|0000
-
-@input &value $2 &mode $1
-@stack &length $1 &items $10
-@center &x $2 &y $2
-@pointer &x $2 &y $2 &last $1
-@keypad-frame &x $2 &y $2 &x2 $2 &y2 $2
-@modpad-frame &x $2 &y $2 &x2 $2 &y2 $2
-@bitpad-frame &x $2 &y $2 &x2 $2 &y2 $2
-@input-frame &x $2 &y $2 &x2 $2 &y2 $2
-
-|0100 ( -> )
-
- ( theme )
- #0e7d .System/r DEO2
- #0ec6 .System/g DEO2
- #0e95 .System/b DEO2
- ( size )
- #0090 .Screen/width DEO2
- #0100 .Screen/height DEO2
- ( vectors )
- ;on-mouse .Mouse/vector DEO2
- ;on-button .Controller/vector DEO2
- ( setup synth )
- #0112 .Audio0/adsr DEO2
- ;sin-pcm .Audio0/addr DEO2
- #0100 .Audio0/length DEO2
- #88 .Audio0/volume DEO
- ( center )
- .Screen/width DEI2 #01 SFT2 .center/x STZ2
- .Screen/height DEI2 #01 SFT2 .center/y STZ2
- .center/x LDZ2 #0020 SUB2
- DUP2 .keypad-frame/x STZ2 #003f ADD2 .keypad-frame/x2 STZ2
- .center/y LDZ2 #0018 SUB2
- DUP2 .keypad-frame/y STZ2 #003f ADD2 .keypad-frame/y2 STZ2
- .keypad-frame/x LDZ2
- DUP2 .modpad-frame/x STZ2 #003f ADD2 .modpad-frame/x2 STZ2
- .keypad-frame/y LDZ2 #0040 ADD2
- DUP2 .modpad-frame/y STZ2 #001f ADD2 .modpad-frame/y2 STZ2
- .keypad-frame/x LDZ2
- DUP2 .bitpad-frame/x STZ2 #003f ADD2 .bitpad-frame/x2 STZ2
- .modpad-frame/y2 LDZ2 #0008 ADD2
- DUP2 .bitpad-frame/y STZ2 #000f ADD2 .bitpad-frame/y2 STZ2
- .center/x LDZ2 #0020 SUB2
- DUP2 .input-frame/x STZ2 #003f ADD2 .input-frame/x2 STZ2
- .center/y LDZ2 #002a SUB2
- DUP2 .input-frame/y STZ2 #000f ADD2 .input-frame/y2 STZ2
- ( theme support )
- ;load-theme JSR2
-
-BRK
-
-@on-button ( -> )
-
- .Controller/key DEI
- ( generics )
- [ #00 ] NEQk NIP ,&no-empty JCN ;redraw JSR2 POP BRK &no-empty
- [ #09 ] NEQk NIP ,&no-tab JCN ;toggle-mode JSR2 POP BRK &no-tab
- [ #0d ] NEQk NIP ,&no-enter JCN ;do-push JSR2 POP BRK &no-enter
- [ #1b ] NEQk NIP ,&no-esc JCN ;do-pop JSR2 POP BRK &no-esc
- [ #08 ] NEQk NIP ,&no-backspace JCN ;do-erase JSR2 POP BRK &no-backspace
- ( arithmetic )
- [ LIT "+ ] NEQk NIP ,&no-add JCN ;do-add JSR2 POP BRK &no-add
- [ LIT "- ] NEQk NIP ,&no-sub JCN ;do-sub JSR2 POP BRK &no-sub
- [ LIT "* ] NEQk NIP ,&no-mul JCN ;do-mul JSR2 POP BRK &no-mul
- [ LIT "/ ] NEQk NIP ,&no-div JCN ;do-div JSR2 POP BRK &no-div
- ( bitwise )
- [ LIT "& ] NEQk NIP ,&no-and JCN ;do-and JSR2 POP BRK &no-and
- [ LIT "| ] NEQk NIP ,&no-ora JCN ;do-ora JSR2 POP BRK &no-ora
- [ LIT "^ ] NEQk NIP ,&no-eor JCN ;do-eor JSR2 POP BRK &no-eor
- [ LIT "~ ] NEQk NIP ,&no-not JCN ;do-not JSR2 POP BRK &no-not
- ( value )
- ;key-value JSR2 ;push-input JSR2
-
-BRK
-
-@on-mouse ( -> )
-
- ;pointer-icn .Screen/addr DEO2
-
- ( clear last cursor )
- .pointer/x LDZ2 .Screen/x DEO2
- .pointer/y LDZ2 .Screen/y DEO2
- #40 .Screen/sprite DEO
-
- ( draw new cursor )
- .Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
- .Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
- #41 .Mouse/state DEI #01 EQU ADD .Screen/sprite DEO
-
- .Mouse/state DEI .pointer/last LDZ
- ( down )
- DUP2 #0100 NEQ2 ,&no-down JCN
- .Mouse/x DEI2 .Mouse/y DEI2
- OVR2 OVR2 .keypad-frame ;within-rect JSR2 ;click-keypad JCN2
- OVR2 OVR2 .input-frame ;within-rect JSR2 ;click-input JCN2
- OVR2 OVR2 .modpad-frame ;within-rect JSR2 ;click-modpad JCN2
- OVR2 OVR2 .bitpad-frame ;within-rect JSR2 ;click-bitpad JCN2
- ;toggle-mode JSR2
- POP2 POP2
- &no-down
- ( up )
- DUP2 #0001 NEQ2 ,&no-up JCN
- ;redraw JSR2
- &no-up
- POP2
- ( record )
- .Mouse/state DEI .pointer/last STZ
-
-BRK
-
-@click-keypad ( state* x* y* -> )
-
- ( y ) .keypad-frame/y LDZ2 SUB2 #24 SFT2
- ( x ) SWP2 .keypad-frame/x LDZ2 SUB2 #04 SFT2 #0003 AND2
- ( value ) ADD2 ;keypad/layout ADD2 LDA ;push-input JSR2
- #00 .Mouse/state DEO POP2
-
-BRK
-
-@click-modpad ( state* x* y* -> )
-
- ( y ) .modpad-frame/y LDZ2 SUB2 #24 SFT2 NIP STH
- ( x ) .modpad-frame/x LDZ2 SUB2 #04 SFT2
- ( lookup ) STHr ADD DUP2 ADD2 ;keypad/ops ADD2 LDA2 JSR2
- ;draw-bitpad JSR2
- #00 .Mouse/state DEO POP2
-
-BRK
-
-@click-input ( state* x* y* -> )
-
- POP2
- .input-frame/x LDZ2 SUB2 #03 SFT2 NIP
- DUP ,&no-push JCN
- ;do-push JSR2 &no-push
- DUP #01 NEQ ,&no-pop JCN
- ;do-pop JSR2 &no-pop
- POP
- #00 .Mouse/state DEO POP2
-
-BRK
-
-@click-bitpad ( state* x* y* -> )
-
- ( y ) .bitpad-frame/y LDZ2 SUB2 #33 SFT2 NIP STH
- ( x ) .bitpad-frame/x LDZ2 SUB2 #03 SFT2 NIP
- ( value ) STHr ADD STHk
-
- #30 ADD .Audio0/pitch DEO
-
- ( toggle bit )
- .input/value LDZ2 #0001
- [ STHr #0f SWP SUB ] #40 SFT SFT2 EOR2
- .input/value STZ2
-
- ;draw-bitpad JSR2
- #ff ;draw-input JSR2
- #00 .Mouse/state DEO POP2
-
-BRK
-
-@push-input ( key -- )
-
- DUP #50 ADD .Audio0/pitch DEO
- #00 OVR ;keypad/series ADD2 LDA ;draw-keypad JSR2
- ( hex/dec )
- #00 SWP .input/value LDZ2 #00 [ #0a #10 .input/mode LDZ JMP SWP POP ] MUL2
- ADD2 .input/value STZ2
- #ff ;draw-input JSR2
- ;draw-bitpad JSR2
-
-JMP2r
-
-@push ( value* -- )
-
- ( store ) .stack/length LDZ DUP ADD .stack/items ADD STZ2
- ( INCZ ) .stack/length LDZk INC SWP STZ
- ( reset ) #0000 .input/value STZ2
- #00 ;draw-input JSR2
- ;draw-stack JSR2
-
-JMP2r
-
-@pop ( -- value* )
-
- .stack/length LDZ #01 SUB DUP ADD .stack/items ADD LDZ2
- ( clear ) #0000 [ .stack/length LDZ #01 SUB DUP ADD .stack/items ADD ] STZ2
- ( DECZ ) .stack/length LDZk #01 SUB SWP STZ
- #01 ;draw-input JSR2
- ;draw-stack JSR2
-
-JMP2r
-
-@toggle-mode ( -- )
-
- .input/mode LDZk #00 EQU SWP STZ
- #30 .Audio0/pitch DEO
- ;redraw JSR2
-
-JMP2r
-
-@do-push ( -- )
-
- .input/value LDZ2 #0000 GTH2 JMP JMP2r
- .stack/length LDZ #07 LTH JMP JMP2r
- #40 .Audio0/pitch DEO
- .input/value LDZ2 ;push JSR2
- ;draw-bitpad JSR2
-
-JMP2r
-
-@do-pop ( -- )
-
- #0000 .input/value STZ2
- .stack/length LDZ #00 EQU ,&continue JCN
- #41 .Audio0/pitch DEO
- ;pop JSR2 POP2
- ;draw-stack JSR2
- &continue
- #01 ;draw-input JSR2
- ;draw-bitpad JSR2
-
-JMP2r
-
-@do-add ( -- )
-
- .input/value LDZ2 #0000 EQU2 ,&no-push JCN
- ;do-push JSR2
- &no-push
-
- ( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
-
- #42 .Audio0/pitch DEO
- #00 ;draw-modpad JSR2
- ;pop JSR2 ;pop JSR2 SWP2 ADD2 ;push JSR2
-
-JMP2r
-
-@do-sub ( -- )
-
- .input/value LDZ2 #0000 EQU2 ,&no-push JCN
- ;do-push JSR2
- &no-push
-
- ( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
-
- #43 .Audio0/pitch DEO
- #01 ;draw-modpad JSR2
- ;pop JSR2 ;pop JSR2 SWP2 SUB2 ;push JSR2
-
-JMP2r
-
-@do-mul ( -- )
-
- .input/value LDZ2 #0000 EQU2 ,&no-push JCN
- ;do-push JSR2
- &no-push
-
- ( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
-
- #44 .Audio0/pitch DEO
- #02 ;draw-modpad JSR2
- ;pop JSR2 ;pop JSR2 SWP2 MUL2 ;push JSR2
-
-JMP2r
-
-@do-div ( -- )
-
- .input/value LDZ2 #0000 EQU2 ,&no-push JCN
- ;do-push JSR2
- &no-push
-
- ( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
-
- #45 .Audio0/pitch DEO
- #03 ;draw-modpad JSR2
- ;pop JSR2 ;pop JSR2 SWP2 DIV2 ;push JSR2
-
-JMP2r
-
-@do-and ( -- )
-
- .input/value LDZ2 #0000 EQU2 ,&no-push JCN
- ;do-push JSR2
- &no-push
-
- ( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
-
- #46 .Audio0/pitch DEO
- #04 ;draw-modpad JSR2
- ;pop JSR2 ;pop JSR2 SWP2 AND2 ;push JSR2
-
-JMP2r
-
-@do-ora ( -- )
-
- .input/value LDZ2 #0000 EQU2 ,&no-push JCN
- ;do-push JSR2
- &no-push
-
- ( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
-
- #47 .Audio0/pitch DEO
- #05 ;draw-modpad JSR2
- ;pop JSR2 ;pop JSR2 SWP2 ORA2 ;push JSR2
-
-JMP2r
-
-@do-eor ( -- )
-
- .input/value LDZ2 #0000 EQU2 ,&no-push JCN
- ;do-push JSR2
- &no-push
-
- ( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
-
- #48 .Audio0/pitch DEO
- #06 ;draw-modpad JSR2
- ;pop JSR2 ;pop JSR2 SWP2 EOR2 ;push JSR2
-
-JMP2r
-
-@do-not ( -- )
-
- .input/value LDZ2 #0000 EQU2 ,&no-push JCN
- ;do-push JSR2
- &no-push
-
- ( stack empty ) .stack/length LDZ #00 GTH JMP JMP2r
-
- #49 .Audio0/pitch DEO
- #07 ;draw-modpad JSR2
- ;pop JSR2 #ffff EOR2 ;push JSR2
-
-JMP2r
-
-@do-erase ( -- )
-
- .input/value LDZ2 #04 SFT2 .input/value STZ2
- #ff ;draw-input JSR2
- ;draw-bitpad JSR2
-
-JMP2r
-
-@key-value ( key -- value )
-
- DUP #2f GTH OVR #3a LTH #0101 NEQ2 ,&no-num JCN
- #30 SUB JMP2r &no-num
- DUP #60 GTH OVR #67 LTH #0101 NEQ2 ,&no-lc JCN
- #57 SUB JMP2r ( #61 - #0a ADD ) &no-lc
- DUP #40 GTH OVR #47 LTH #0101 NEQ2 ,&no-uc JCN
- #37 SUB JMP2r ( #41 - #0a ADD ) &no-uc
- POP #00
-
-JMP2r
-
-@redraw ( -- )
-
- #ff ;draw-keypad JSR2
- #ff ;draw-modpad JSR2
- #ff ;draw-input JSR2
- ;draw-bitpad JSR2
- ;draw-mode JSR2
- ;draw-stack JSR2
-
- #0010 .Screen/x DEO2
- #0010 .Screen/y DEO2
-
-JMP2r
-
-@draw-mode ( -- )
-
- #26 .Screen/auto DEO
- .input-frame/x LDZ2 .Screen/x DEO2
- .input-frame/y LDZ2 #0014 SUB2 .Screen/y DEO2
- ;modes #00 .input/mode LDZ #0018 MUL2 ADD2 .Screen/addr DEO2
- #02 .input/mode LDZ ADD .Screen/sprite DEO
- #00 .Screen/auto DEO
-
-JMP2r
-
-@draw-stack ( -- )
-
- #08 #00
- &loop
- .input-frame/x LDZ2 #0018 ADD2 .Screen/x DEO2
- #00 OVR #30 SFT2 .input-frame/y LDZ2 ADD2 #004c SUB2 .Screen/y DEO2
- ( color ) DUP #08 .stack/length LDZ SUB #01 SUB GTH STH
- ( value ) DUP DUP ADD .stack/items ADD [ #10 .stack/length LDZ DUP ADD SUB SUB ] LDZ2
- STHr ;draw-number JSR2
- INC GTHk ,&loop JCN
- POP2
-
-JMP2r
-
-@draw-input ( key -- )
-
- STH
- ( draw value )
- .input-frame/x LDZ2 #0018 ADD2 .Screen/x DEO2
- .input-frame/y LDZ2 #0003 ADD2 .Screen/y DEO2
- .input/value LDZ2 #02 ;draw-number JSR2
- ( controls )
- .input-frame/x LDZ2
- .input-frame/y LDZ2
- ;stack-icns/push [ STHkr #00 EQU ] #02
- ;draw-key-thin JSR2
- .input-frame/x LDZ2 #0008 ADD2
- .input-frame/y LDZ2
- ;stack-icns/pop [ STHkr #01 EQU ] #03
- ;draw-key-thin JSR2
- ( line )
- .input-frame/x LDZ2
- .input-frame/x2 LDZ2
- .input-frame/y LDZ2 #0004 SUB2 #02
- ;line-hor-dotted JSR2
- POPr
-
-JMP2r
-
-@draw-keypad ( key -- )
-
- STH
- #10 #00
- &loop
- ( color ) #00 OVR ;keypad/color ADD2 LDA STH
- ( state ) DUP OVRr STHr EQU STH
- ( layout ) #00 OVR ;keypad/layout ADD2 LDA
- ( layout addr ) #00 SWP #30 SFT2 ;font-hex ADD2 STH2
- ( x ) #00 OVR #03 AND #40 SFT2 STH2
- ( y ) #00 OVR #42 SFT2
- ( origin-x ) STH2r .keypad-frame/x LDZ2 ADD2 SWP2
- ( origin-y ) .keypad-frame/y LDZ2 ADD2
- STH2r STHr STHr ;draw-key JSR2
- INC GTHk ,&loop JCN
- POP2
- POPr
-
-JMP2r
-
-@draw-modpad ( key -- )
-
- STH
- #08 #00
- &loop
- ( state ) DUP STHkr EQU STH
- ( glyph ) #00 OVR #30 SFT2 ;mod-icns ADD2 STH2
- ( y ) #00 OVR #42 SFT2 .modpad-frame/y LDZ2 ADD2 STH2
- ( x ) #00 OVR #03 AND #40 SFT2 .modpad-frame/x LDZ2 ADD2
- STH2r STH2r STHr #03 ;draw-key JSR2
- INC GTHk ,&loop JCN
- POP2
- POPr
-
-JMP2r
-
-@draw-bitpad ( -- )
-
- #1000
- &loop
- ( y ) #00 OVR #33 SFT2 .bitpad-frame/y LDZ2 ADD2 .Screen/y DEO2
- ( x ) #00 OVR #07 AND #30 SFT2 .bitpad-frame/x LDZ2 ADD2 .Screen/x DEO2
- ( state ) DUP #0f SWP SUB .input/value LDZ2 ROT SFT2 #0001 AND2
- ( addr ) #30 SFT2 ;bit-icns ADD2 .Screen/addr DEO2
- #01 .Screen/sprite DEO
- INC GTHk ,&loop JCN
- POP2
-
-JMP2r
-
-@draw-key ( x* y* glyph* state color -- )
-
- STH2
- #16 .Screen/auto DEO
- SWP2 .Screen/y DEO2
- SWP2 .Screen/x DEO2
- ( bg )
- ;button-icns [ #00 OVRr STHr #50 SFT2 ADD2 ] .Screen/addr DEO2
- STHkr .Screen/sprite DEOk DEO
- ( fg )
- .Screen/addr DEO2
- #00 .Screen/auto DEO
- .Screen/y DEI2k #000d SUB2 ROT DEO2
- .Screen/x DEI2k #0004 ADD2 ROT DEO2
- STHr [ STHr #09 MUL ADD ] .Screen/sprite DEO
-
-JMP2r
-
-@draw-key-thin ( x* y* glyph* state color -- )
-
- #06 .Screen/auto DEO
- ,&color STR ,&state STR ,&glyph STR2
- ( frame )
- ;button-thin-icns #00 [ LIT &state $1 ] #40 SFT2 ADD2 .Screen/addr DEO2
- .Screen/y DEO2 .Screen/x DEO2
- [ LIT &color $1 ] .Screen/sprite DEOk DEO
- ( glyph )
- [ LIT2 &glyph $2 ] .Screen/addr DEO2
- .Screen/y DEI2 #000c SUB2 .Screen/y DEO2
- #05 .Screen/sprite DEO
- #00 .Screen/auto DEO
-
-JMP2r
-
-@draw-number ( number* color -- )
-
- ,&color STR
- ( reset zero pad )
- #00 ;&zero STA
- ( hexadecimal )
- .input/mode LDZ ,&decimal JCN
- #01 .Screen/auto DEO
- #00 ,&digit JSR
- SWP ,&byte JSR
- &byte
- STHk #04 SFT ,&digit JSR
- STHr #0f AND
- &digit ( num -- )
- ,&addr JSR .Screen/addr DEO2
- [ LIT &color $1 ] .Screen/sprite DEO
- JMP2r
- &decimal ( num* -- )
- #01 .Screen/auto DEO
- #2710 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2
- #03e8 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2
- #0064 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2 NIP
- #0a DIVk DUP ,&digit JSR MUL SUB
- ,&digit JSR
- #00 .Screen/auto DEO
- JMP2r
- &addr ( num -- addr* )
- ,&zero LDR ,&padded JCN
- DUP ,&no-blank JCN
- POP ;blank-icn JMP2r
- &no-blank
- DUP ,&zero STR
- &padded #30 SFT #00 SWP ;font-hex ADD2
-
-JMP2r
- &zero $1
-
-( theme )
-
-@theme-txt ".theme $1
-
-@load-theme ( -- )
-
- ;theme-txt .File/name DEO2
- #0006 .File/length DEO2
- #fffa .File/read DEO2
-
- .File/success DEI2 #0006 NEQ2 ,&ignore JCN
- #fffa LDA2 .System/r DEO2
- #fffc LDA2 .System/g DEO2
- #fffe LDA2 .System/b DEO2
- &ignore
- ;redraw JSR2
-
-JMP2r
-
-@within-rect ( x* y* rect -- flag )
-
- STH
- ( y < rect.y1 ) DUP2 STHkr INC INC LDZ2 LTH2 ,&skip JCN
- ( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ,&skip JCN
- SWP2
- ( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ,&skip JCN
- ( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN
- POP2 POP2 POPr
- #01
-JMP2r
- &skip POP2 POP2 POPr #00 JMP2r
-
-@line-hor-dotted ( x0* x1* y* color -- )
-
- STH .Screen/y DEO2
- SWP2
- &loop
- ( save ) DUP2 .Screen/x DEO2
- ( draw ) STHkr .Screen/pixel DEO
- INC2 INC2 GTH2k ,&loop JCN
- POP2 POP2 POPr
-
-JMP2r
-
-( assets )
-
-@keypad
- &layout
- 0708 090f 0405 060e 0102 030d 000a 0b0c
- &series
- 0c08 090a 0405 0600 0102 0d0e 0f0b 0703
- &color
- 0101 0102 0101 0102 0101 0102 0102 0202
- &ops
- :do-add :do-sub :do-mul :do-div
- :do-and :do-ora :do-eor :do-not
-
-@sin-pcm
- 8083 8689 8c8f 9295 989b 9ea1 a4a7 aaad
- b0b3 b6b9 bbbe c1c3 c6c9 cbce d0d2 d5d7
- d9db dee0 e2e4 e6e7 e9eb ecee f0f1 f2f4
- f5f6 f7f8 f9fa fbfb fcfd fdfe fefe fefe
- fffe fefe fefe fdfd fcfb fbfa f9f8 f7f6
- f5f4 f2f1 f0ee eceb e9e7 e6e4 e2e0 dedb
- d9d7 d5d2 d0ce cbc9 c6c3 c1be bbb9 b6b3
- b0ad aaa7 a4a1 9e9b 9895 928f 8c89 8683
- 807d 7a77 7471 6e6b 6865 625f 5c59 5653
- 504d 4a47 4542 3f3d 3a37 3532 302e 2b29
- 2725 2220 1e1c 1a19 1715 1412 100f 0e0c
- 0b0a 0908 0706 0505 0403 0302 0202 0202
- 0102 0202 0202 0303 0405 0506 0708 090a
- 0b0c 0e0f 1012 1415 1719 1a1c 1e20 2225
- 2729 2b2e 3032 3537 3a3d 3f42 4547 4a4d
- 5053 5659 5c5f 6265 686b 6e71 7477 7a7d
-
-@font-hex
- 007c 8282 8282 827c 0030 1010 1010 1010
- 007c 8202 7c80 80fe 007c 8202 1c02 827c
- 000c 1424 4484 fe04 00fe 8080 7c02 827c
- 007c 8280 fc82 827c 00fe 0202 0408 1010
- 007c 8282 7c82 827c 007c 8282 7e02 827c
- 007c 8202 7e82 827e 00fc 8282 fc82 82fc
- 007c 8280 8080 827c 00fc 8282 8282 82fc
- 00fe 8080 fe80 80fe 00fe 8080 f080 8080
-
-@modes
- ( hex )
- 0082 8282 fe82 8282
- 00fe 8080 fe80 80fe
- 0082 4428 1028 4482
- ( dec )
- 00fc 8282 8282 82fc
- 00fe 8080 fe80 80fe
- 007c 8280 8080 827c
-
-@mod-icns
- 0010 1010 fe10 1010
- 0000 0000 fe00 0000
- 0082 4428 1028 4482
- 0002 0408 1020 4080
- 0070 8888 728a 847a
- 0010 1010 1010 1010
- 0000 1028 4482 0000
- 0000 0060 920c 0000
-
-@button-icns
- ( outline )
- 3f40 8080 8080 8080
- f804 0202 0202 0202
- 8080 8080 8040 3f00
- 0202 0202 0204 f800
- ( full )
- 3f7f ffff ffff ffff
- f8fc fefe fefe fefe
- ffff ffff ff7f 3f00
- fefe fefe fefc f800
-
-@button-thin-icns
- ( outline )
- 3844 8282 8282 8282
- 8282 8282 8244 3800
- ( full )
- 387c fefe fefe fefe
- fefe fefe fe7c 3800
-
-@bit-icns
- ( outline )
- 3844 8282 8244 3800
- ( full )
- 387c fefe fe7c 3800
-
-@stack-icns
- &push
- 0000 1028 1000 0000
- &pop
- 0000 2810 2800 0000
-
-@pointer-icn
- 80c0 e0f0 f8e0 1000
-
-@blank-icn
