diff --git a/projects/software/calc.tal b/projects/software/calc.tal index a861bc2..8bdb9ac 100644 --- a/projects/software/calc.tal +++ b/projects/software/calc.tal @@ -5,7 +5,8 @@ %++ { ADD2 } %-- { SUB2 } %// { DIV2 } %<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 } -%4/ { #02 SFT } +%2* { #10 SFT } +%4/ { #02 SFT } %4* { #20 SFT } %2** { #10 SFT2 } %2// { #01 SFT2 } %4** { #20 SFT2 } @@ -42,6 +43,9 @@ @input &length $1 &value $2 +@stack + &length $1 + &items $10 @center &x $2 &y $2 @rect @@ -51,9 +55,9 @@ @keypad-frame &x $2 &y $2 &x2 $2 &y2 $2 @modpad-frame - &x $2 &y $2 + &x $2 &y $2 &x2 $2 &y2 $2 @input-frame - &x $2 &y $2 + &x $2 &y $2 &x2 $2 &y2 $2 ( program ) @@ -78,11 +82,19 @@ DUP2 .keypad-frame/y STZ2 #0040 ++ .keypad-frame/y2 STZ2 - .keypad-frame/x LDZ2 #0040 ++ .modpad-frame/x STZ2 - .keypad-frame/y LDZ2 .modpad-frame/y STZ2 + .keypad-frame/x LDZ2 #0040 ++ + DUP2 .modpad-frame/x STZ2 + #0010 ++ .modpad-frame/x2 STZ2 + .keypad-frame/y LDZ2 + DUP2 .modpad-frame/y STZ2 + #0040 ++ .modpad-frame/y2 STZ2 - .center/x LDZ2 #0010 -- .input-frame/x STZ2 - .center/y LDZ2 #0030 -- .input-frame/y STZ2 + .center/x LDZ2 #0010 -- + DUP2 .input-frame/x STZ2 + #0040 ++ .input-frame/x2 STZ2 + .center/y LDZ2 #0030 -- + DUP2 .input-frame/y STZ2 + #0010 ++ .input-frame/y2 STZ2 ;on-mouse .Mouse/vector DEO2 @@ -109,24 +121,60 @@ BRK .Mouse/state DEI BRK? - .Mouse/x DEI2 - .Mouse/y DEI2 - .keypad-frame + .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 + POP2 POP2 BRK -@click-keypad ( -> ) +@click-keypad ( x* y* -> ) ( get key ) - .Mouse/x DEI2 .keypad-frame/x LDZ2 -- 10// 4MOD - .Mouse/y DEI2 .keypad-frame/y LDZ2 -- 10// 4** + .keypad-frame/y LDZ2 -- 10// 4** + SWP2 .keypad-frame/x LDZ2 -- 10// #0003 AND2 ++ ;keypad/layout ++ LDA ;push-key JSR2 ( release mouse ) #00 .Mouse/state DEO BRK +@click-modpad ( x* y* -> ) + + NIP2 + ( get key ) + .modpad-frame/y LDZ2 -- 10// NIP + DUP #00 ! ,&no-add JCN + ;pop JSR2 + ;pop JSR2 + ADD2 ;push JSR2 + &no-add + POP + + ( release mouse ) #00 .Mouse/state DEO + +BRK + +@click-input ( x* y* -> ) + + POP2 + .input-frame/x LDZ2 #0008 ++ -- 10// NIP + DUP #01 ! ,&no-push JCN + .input/value LDZ2 ;push JSR2 + &no-push + DUP #02 ! ,&no-pop JCN + ;pop JSR2 POP2 + &no-pop + POP + + ( release mouse ) #00 .Mouse/state DEO + +BRK + @push-key ( key -- ) TOS .input/value LDZ2 #40 SFT2 ++ .input/value STZ2 @@ -135,11 +183,62 @@ BRK RTN +@push ( value* -- ) + + ( store ) .stack/length LDZ 2* .stack/items + STZ2 + ( incr ) .stack/length LDZ INC .stack/length STZ + ( reset ) #0000 .input/value STZ2 + ;draw-input JSR2 + ;draw-stack JSR2 + +RTN + +@pop ( -- value* ) + + .stack/length LDZ #01 - 2* .stack/items + LDZ2 + ( clear ) #0000 .stack/length LDZ #01 - 2* .stack/items + STZ2 + ( incr ) .stack/length LDZ #01 - .stack/length STZ + ;draw-input JSR2 + ;draw-stack JSR2 + +RTN + @redraw ( -- ) ;draw-keypad JSR2 ;draw-modpad JSR2 ;draw-input JSR2 + ;draw-stack JSR2 + +RTN + +@draw-stack ( -- ) + + #08 #00 + &loop + ( value ) DUP 2* .stack/items + LDZ2 STH2 + ( y ) DUP TOS 8** #0070 SWP2 -- STH2 + ( x ) #0088 STH2r STH2r #01 ;draw-short JSR2 + INC GTHk ,&loop JCN + POP2 + +RTN + +@draw-short ( x* y* value* color -- ) + + POP STH2 + .Screen/y DEO2 + .Screen/x DEO2 + + #04 #00 + &loop + .Screen/x DEI2 #0008 -- .Screen/x DEO2 + ( value ) DUP STH2kr ROT 4* SFT2 #000f AND2 + ( value glyph ) 8** ;font-hex ++ .Screen/addr DEO2 + #01 .Screen/sprite DEO + INC GTHk ,&loop JCN + POP2 + POP2r RTN