From 127cb207d62b7f23449be0e2bf2585278a2454d1 Mon Sep 17 00:00:00 2001 From: Devine Lu Linvega Date: Sat, 9 Aug 2025 12:09:28 -0700 Subject: [PATCH] Removed old examples --- projects/examples/exercises/pig.tal | 70 -- projects/library/asma.tal | 962 ---------------------------- projects/library/heap.tal | 52 -- projects/library/helpers.tal | 243 ------- projects/software/calc.tal | 692 -------------------- 5 files changed, 2019 deletions(-) delete mode 100644 projects/examples/exercises/pig.tal delete mode 100644 projects/library/asma.tal delete mode 100644 projects/library/heap.tal delete mode 100644 projects/library/helpers.tal delete mode 100644 projects/software/calc.tal diff --git a/projects/examples/exercises/pig.tal b/projects/examples/exercises/pig.tal deleted file mode 100644 index d80a234..0000000 --- a/projects/examples/exercises/pig.tal +++ /dev/null @@ -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 deleted file mode 100644 index 04c7807..0000000 --- a/projects/library/asma.tal +++ /dev/null @@ -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 deleted file mode 100644 index 1f71a35..0000000 --- a/projects/library/heap.tal +++ /dev/null @@ -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 deleted file mode 100644 index 5267b37..0000000 --- a/projects/library/helpers.tal +++ /dev/null @@ -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 deleted file mode 100644 index d5ced4a..0000000 --- a/projects/software/calc.tal +++ /dev/null @@ -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