d6
/
uxn
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Working copy of the calc.tal

This commit is contained in:
neauoire 2021-09-20 15:36:13 -07:00
parent 81ab3a7a74
commit 0c8a7feec5
1 changed files with 157 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

264
projects/software/calc.tal
View File

@ -11,6 +11,7 @@
%4** { #20 SFT2 } %4** { #20 SFT2 }
%8** { #30 SFT2 } %8// { #03 SFT2 } %8** { #30 SFT2 } %8// { #03 SFT2 }
%10** { #40 SFT2 } %10// { #04 SFT2 } %10** { #40 SFT2 } %10// { #04 SFT2 }
%20** { #50 SFT2 }
%4MOD { #03 AND } %4MOD { #03 AND }
@ -20,6 +21,7 @@
%RTN { JMP2r } %RTN { JMP2r }
%SWP2? { #01 JCN SWP2 } %SWP2? { #01 JCN SWP2 }
%BRK? { #01 JCN BRK } %BRK? { #01 JCN BRK }
%RTN? { #01 JCN RTN }
%TOS { #00 SWP } %TOS { #00 SWP }
( devices ) ( devices )
@ -47,10 +49,8 @@
&items $10 &items $10
@center @center
&x $2 &y $2 &x $2 &y $2
@rect
&x1 $2 &y1 $2 &x2 $2 &y2 $2
@pointer @pointer
&x $2 &y $2 &lastx $2 &lasty $2 &state $1 &x $2 &y $2
@keypad-frame @keypad-frame
&x $2 &y $2 &x2 $2 &y2 $2 &x $2 &y $2 &x2 $2 &y2 $2
@modpad-frame @modpad-frame
@ -93,9 +93,9 @@
DUP2 .modpad-frame/y STZ2 DUP2 .modpad-frame/y STZ2
#0040 ++ .modpad-frame/y2 STZ2 #0040 ++ .modpad-frame/y2 STZ2
.center/x LDZ2 #0010 -- .center/x LDZ2 #0028 --
DUP2 .input-frame/x STZ2 DUP2 .input-frame/x STZ2
#0040 ++ .input-frame/x2 STZ2 #0050 ++ .input-frame/x2 STZ2
.center/y LDZ2 #0030 -- .center/y LDZ2 #0030 --
DUP2 .input-frame/y STZ2 DUP2 .input-frame/y STZ2
#0010 ++ .input-frame/y2 STZ2 #0010 ++ .input-frame/y2 STZ2
@ -106,19 +106,29 @@ BRK
@on-button ( -> ) @on-button ( -> )
.Controller/key DEI BRK? .Controller/key DEI #00 ! ,&continue JCN
;redraw JSR2 BRK
&continue
.Controller/key DEI .Controller/key DEI
DUP #0d ! ,&no-enter JCN DUP #0d ! ,&no-enter JCN
;send-input JSR2 POP BRK ;do-push JSR2 POP BRK
&no-enter &no-enter
DUP LIT '+ ! ,&no-add JCN ;do-add JSR2 POP BRK &no-add DUP LIT '+ ! ,&no-add JCN
DUP LIT '- ! ,&no-sub JCN ;do-sub JSR2 POP BRK &no-sub ;do-add JSR2 POP BRK &no-add
DUP LIT '* ! ,&no-mul JCN ;do-mul JSR2 POP BRK &no-mul DUP LIT '- ! ,&no-sub JCN
DUP LIT '/ ! ,&no-div JCN ;do-div JSR2 POP BRK &no-div ;do-sub JSR2 POP BRK &no-sub
DUP LIT '* ! ,&no-mul JCN
;do-mul JSR2 POP BRK &no-mul
DUP LIT '/ ! ,&no-div JCN
;do-div JSR2 POP BRK &no-div
DUP #1b ! ,&no-esc JCN DUP #1b ! ,&no-esc JCN
;do-pop JSR2 POP BRK ;do-pop JSR2 POP BRK &no-esc
&no-esc DUP #08 ! ,&no-backspace JCN
.input/value LDZ2 #04 SFT2 .input/value STZ2
#ff ;draw-input JSR2
POP BRK
&no-backspace
;key-value JSR2 ;push-input JSR2 ;key-value JSR2 ;push-input JSR2
BRK BRK
@ -140,7 +150,9 @@ BRK
.pointer/y LDZ2 .Screen/y DEO2 .pointer/y LDZ2 .Screen/y DEO2
#41 .Mouse/state DEI #01 = + .Screen/sprite DEO #41 .Mouse/state DEI #01 = + .Screen/sprite DEO
.Mouse/state DEI BRK? .Mouse/state DEI #00 ! ,&continue JCN
;redraw JSR2 BRK
&continue
.Mouse/x DEI2 .Mouse/y DEI2 .Mouse/x DEI2 .Mouse/y DEI2
OVR2 OVR2 .keypad-frame OVR2 OVR2 .keypad-frame
@ -171,6 +183,8 @@ BRK
.modpad-frame/y LDZ2 -- 10// NIP .modpad-frame/y LDZ2 -- 10// NIP
DUP #00 ! ,&no-add JCN ;do-add JSR2 &no-add DUP #00 ! ,&no-add JCN ;do-add JSR2 &no-add
DUP #01 ! ,&no-sub JCN ;do-sub JSR2 &no-sub DUP #01 ! ,&no-sub JCN ;do-sub JSR2 &no-sub
DUP #02 ! ,&no-mul JCN ;do-mul JSR2 &no-mul
DUP #03 ! ,&no-div JCN ;do-div JSR2 &no-div
POP POP
( release mouse ) #00 .Mouse/state DEO ( release mouse ) #00 .Mouse/state DEO
@ -181,12 +195,12 @@ BRK
POP2 POP2
.input-frame/x LDZ2 #0008 ++ -- 10// NIP .input-frame/x LDZ2 #0008 ++ -- 10// NIP
DUP #01 ! ,&no-push JCN DUP #03 ! ,&no-push JCN
.input/value LDZ2 #0001 << ,&no-push-empty JCN .input/value LDZ2 #0001 << ,&no-push-empty JCN
;send-input JSR2 ;do-push JSR2
&no-push-empty &no-push-empty
&no-push &no-push
DUP #02 ! ,&no-pop JCN DUP #04 ! ,&no-pop JCN
;do-pop JSR2 ;do-pop JSR2
&no-pop &no-pop
POP POP
@ -197,15 +211,10 @@ BRK
@push-input ( key -- ) @push-input ( key -- )
DUP TOS ;keypad/series ++ LDA ;draw-keypad JSR2
TOS .input/value LDZ2 #40 SFT2 ++ .input/value STZ2 TOS .input/value LDZ2 #40 SFT2 ++ .input/value STZ2
.input/length LDZ INC .input/length STZ .input/length LDZ INC .input/length STZ
;draw-input JSR2 #ff ;draw-input JSR2
RTN
@send-input ( -- )
.input/value LDZ2 ;push JSR2
RTN RTN
@ -214,7 +223,7 @@ RTN
( store ) .stack/length LDZ 2* .stack/items + STZ2 ( store ) .stack/length LDZ 2* .stack/items + STZ2
( incr ) .stack/length LDZ INC .stack/length STZ ( incr ) .stack/length LDZ INC .stack/length STZ
( reset ) #0000 .input/value STZ2 ( reset ) #0000 .input/value STZ2
;draw-input JSR2 #00 ;draw-input JSR2
;draw-stack JSR2 ;draw-stack JSR2
RTN RTN
@ -224,45 +233,60 @@ RTN
.stack/length LDZ #01 - 2* .stack/items + LDZ2 .stack/length LDZ #01 - 2* .stack/items + LDZ2
( clear ) #0000 .stack/length LDZ #01 - 2* .stack/items + STZ2 ( clear ) #0000 .stack/length LDZ #01 - 2* .stack/items + STZ2
( incr ) .stack/length LDZ #01 - .stack/length STZ ( incr ) .stack/length LDZ #01 - .stack/length STZ
;draw-input JSR2 #01 ;draw-input JSR2
;draw-stack JSR2 ;draw-stack JSR2
RTN RTN
@do-push ( -- )
.stack/length LDZ #07 < ,&continue JCN
RTN
&continue
.input/value LDZ2 ;push JSR2
RTN
@do-pop ( -- ) @do-pop ( -- )
.stack/length LDZ BRK? #0000 .input/value STZ2
;pop JSR2 POP2 .stack/length LDZ #00 = ,&continue JCN
;draw-input JSR2 ;pop JSR2 POP2
;draw-stack JSR2 ;draw-stack JSR2
&continue
#01 ;draw-input JSR2
RTN RTN
@do-add ( -- ) @do-add ( -- )
.stack/length LDZ #01 > BRK? .stack/length LDZ #01 > RTN?
;pop JSR2 ;pop JSR2 ADD2 ;push JSR2 #00 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 ADD2 ;push JSR2
RTN RTN
@do-sub ( -- ) @do-sub ( -- )
.stack/length LDZ #01 > BRK? .stack/length LDZ #01 > RTN?
;pop JSR2 ;pop JSR2 SUB2 ;push JSR2 #01 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 SUB2 ;push JSR2
RTN RTN
@do-mul ( -- ) @do-mul ( -- )
.stack/length LDZ #01 > BRK? .stack/length LDZ #01 > RTN?
;pop JSR2 ;pop JSR2 MUL2 ;push JSR2 #02 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 MUL2 ;push JSR2
RTN RTN
@do-div ( -- ) @do-div ( -- )
.stack/length LDZ #01 > BRK? .stack/length LDZ #01 > RTN?
;pop JSR2 ;pop JSR2 DIV2 ;push JSR2 #03 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 DIV2 ;push JSR2
RTN RTN
@ -283,9 +307,9 @@ RTN
@redraw ( -- ) @redraw ( -- )
;draw-keypad JSR2 #ff ;draw-keypad JSR2
;draw-modpad JSR2 #ff ;draw-modpad JSR2
;draw-input JSR2 #ff ;draw-input JSR2
;draw-stack JSR2 ;draw-stack JSR2
RTN RTN
@ -294,9 +318,9 @@ RTN
#08 #00 #08 #00
&loop &loop
( color ) DUP .stack/length LDZ < STH ( color ) DUP #08 .stack/length LDZ - #01 - > STH
( value ) DUP 2* .stack/items + LDZ2 STH2 ( value ) DUP 2* .stack/items + [ #10 .stack/length LDZ 2* - - ] LDZ2 STH2
( y ) DUP TOS 8** #0070 SWP2 -- STH2 ( y ) DUP TOS 8** .input-frame/y LDZ2 ++ #0048 -- STH2
( x ) #0088 STH2r STH2r STHr ;draw-short JSR2 ( x ) #0088 STH2r STH2r STHr ;draw-short JSR2
INC GTHk ,&loop JCN INC GTHk ,&loop JCN
POP2 POP2
@ -320,34 +344,6 @@ RTN
RTN RTN
@draw-input ( -- )
.input-frame/y LDZ2 #0002 ++ .Screen/y DEO2
#04 #00
&loop
( x ) DUP TOS 8** .input-frame/x LDZ2 SWP2 -- .Screen/x DEO2
( value ) STHk .input/value LDZ2 STHr 4* SFT2 #000f AND2
( value glyph ) 8** ;font-hex ++ .Screen/addr DEO2
( color ) DUP INC .input/value LDZ2 ;get-length JSR2 >
#01 + .Screen/sprite DEO
INC GTHk ,&loop JCN
POP2
( controls )
.input-frame/x LDZ2 #0018 ++
.input-frame/y LDZ2
;stack-icns/push
;key-icns/outline #01
;draw-key JSR2
.input-frame/x LDZ2 #0028 ++
.input-frame/y LDZ2
;stack-icns/pop
;key-icns/outline #02
;draw-key JSR2
RTN
@get-length ( short* -- length ) @get-length ( short* -- length )
DUP2 #0fff << ,&no4 JCN POP2 #04 RTN &no4 DUP2 #0fff << ,&no4 JCN POP2 #04 RTN &no4
@ -357,62 +353,108 @@ RTN
RTN RTN
@draw-keypad ( -- ) @draw-input ( key -- )
STH
.input-frame/y LDZ2 #0002 ++ .Screen/y DEO2
#04 #00
&loop
( x ) DUP TOS 8** .input-frame/x LDZ2 #0018 ++ SWP2 -- .Screen/x DEO2
( value ) STHk .input/value LDZ2 STHr 4* SFT2 #000f AND2
( value glyph ) 8** ;font-hex ++ .Screen/addr DEO2
( color ) DUP INC .input/value LDZ2 ;get-length JSR2 >
#01 + .Screen/sprite DEO
INC GTHk ,&loop JCN
POP2
( controls )
.input-frame/x LDZ2 #0030 ++
.input-frame/y LDZ2
;stack-icns/push [ STHkr #00 = ] #01
;draw-key JSR2
.input-frame/x LDZ2 #0040 ++
.input-frame/y LDZ2
;stack-icns/pop [ STHkr #01 = ] #02
;draw-key JSR2
( line )
.input-frame/x LDZ2
.input-frame/x2 LDZ2
.input-frame/y LDZ2 #0004 -- #02
;line-hor-dotted JSR2
POPr
RTN
@draw-keypad ( key -- )
STH
#10 #00 #10 #00
&loop &loop
( color ) DUP TOS ;keypad/color ++ LDA STH ( color ) DUP TOS ;keypad/color ++ LDA STH
( state ) DUP OVRr STHr = STH
( layout ) DUP TOS ;keypad/layout ++ LDA ( layout ) DUP TOS ;keypad/layout ++ LDA
( layout addr ) TOS 8** ;font-hex ++ STH2 ( layout addr ) TOS 8** ;font-hex ++ STH2
( x ) DUP 4MOD TOS 10** STH2 ( x ) DUP 4MOD TOS 10** STH2
( y ) DUP 4/ TOS 10** ( y ) DUP 4/ TOS 10**
( origin-x ) STH2r .keypad-frame/x LDZ2 ++ SWP2 ( origin-x ) STH2r .keypad-frame/x LDZ2 ++ SWP2
( origin-y ) .keypad-frame/y LDZ2 ++ ( origin-y ) .keypad-frame/y LDZ2 ++
STH2r ;key-icns/full STHr ;draw-key JSR2 STH2r STHr STHr ;draw-key JSR2
INC GTHk ,&loop JCN INC GTHk ,&loop JCN
POP2 POP2
POPr
RTN RTN
@draw-modpad ( -- ) @draw-modpad ( key -- )
STH
#04 #00 #04 #00
&loop &loop
( color ) DUP TOS ;modpad/color ++ LDA STH ( color ) DUP TOS ;modpad/color ++ LDA STH
( state ) DUP OVRr STHr = STH
( layout ) DUP TOS 8** ;mod-icns ++ STH2 ( layout ) DUP TOS 8** ;mod-icns ++ STH2
( x ) #0000 STH2 ( x ) #0000 STH2
( y ) DUP TOS 10** ( y ) DUP TOS 10**
( origin-x ) STH2r .modpad-frame/x LDZ2 ++ SWP2 ( origin-x ) STH2r .modpad-frame/x LDZ2 ++ SWP2
( origin-y ) .modpad-frame/y LDZ2 ++ ( origin-y ) .modpad-frame/y LDZ2 ++
STH2r ;key-icns/full STHr ;draw-key JSR2 STH2r STHr STHr ;draw-key JSR2
INC GTHk ,&loop JCN INC GTHk ,&loop JCN
POP2 POP2
POPr
RTN RTN
@draw-key ( x* y* glyph* style* color -- ) @draw-key ( x* y* glyph* state color -- )
( auto x addr ) #05 .Screen/auto DEO ( auto x addr ) #05 .Screen/auto DEO
( frame )
STH ( color ) ,&color STR
( style ) .Screen/addr DEO2 ( state ) ,&state STR
STH2 ROTr ( glyph ) ,&glyph STR2
.Screen/y DEO2
.Screen/x DEO2 ( state ) ;button-icns [ #00 ,&state LDR 20** ++ ] .Screen/addr DEO2
STHkr .Screen/sprite DEO ( y* ) .Screen/y DEO2
STHkr .Screen/sprite DEO ( x* ) .Screen/x DEO2
( draw background )
,&color LDR .Screen/sprite DEO
,&color LDR .Screen/sprite DEO
.Screen/x DEI2 #0010 -- .Screen/x DEO2 .Screen/x DEI2 #0010 -- .Screen/x DEO2
.Screen/y DEI2 #0008 ++ .Screen/y DEO2 .Screen/y DEI2 #0008 ++ .Screen/y DEO2
STHkr .Screen/sprite DEO ,&color LDR .Screen/sprite DEO
STHkr .Screen/sprite DEO ,&color LDR .Screen/sprite DEO
( glyph ) ( glyph )
ROTr ROTr STH2r .Screen/addr DEO2 ,&glyph LDR2 .Screen/addr DEO2
.Screen/x DEI2 #000c -- .Screen/x DEO2 .Screen/x DEI2 #000c -- .Screen/x DEO2
.Screen/y DEI2 #0005 -- .Screen/y DEO2 .Screen/y DEI2 #0005 -- .Screen/y DEO2
STHr #04 MUL .Screen/sprite DEO ,&color LDR [ ,&state LDR #09 MUL + ] .Screen/sprite DEO
( auto none ) #00 .Screen/auto DEO ( auto none ) #00 .Screen/auto DEO
RTN RTN
&color $1 &state $1 &glyph $2
@within-rect ( x* y* rect -- flag ) @within-rect ( x* y* rect -- flag )
@ -431,6 +473,19 @@ RTN
RTN RTN
@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
RTN
@line-rect ( rect color -- ) @line-rect ( rect color -- )
STH STH STH STH
@ -486,6 +541,11 @@ RTN
0405 060e 0405 060e
0102 030d 0102 030d
000a 0b0c 000a 0b0c
&series
0c08 090a
0405 0600
0102 0d0e
0f0b 0703
&color &color
0101 0102 0101 0102
0101 0102 0101 0102
@ -513,33 +573,23 @@ RTN
0010 5428 c628 5410 0010 5428 c628 5410
0010 0000 fe00 0010 0010 0000 fe00 0010
@key-icns @button-icns
&full
3f7f ffff ffff ffff
f8fc fefe fefe fefe
ffff ffff ff7f 3f00
fefe fefe fefc f800
&outline &outline
3f40 8080 8080 8080 3f40 8080 8080 8080
f804 0202 0202 0202 f804 0202 0202 0202
8080 8080 8040 3f00 8080 8080 8040 3f00
0202 0202 0204 f800 0202 0202 0204 f800
&full
3f7f ffff ffff ffff
f8fc fefe fefe fefe
ffff ffff ff7f 3f00
fefe fefe fefc f800
@stack-icns @stack-icns
&push &push
ffff ffef d7bb ffff 0000 0010 2844 0000
&pop &pop
ffff efc7 83c7 efff 0000 1038 7c38 1000
@input-icn
3f40 8080 8080 8080
ff00 0000 0000 0000
ff00 0000 0000 0000
f804 0202 0202 0202
8080 8080 8040 3f00
0000 0000 0000 ff00
0000 0000 0000 ff00
0202 0202 0204 f800
@pointer-icn @pointer-icn
80c0 e0f0 f8e0 1000 80c0 e0f0 f8e0 1000