etc/uxn
0
0
Fork 0
mirror of https://git.sr.ht/~rabbits/uxn synced 2024-11-30 01:33:01 +00:00
Code Issues Projects Releases Wiki Activity

(calc.tal) Optimized to use screen/auto

Browse source
This commit is contained in:
neauoire 2022-03-15 11:03:09 -07:00
parent 5057dd160a
commit a63322e207
1 changed files with 183 additions and 244 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

421
projects/software/calc.tal
View file

@ -1,71 +1,22 @@
( simple graphical calculator ) ( simple graphical calculator )
%+ { ADD } %- { SUB } %* { MUL } %/ { DIV } |00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1
%< { LTH } %> { GTH } %= { EQU } %! { NEQ } |20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 } |30 @Audio0 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 } |80 @Controller &vector $2 &button $1 &key $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &wheel $1
%2* { #10 SFT } %2/ { #01 SFT } %2** { #10 SFT2 } %2// { #01 SFT2 } |a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
%4* { #20 SFT } %4/ { #02 SFT } %4** { #20 SFT2 } %4// { #02 SFT2 }
%8* { #30 SFT } %8/ { #03 SFT } %8** { #30 SFT2 } %8// { #03 SFT2 }
%10* { #40 SFT } %10/ { #04 SFT } %10** { #40 SFT2 } %10// { #04 SFT2 }
%20* { #50 SFT } %20/ { #05 SFT } %20** { #50 SFT2 } %20// { #05 SFT2 }
%2MOD { #01 AND } %2MOD2 { #0001 AND2 }
%4MOD { #03 AND } %4MOD2 { #0003 AND2 }
%8MOD { #07 AND } %8MOD2 { #0007 AND2 }
%10MOD { #0f AND } %10MOD2 { #000f AND2 }
%!~ { NEQk NIP }
%DEBUG { ;print-hex/byte JSR2 #0a .Console/write DEO }
%DEBUG2 { ;print-hex/short JSR2 #0a .Console/write DEO }
%AUTO-NONE { #00 .Screen/auto DEO }
%AUTO-X { #01 .Screen/auto DEO }
%AUTO-XADDR { #05 .Screen/auto DEO }
%AUTO-YADDR { #06 .Screen/auto DEO }
%RELEASE-MOUSE { #0096 DEO }
%RTN { JMP2r }
%RTN? { JMP RTN }
%TOS { #00 SWP }
( devices )
|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1 ]
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $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 ]
( variables )
|0000 |0000
@input @input &value $2 &mode $1
&value $2 @stack &length $1 &items $10
&mode $1 @center &x $2 &y $2
@stack @pointer &x $2 &y $2 &last $1
&length $1 @keypad-frame &x $2 &y $2 &x2 $2 &y2 $2
&items $10 @modpad-frame &x $2 &y $2 &x2 $2 &y2 $2
@center @bitpad-frame &x $2 &y $2 &x2 $2 &y2 $2
&x $2 &y $2 @input-frame &x $2 &y $2 &x2 $2 &y2 $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
( program )
|0100 ( -> ) |0100 ( -> )
@ -73,45 +24,36 @@
#0e7d .System/r DEO2 #0e7d .System/r DEO2
#0ec6 .System/g DEO2 #0ec6 .System/g DEO2
#0e95 .System/b DEO2 #0e95 .System/b DEO2
( size ) ( size )
#0090 .Screen/width DEO2 #0090 .Screen/width DEO2
#0100 .Screen/height DEO2 #0100 .Screen/height DEO2
( vectors ) ( vectors )
;on-mouse .Mouse/vector DEO2 ;on-mouse .Mouse/vector DEO2
;on-button .Controller/vector DEO2 ;on-button .Controller/vector DEO2
( setup synth ) ( setup synth )
#0112 .Audio0/adsr DEO2 #0112 .Audio0/adsr DEO2
;sin-pcm .Audio0/addr DEO2 ;sin-pcm .Audio0/addr DEO2
#0100 .Audio0/length DEO2 #0100 .Audio0/length DEO2
#88 .Audio0/volume DEO #88 .Audio0/volume DEO
( center ) ( center )
.Screen/width DEI2 2// .center/x STZ2 .Screen/width DEI2 #01 SFT2 .center/x STZ2
.Screen/height DEI2 2// .center/y STZ2 .Screen/height DEI2 #01 SFT2 .center/y STZ2
.center/x LDZ2 #0020 SUB2
.center/x LDZ2 #0020 -- DUP2 .keypad-frame/x STZ2 #0040 ADD2 .keypad-frame/x2 STZ2
DUP2 .keypad-frame/x STZ2 #0040 ++ .keypad-frame/x2 STZ2 .center/y LDZ2 #0018 SUB2
.center/y LDZ2 #0018 -- DUP2 .keypad-frame/y STZ2 #003f ADD2 .keypad-frame/y2 STZ2
DUP2 .keypad-frame/y STZ2 #003f ++ .keypad-frame/y2 STZ2
.keypad-frame/x LDZ2 .keypad-frame/x LDZ2
DUP2 .modpad-frame/x STZ2 #0040 ++ .modpad-frame/x2 STZ2 DUP2 .modpad-frame/x STZ2 #0040 ADD2 .modpad-frame/x2 STZ2
.keypad-frame/y LDZ2 #0040 ++ .keypad-frame/y LDZ2 #0040 ADD2
DUP2 .modpad-frame/y STZ2 #001f ++ .modpad-frame/y2 STZ2 DUP2 .modpad-frame/y STZ2 #001f ADD2 .modpad-frame/y2 STZ2
.keypad-frame/x LDZ2 .keypad-frame/x LDZ2
DUP2 .bitpad-frame/x STZ2 #0040 ++ .bitpad-frame/x2 STZ2 DUP2 .bitpad-frame/x STZ2 #0040 ADD2 .bitpad-frame/x2 STZ2
.modpad-frame/y2 LDZ2 #0008 ++ .modpad-frame/y2 LDZ2 #0008 ADD2
DUP2 .bitpad-frame/y STZ2 #000f ++ .bitpad-frame/y2 STZ2 DUP2 .bitpad-frame/y STZ2 #000f ADD2 .bitpad-frame/y2 STZ2
.center/x LDZ2 #0020 SUB2
.center/x LDZ2 #0020 -- DUP2 .input-frame/x STZ2 #0040 ADD2 .input-frame/x2 STZ2
DUP2 .input-frame/x STZ2 #0040 ++ .input-frame/x2 STZ2 .center/y LDZ2 #002a SUB2
.center/y LDZ2 #002a -- DUP2 .input-frame/y STZ2 #0010 ADD2 .input-frame/y2 STZ2
DUP2 .input-frame/y STZ2 #0010 ++ .input-frame/y2 STZ2
( theme support ) ( theme support )
;load-theme JSR2 ;load-theme JSR2
@ -121,21 +63,21 @@ BRK
.Controller/key DEI .Controller/key DEI
( generics ) ( generics )
#00 !~ ,&no-empty JCN ;redraw JSR2 POP BRK &no-empty [ #00 ] NEQk NIP ,&no-empty JCN ;redraw JSR2 POP BRK &no-empty
#09 !~ ,&no-tab JCN ;toggle-mode JSR2 POP BRK &no-tab [ #09 ] NEQk NIP ,&no-tab JCN ;toggle-mode JSR2 POP BRK &no-tab
#0d !~ ,&no-enter JCN ;do-push JSR2 POP BRK &no-enter [ #0d ] NEQk NIP ,&no-enter JCN ;do-push JSR2 POP BRK &no-enter
#1b !~ ,&no-esc JCN ;do-pop JSR2 POP BRK &no-esc [ #1b ] NEQk NIP ,&no-esc JCN ;do-pop JSR2 POP BRK &no-esc
#08 !~ ,&no-backspace JCN ;do-erase JSR2 POP BRK &no-backspace [ #08 ] NEQk NIP ,&no-backspace JCN ;do-erase JSR2 POP BRK &no-backspace
( arithmetic ) ( arithmetic )
LIT '+ !~ ,&no-add JCN ;do-add JSR2 POP BRK &no-add [ LIT '+ ] NEQk NIP ,&no-add JCN ;do-add JSR2 POP BRK &no-add
LIT '- !~ ,&no-sub JCN ;do-sub JSR2 POP BRK &no-sub [ LIT '- ] NEQk NIP ,&no-sub JCN ;do-sub JSR2 POP BRK &no-sub
LIT '* !~ ,&no-mul JCN ;do-mul JSR2 POP BRK &no-mul [ LIT '* ] NEQk NIP ,&no-mul JCN ;do-mul JSR2 POP BRK &no-mul
LIT '/ !~ ,&no-div JCN ;do-div JSR2 POP BRK &no-div [ LIT '/ ] NEQk NIP ,&no-div JCN ;do-div JSR2 POP BRK &no-div
( bitwise ) ( bitwise )
LIT '& !~ ,&no-and JCN ;do-and JSR2 POP BRK &no-and [ LIT '& ] NEQk NIP ,&no-and JCN ;do-and JSR2 POP BRK &no-and
LIT '| !~ ,&no-ora JCN ;do-ora JSR2 POP BRK &no-ora [ LIT '| ] NEQk NIP ,&no-ora JCN ;do-ora JSR2 POP BRK &no-ora
LIT '^ !~ ,&no-eor JCN ;do-eor JSR2 POP BRK &no-eor [ LIT '^ ] NEQk NIP ,&no-eor JCN ;do-eor JSR2 POP BRK &no-eor
LIT '~ !~ ,&no-not JCN ;do-not JSR2 POP BRK &no-not [ LIT '~ ] NEQk NIP ,&no-not JCN ;do-not JSR2 POP BRK &no-not
( value ) ( value )
;key-value JSR2 ;push-input JSR2 ;key-value JSR2 ;push-input JSR2
@ -153,11 +95,11 @@ BRK
( draw new cursor ) ( draw new cursor )
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2 .Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2 .Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
#41 .Mouse/state DEI #01 = + .Screen/sprite DEO #41 .Mouse/state DEI #01 EQU ADD .Screen/sprite DEO
.Mouse/state DEI .pointer/last LDZ .Mouse/state DEI .pointer/last LDZ
( down ) ( down )
DUP2 #0100 !! ,&no-down JCN DUP2 #0100 NEQ2 ,&no-down JCN
.Mouse/x DEI2 .Mouse/y DEI2 .Mouse/x DEI2 .Mouse/y DEI2
OVR2 OVR2 .keypad-frame ;within-rect JSR2 ;click-keypad JCN2 OVR2 OVR2 .keypad-frame ;within-rect JSR2 ;click-keypad JCN2
OVR2 OVR2 .input-frame ;within-rect JSR2 ;click-input JCN2 OVR2 OVR2 .input-frame ;within-rect JSR2 ;click-input JCN2
@ -167,7 +109,7 @@ BRK
POP2 POP2 POP2 POP2
&no-down &no-down
( up ) ( up )
DUP2 #0001 !! ,&no-up JCN DUP2 #0001 NEQ2 ,&no-up JCN
;redraw JSR2 ;redraw JSR2
&no-up &no-up
POP2 POP2
@ -178,109 +120,109 @@ BRK
@click-keypad ( state* x* y* -> ) @click-keypad ( state* x* y* -> )
( y ) .keypad-frame/y LDZ2 -- #24 SFT2 ( y ) .keypad-frame/y LDZ2 SUB2 #24 SFT2
( x ) SWP2 .keypad-frame/x LDZ2 -- 10// 4MOD2 ( x ) SWP2 .keypad-frame/x LDZ2 SUB2 #04 SFT2 #0003 AND2
( value ) ++ ;keypad/layout ++ LDA ;push-input JSR2 ( value ) ADD2 ;keypad/layout ADD2 LDA ;push-input JSR2
RELEASE-MOUSE POP2 #00 .Mouse/state DEO POP2
BRK BRK
@click-modpad ( state* x* y* -> ) @click-modpad ( state* x* y* -> )
( y ) .modpad-frame/y LDZ2 -- #24 SFT2 NIP STH ( y ) .modpad-frame/y LDZ2 SUB2 #24 SFT2 NIP STH
( x ) .modpad-frame/x LDZ2 -- 10// ( x ) .modpad-frame/x LDZ2 SUB2 #04 SFT2
( lookup ) STHr + 2** ;keypad/ops ++ LDA2 JSR2 ( lookup ) STHr ADD #10 SFT2 ;keypad/ops ADD2 LDA2 JSR2
;draw-bitpad JSR2 ;draw-bitpad JSR2
RELEASE-MOUSE POP2 #00 .Mouse/state DEO POP2
BRK BRK
@click-input ( state* x* y* -> ) @click-input ( state* x* y* -> )
POP2 POP2
.input-frame/x LDZ2 -- 8// NIP .input-frame/x LDZ2 SUB2 #03 SFT2 NIP
DUP #00 ! ,&no-push JCN DUP #00 NEQ ,&no-push JCN
;do-push JSR2 &no-push ;do-push JSR2 &no-push
DUP #01 ! ,&no-pop JCN DUP #01 NEQ ,&no-pop JCN
;do-pop JSR2 &no-pop ;do-pop JSR2 &no-pop
POP POP
RELEASE-MOUSE POP2 #00 .Mouse/state DEO POP2
BRK BRK
@click-bitpad ( state* x* y* -> ) @click-bitpad ( state* x* y* -> )
( y ) .bitpad-frame/y LDZ2 -- 8// NIP 8* STH ( y ) .bitpad-frame/y LDZ2 SUB2 #03 SFT2 NIP #30 SFT STH
( x ) .bitpad-frame/x LDZ2 -- 8// NIP ( x ) .bitpad-frame/x LDZ2 SUB2 #03 SFT2 NIP
( value ) STHr + STHk ( value ) STHr ADD STHk
#30 + .Audio0/pitch DEO #30 ADD .Audio0/pitch DEO
( toggle bit ) ( toggle bit )
.input/value LDZ2 #0001 .input/value LDZ2 #0001
[ STHr #0f SWP - ] #40 SFT SFT2 EOR2 [ STHr #0f SWP SUB ] #40 SFT SFT2 EOR2
.input/value STZ2 .input/value STZ2
;draw-bitpad JSR2 ;draw-bitpad JSR2
#ff ;draw-input JSR2 #ff ;draw-input JSR2
RELEASE-MOUSE POP2 #00 .Mouse/state DEO POP2
BRK BRK
@push-input ( key -- ) @push-input ( key -- )
DUP #50 + .Audio0/pitch DEO DUP #50 ADD .Audio0/pitch DEO
#00 OVR ;keypad/series ++ LDA ;draw-keypad JSR2 #00 OVR ;keypad/series ADD2 LDA ;draw-keypad JSR2
( hex/dec ) ( hex/dec )
TOS .input/value LDZ2 #00 [ #0a #10 .input/mode LDZ JMP SWP POP ] ** #00 SWP .input/value LDZ2 #00 [ #0a #10 .input/mode LDZ JMP SWP POP ] MUL2
++ .input/value STZ2 ADD2 .input/value STZ2
#ff ;draw-input JSR2 #ff ;draw-input JSR2
;draw-bitpad JSR2 ;draw-bitpad JSR2
RTN JMP2r
@push ( value* -- ) @push ( value* -- )
( store ) .stack/length LDZ 2* .stack/items + STZ2 ( store ) .stack/length LDZ #10 SFT .stack/items ADD STZ2
( INCZ ) .stack/length LDZk INC SWP STZ ( INCZ ) .stack/length LDZk INC SWP STZ
( reset ) #0000 .input/value STZ2 ( reset ) #0000 .input/value STZ2
#00 ;draw-input JSR2 #00 ;draw-input JSR2
;draw-stack JSR2 ;draw-stack JSR2
RTN JMP2r
@pop ( -- value* ) @pop ( -- value* )
.stack/length LDZ #01 - 2* .stack/items + LDZ2 .stack/length LDZ #01 SUB #10 SFT .stack/items ADD LDZ2
( clear ) #0000 [ .stack/length LDZ #01 - 2* .stack/items + ] STZ2 ( clear ) #0000 [ .stack/length LDZ #01 SUB #10 SFT .stack/items ADD ] STZ2
( DECZ ) .stack/length LDZk #01 - SWP STZ ( DECZ ) .stack/length LDZk #01 SUB SWP STZ
#01 ;draw-input JSR2 #01 ;draw-input JSR2
;draw-stack JSR2 ;draw-stack JSR2
RTN JMP2r
@toggle-mode ( -- ) @toggle-mode ( -- )
.input/mode LDZk #00 = SWP STZ .input/mode LDZk #00 EQU SWP STZ
#30 .Audio0/pitch DEO #30 .Audio0/pitch DEO
;redraw JSR2 ;redraw JSR2
RTN JMP2r
@do-push ( -- ) @do-push ( -- )
.input/value LDZ2 ADD #00 > JMP RTN .input/value LDZ2 ADD #00 GTH JMP JMP2r
.stack/length LDZ #07 < JMP RTN .stack/length LDZ #07 LTH JMP JMP2r
#40 .Audio0/pitch DEO #40 .Audio0/pitch DEO
.input/value LDZ2 ;push JSR2 .input/value LDZ2 ;push JSR2
;draw-bitpad JSR2 ;draw-bitpad JSR2
RTN JMP2r
@do-pop ( -- ) @do-pop ( -- )
#0000 .input/value STZ2 #0000 .input/value STZ2
.stack/length LDZ #00 = ,&continue JCN .stack/length LDZ #00 EQU ,&continue JCN
#41 .Audio0/pitch DEO #41 .Audio0/pitch DEO
;pop JSR2 POP2 ;pop JSR2 POP2
;draw-stack JSR2 ;draw-stack JSR2
@ -288,119 +230,119 @@ RTN
#01 ;draw-input JSR2 #01 ;draw-input JSR2
;draw-bitpad JSR2 ;draw-bitpad JSR2
RTN JMP2r
@do-add ( -- ) @do-add ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN .input/value LDZ2 #0000 EQU2 ,&no-push JCN
;do-push JSR2 ;do-push JSR2
&no-push &no-push
( stack empty ) .stack/length LDZ #01 > RTN? ( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
#42 .Audio0/pitch DEO #42 .Audio0/pitch DEO
#00 ;draw-modpad JSR2 #00 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 ADD2 ;push JSR2 ;pop JSR2 ;pop JSR2 SWP2 ADD2 ;push JSR2
RTN JMP2r
@do-sub ( -- ) @do-sub ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN .input/value LDZ2 #0000 EQU2 ,&no-push JCN
;do-push JSR2 ;do-push JSR2
&no-push &no-push
( stack empty ) .stack/length LDZ #01 > RTN? ( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
#43 .Audio0/pitch DEO #43 .Audio0/pitch DEO
#01 ;draw-modpad JSR2 #01 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 SUB2 ;push JSR2 ;pop JSR2 ;pop JSR2 SWP2 SUB2 ;push JSR2
RTN JMP2r
@do-mul ( -- ) @do-mul ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN .input/value LDZ2 #0000 EQU2 ,&no-push JCN
;do-push JSR2 ;do-push JSR2
&no-push &no-push
( stack empty ) .stack/length LDZ #01 > RTN? ( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
#44 .Audio0/pitch DEO #44 .Audio0/pitch DEO
#02 ;draw-modpad JSR2 #02 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 MUL2 ;push JSR2 ;pop JSR2 ;pop JSR2 SWP2 MUL2 ;push JSR2
RTN JMP2r
@do-div ( -- ) @do-div ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN .input/value LDZ2 #0000 EQU2 ,&no-push JCN
;do-push JSR2 ;do-push JSR2
&no-push &no-push
( stack empty ) .stack/length LDZ #01 > RTN? ( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
#45 .Audio0/pitch DEO #45 .Audio0/pitch DEO
#03 ;draw-modpad JSR2 #03 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 DIV2 ;push JSR2 ;pop JSR2 ;pop JSR2 SWP2 DIV2 ;push JSR2
RTN JMP2r
@do-and ( -- ) @do-and ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN .input/value LDZ2 #0000 EQU2 ,&no-push JCN
;do-push JSR2 ;do-push JSR2
&no-push &no-push
( stack empty ) .stack/length LDZ #01 > RTN? ( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
#46 .Audio0/pitch DEO #46 .Audio0/pitch DEO
#04 ;draw-modpad JSR2 #04 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 AND2 ;push JSR2 ;pop JSR2 ;pop JSR2 SWP2 AND2 ;push JSR2
RTN JMP2r
@do-ora ( -- ) @do-ora ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN .input/value LDZ2 #0000 EQU2 ,&no-push JCN
;do-push JSR2 ;do-push JSR2
&no-push &no-push
( stack empty ) .stack/length LDZ #01 > RTN? ( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
#47 .Audio0/pitch DEO #47 .Audio0/pitch DEO
#05 ;draw-modpad JSR2 #05 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 ORA2 ;push JSR2 ;pop JSR2 ;pop JSR2 SWP2 ORA2 ;push JSR2
RTN JMP2r
@do-eor ( -- ) @do-eor ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN .input/value LDZ2 #0000 EQU2 ,&no-push JCN
;do-push JSR2 ;do-push JSR2
&no-push &no-push
( stack empty ) .stack/length LDZ #01 > RTN? ( stack empty ) .stack/length LDZ #01 GTH JMP JMP2r
#48 .Audio0/pitch DEO #48 .Audio0/pitch DEO
#06 ;draw-modpad JSR2 #06 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 EOR2 ;push JSR2 ;pop JSR2 ;pop JSR2 SWP2 EOR2 ;push JSR2
RTN JMP2r
@do-not ( -- ) @do-not ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN .input/value LDZ2 #0000 EQU2 ,&no-push JCN
;do-push JSR2 ;do-push JSR2
&no-push &no-push
( stack empty ) .stack/length LDZ #00 > RTN? ( stack empty ) .stack/length LDZ #00 GTH JMP JMP2r
#49 .Audio0/pitch DEO #49 .Audio0/pitch DEO
#07 ;draw-modpad JSR2 #07 ;draw-modpad JSR2
;pop JSR2 #ffff EOR2 ;push JSR2 ;pop JSR2 #ffff EOR2 ;push JSR2
RTN JMP2r
@do-erase ( -- ) @do-erase ( -- )
@ -408,19 +350,19 @@ RTN
#ff ;draw-input JSR2 #ff ;draw-input JSR2
;draw-bitpad JSR2 ;draw-bitpad JSR2
RTN JMP2r
@key-value ( key -- value ) @key-value ( key -- value )
DUP #2f > OVR #3a < #0101 !! ,&no-num JCN DUP #2f GTH OVR #3a LTH #0101 NEQ2 ,&no-num JCN
#30 - RTN &no-num #30 SUB JMP2r &no-num
DUP #60 > OVR #67 < #0101 !! ,&no-lc JCN DUP #60 GTH OVR #67 LTH #0101 NEQ2 ,&no-lc JCN
#57 - RTN ( #61 - #0a + ) &no-lc #57 SUB JMP2r ( #61 - #0a ADD ) &no-lc
DUP #40 > OVR #47 < #0101 !! ,&no-uc JCN DUP #40 GTH OVR #47 LTH #0101 NEQ2 ,&no-uc JCN
#37 - RTN ( #41 - #0a + ) &no-uc #37 SUB JMP2r ( #41 - #0a ADD ) &no-uc
POP #00 POP #00
RTN JMP2r
@redraw ( -- ) @redraw ( -- )
@ -434,144 +376,141 @@ RTN
#0010 .Screen/x DEO2 #0010 .Screen/x DEO2
#0010 .Screen/y DEO2 #0010 .Screen/y DEO2
RTN JMP2r
@draw-mode ( -- ) @draw-mode ( -- )
AUTO-XADDR #26 .Screen/auto DEO
.input-frame/x LDZ2 .Screen/x DEO2 .input-frame/x LDZ2 .Screen/x DEO2
.input-frame/y LDZ2 #0014 -- .Screen/y DEO2 .input-frame/y LDZ2 #0014 SUB2 .Screen/y DEO2
;modes #00 .input/mode LDZ #0018 MUL2 ++ .Screen/addr DEO2 ;modes #00 .input/mode LDZ #0018 MUL2 ADD2 .Screen/addr DEO2
#02 .input/mode LDZ + .Screen/sprite DEOk DEOk DEO #02 .input/mode LDZ ADD .Screen/sprite DEO
AUTO-NONE #00 .Screen/auto DEO
RTN JMP2r
@draw-stack ( -- ) @draw-stack ( -- )
#08 #00 #08 #00
&loop &loop
.input-frame/x LDZ2 #0018 ++ .Screen/x DEO2 .input-frame/x LDZ2 #0018 ADD2 .Screen/x DEO2
#00 OVR 8** .input-frame/y LDZ2 ++ #004c -- .Screen/y DEO2 #00 OVR #30 SFT2 .input-frame/y LDZ2 ADD2 #004c SUB2 .Screen/y DEO2
( color ) DUP #08 .stack/length LDZ - #01 - > STH ( color ) DUP #08 .stack/length LDZ SUB #01 SUB GTH STH
( value ) DUP 2* .stack/items + [ #10 .stack/length LDZ 2* - - ] LDZ2 ( value ) DUP #10 SFT .stack/items ADD [ #10 .stack/length LDZ #10 SFT SUB SUB ] LDZ2
STHr ;draw-number JSR2 STHr ;draw-number JSR2
INC GTHk ,&loop JCN INC GTHk ,&loop JCN
POP2 POP2
RTN JMP2r
@draw-input ( key -- ) @draw-input ( key -- )
STH STH
( draw value ) ( draw value )
.input-frame/x LDZ2 #0018 ++ .Screen/x DEO2 .input-frame/x LDZ2 #0018 ADD2 .Screen/x DEO2
.input-frame/y LDZ2 #0003 ++ .Screen/y DEO2 .input-frame/y LDZ2 #0003 ADD2 .Screen/y DEO2
.input/value LDZ2 #02 ;draw-number JSR2 .input/value LDZ2 #02 ;draw-number JSR2
( controls ) ( controls )
.input-frame/x LDZ2 .input-frame/x LDZ2
.input-frame/y LDZ2 .input-frame/y LDZ2
;stack-icns/push [ STHkr #00 = ] #02 ;stack-icns/push [ STHkr #00 EQU ] #02
;draw-key-thin JSR2 ;draw-key-thin JSR2
.input-frame/x LDZ2 #0008 ++ .input-frame/x LDZ2 #0008 ADD2
.input-frame/y LDZ2 .input-frame/y LDZ2
;stack-icns/pop [ STHkr #01 = ] #03 ;stack-icns/pop [ STHkr #01 EQU ] #03
;draw-key-thin JSR2 ;draw-key-thin JSR2
( line ) ( line )
.input-frame/x LDZ2 .input-frame/x LDZ2
.input-frame/x2 LDZ2 .input-frame/x2 LDZ2
.input-frame/y LDZ2 #0004 -- #02 .input-frame/y LDZ2 #0004 SUB2 #02
;line-hor-dotted JSR2 ;line-hor-dotted JSR2
POPr POPr
RTN JMP2r
@draw-keypad ( key -- ) @draw-keypad ( key -- )
STH STH
#10 #00 #10 #00
&loop &loop
( color ) #00 OVR ;keypad/color ++ LDA STH ( color ) #00 OVR ;keypad/color ADD2 LDA STH
( state ) DUP OVRr STHr = STH ( state ) DUP OVRr STHr EQU STH
( layout ) #00 OVR ;keypad/layout ++ LDA ( layout ) #00 OVR ;keypad/layout ADD2 LDA
( layout addr ) TOS 8** ;font-hex ++ STH2 ( layout addr ) #00 SWP #30 SFT2 ;font-hex ADD2 STH2
( x ) DUP 4MOD TOS 10** STH2 ( x ) #00 OVR #03 AND #40 SFT2 STH2
( y ) DUP 4/ TOS 10** ( y ) #00 OVR #02 SFT #40 SFT2
( origin-x ) STH2r .keypad-frame/x LDZ2 ++ SWP2 ( origin-x ) STH2r .keypad-frame/x LDZ2 ADD2 SWP2
( origin-y ) .keypad-frame/y LDZ2 ++ ( origin-y ) .keypad-frame/y LDZ2 ADD2
STH2r STHr STHr ;draw-key JSR2 STH2r STHr STHr ;draw-key JSR2
INC GTHk ,&loop JCN INC GTHk ,&loop JCN
POP2 POP2
POPr POPr
RTN JMP2r
@draw-modpad ( key -- ) @draw-modpad ( key -- )
STH STH
#08 #00 #08 #00
&loop &loop
( state ) DUP STHkr = STH ( state ) DUP STHkr EQU STH
( glyph ) #00 OVR 8** ;mod-icns ++ STH2 ( glyph ) #00 OVR #30 SFT2 ;mod-icns ADD2 STH2
( y ) DUP 4/ TOS 10** .modpad-frame/y LDZ2 ++ STH2 ( y ) #00 OVR #02 SFT #40 SFT2 .modpad-frame/y LDZ2 ADD2 STH2
( x ) DUP 4MOD TOS 10** .modpad-frame/x LDZ2 ++ STH2 ( x ) #00 OVR #03 AND #40 SFT2 .modpad-frame/x LDZ2 ADD2 STH2
STH2r STH2r STH2r STHr #03 ;draw-key JSR2 STH2r STH2r STH2r STHr #03 ;draw-key JSR2
INC GTHk ,&loop JCN INC GTHk ,&loop JCN
POP2 POP2
POPr POPr
RTN JMP2r
@draw-bitpad ( -- ) @draw-bitpad ( -- )
#1000 #1000
&loop &loop
( y ) DUP 8/ TOS 8** .bitpad-frame/y LDZ2 ++ .Screen/y DEO2 ( y ) #00 OVR #03 SFT #30 SFT2 .bitpad-frame/y LDZ2 ADD2 .Screen/y DEO2
( x ) DUP 8MOD TOS 8** .bitpad-frame/x LDZ2 ++ .Screen/x DEO2 ( x ) #00 OVR #07 AND #30 SFT2 .bitpad-frame/x LDZ2 ADD2 .Screen/x DEO2
( state ) DUP #0f SWP - .input/value LDZ2 ROT SFT2 2MOD2 ( state ) DUP #0f SWP SUB .input/value LDZ2 ROT SFT2 #0001 AND2
( addr ) 8** ;bit-icns ++ .Screen/addr DEO2 ( addr ) #30 SFT2 ;bit-icns ADD2 .Screen/addr DEO2
#01 .Screen/sprite DEO #01 .Screen/sprite DEO
INC GTHk ,&loop JCN INC GTHk ,&loop JCN
POP2 POP2
RTN JMP2r
@draw-key ( x* y* glyph* state color -- ) @draw-key ( x* y* glyph* state color -- )
STH2 STH2
AUTO-XADDR #16 .Screen/auto DEO
SWP2 .Screen/y DEO2 SWP2 .Screen/y DEO2
SWP2 .Screen/x DEO2 SWP2 .Screen/x DEO2
( bg ) ( bg )
;button-icns [ #00 OVRr STHr 20** ++ ] .Screen/addr DEO2 ;button-icns [ #00 OVRr STHr #50 SFT2 ADD2 ] .Screen/addr DEO2
STHkr .Screen/sprite DEOk DEO
.Screen/x DEI2k #0010 -- ROT DEO2
.Screen/y DEI2k #0008 ++ ROT DEO2
STHkr .Screen/sprite DEOk DEO STHkr .Screen/sprite DEOk DEO
( fg ) ( fg )
.Screen/addr DEO2 .Screen/addr DEO2
.Screen/x DEI2k #000c -- ROT DEO2 #00 .Screen/auto DEO
.Screen/y DEI2k #0005 -- ROT DEO2 .Screen/y DEI2k #000d SUB2 ROT DEO2
STHr [ STHr #09 MUL + ] .Screen/sprite DEO .Screen/x DEI2k #0004 ADD2 ROT DEO2
AUTO-NONE STHr [ STHr #09 MUL ADD ] .Screen/sprite DEO
RTN JMP2r
@draw-key-thin ( x* y* glyph* state color -- ) @draw-key-thin ( x* y* glyph* state color -- )
AUTO-YADDR #06 .Screen/auto DEO
,&color STR ,&state STR ,&glyph STR2 ,&color STR ,&state STR ,&glyph STR2
( frame ) ( frame )
;button-thin-icns #00 [ LIT &state $1 ] 10** ++ .Screen/addr DEO2 ;button-thin-icns #00 [ LIT &state $1 ] #40 SFT2 ADD2 .Screen/addr DEO2
.Screen/y DEO2 .Screen/x DEO2 .Screen/y DEO2 .Screen/x DEO2
[ LIT &color $1 ] .Screen/sprite DEOk DEO [ LIT &color $1 ] .Screen/sprite DEOk DEO
( glyph ) ( glyph )
[ LIT2 &glyph $2 ] .Screen/addr DEO2 [ LIT2 &glyph $2 ] .Screen/addr DEO2
.Screen/y DEI2 #000c -- .Screen/y DEO2 .Screen/y DEI2 #000c SUB2 .Screen/y DEO2
#05 .Screen/sprite DEO #05 .Screen/sprite DEO
AUTO-NONE #00 .Screen/auto DEO
RTN JMP2r
@draw-number ( number* color -- ) @draw-number ( number* color -- )
@ -580,38 +519,38 @@ RTN
#00 ;&zero STA #00 ;&zero STA
( hexadecimal ) ( hexadecimal )
.input/mode LDZ ,&decimal JCN .input/mode LDZ ,&decimal JCN
AUTO-X #01 .Screen/auto DEO
#00 ,&digit JSR #00 ,&digit JSR
SWP SWP
STHk #04 SFT ,&digit JSR STHk #04 SFT ,&digit JSR
STHr #0f AND ,&digit JSR STHr #0f AND ,&digit JSR
STHk #04 SFT ,&digit JSR STHk #04 SFT ,&digit JSR
STHr #0f AND ,&digit JSR STHr #0f AND ,&digit JSR
AUTO-NONE #00 .Screen/auto DEO
RTN JMP2r
&digit ( num -- ) &digit ( num -- )
,&addr JSR .Screen/addr DEO2 ,&addr JSR .Screen/addr DEO2
[ LIT &color $1 ] .Screen/sprite DEO [ LIT &color $1 ] .Screen/sprite DEO
RTN JMP2r
&decimal ( num* -- ) &decimal ( num* -- )
AUTO-X #01 .Screen/auto DEO
#2710 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2 #2710 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2
#03e8 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2 #03e8 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2
#0064 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2 NIP #0064 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2 NIP
#0a DIVk DUP ,&digit JSR MUL SUB #0a DIVk DUP ,&digit JSR MUL SUB
,&digit JSR ,&digit JSR
AUTO-NONE #00 .Screen/auto DEO
RTN JMP2r
&addr ( num -- addr* ) &addr ( num -- addr* )
,&zero LDR ,&padded JCN ,&zero LDR ,&padded JCN
DUP ,&no-blank JCN DUP ,&no-blank JCN
POP ;blank-icn RTN POP ;blank-icn JMP2r
&no-blank &no-blank
DUP ,&zero STR DUP ,&zero STR
&padded 8* TOS ;font-hex ++ &padded #30 SFT #00 SWP ;font-hex ADD2
RTN JMP2r
RTN JMP2r
&zero $1 &zero $1
( theme ) ( theme )
@ -624,14 +563,14 @@ RTN
#0006 .File/length DEO2 #0006 .File/length DEO2
#fffa .File/read DEO2 #fffa .File/read DEO2
.File/success DEI2 #0006 !! ,&ignore JCN .File/success DEI2 #0006 NEQ2 ,&ignore JCN
#fffa LDA2 .System/r DEO2 #fffa LDA2 .System/r DEO2
#fffc LDA2 .System/g DEO2 #fffc LDA2 .System/g DEO2
#fffe LDA2 .System/b DEO2 #fffe LDA2 .System/b DEO2
&ignore &ignore
;redraw JSR2 ;redraw JSR2
RTN JMP2r
@within-rect ( x* y* rect -- flag ) @within-rect ( x* y* rect -- flag )
@ -643,8 +582,8 @@ RTN
( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN ( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN
POP2 POP2 POPr POP2 POP2 POPr
#01 #01
RTN JMP2r
&skip POP2 POP2 POPr #00 RTN &skip POP2 POP2 POPr #00 JMP2r
@line-hor-dotted ( x0* x1* y* color -- ) @line-hor-dotted ( x0* x1* y* color -- )
@ -656,7 +595,7 @@ RTN
INC2 INC2 GTH2k ,&loop JCN INC2 INC2 GTH2k ,&loop JCN
POP2 POP2 POPr POP2 POP2 POPr
RTN JMP2r
( assets ) ( assets )