(calc.tal) Optimizations

This commit is contained in:
Devine Lu Linvega 2021-11-21 10:54:38 -05:00
parent baeed39e04
commit d7059eccd4
1 changed files with 49 additions and 91 deletions

View File

@ -7,6 +7,8 @@
%++ { ADD2 } %-- { SUB2 } %// { DIV2 } %++ { ADD2 } %-- { SUB2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 } %<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%!~ { NEQk NIP }
%2* { #10 SFT } %2* { #10 SFT }
%4* { #20 SFT } %4/ { #02 SFT } %4* { #20 SFT } %4/ { #02 SFT }
%8* { #30 SFT } %8/ { #03 SFT } %8* { #30 SFT } %8/ { #03 SFT }
@ -83,39 +85,31 @@
#0110 .Audio0/adsr DEO2 #0110 .Audio0/adsr DEO2
;sin-pcm .Audio0/addr DEO2 ;sin-pcm .Audio0/addr DEO2
#0100 .Audio0/length DEO2 #0100 .Audio0/length DEO2
#dd .Audio0/volume DEO ( TODO: turn ON ) #dd .Audio0/volume DEO
( center ) ( center )
.Screen/width DEI2 2// .center/x STZ2 .Screen/width DEI2 2// .center/x STZ2
.Screen/height DEI2 2// .center/y STZ2 .Screen/height DEI2 2// .center/y STZ2
.center/x LDZ2 #0020 -- .center/x LDZ2 #0020 --
DUP2 .keypad-frame/x STZ2 DUP2 .keypad-frame/x STZ2 #0040 ++ .keypad-frame/x2 STZ2
#0040 ++ .keypad-frame/x2 STZ2
.center/y LDZ2 #0018 -- .center/y LDZ2 #0018 --
DUP2 .keypad-frame/y STZ2 DUP2 .keypad-frame/y STZ2 #003f ++ .keypad-frame/y2 STZ2
#003f ++ .keypad-frame/y2 STZ2
.keypad-frame/x LDZ2 .keypad-frame/x LDZ2
DUP2 .modpad-frame/x STZ2 DUP2 .modpad-frame/x STZ2 #0040 ++ .modpad-frame/x2 STZ2
#0040 ++ .modpad-frame/x2 STZ2
.keypad-frame/y LDZ2 #0040 ++ .keypad-frame/y LDZ2 #0040 ++
DUP2 .modpad-frame/y STZ2 DUP2 .modpad-frame/y STZ2 #001f ++ .modpad-frame/y2 STZ2
#001f ++ .modpad-frame/y2 STZ2
.keypad-frame/x LDZ2 .keypad-frame/x LDZ2
DUP2 .bitpad-frame/x STZ2 DUP2 .bitpad-frame/x STZ2 #0040 ++ .bitpad-frame/x2 STZ2
#0040 ++ .bitpad-frame/x2 STZ2
.modpad-frame/y2 LDZ2 #0008 ++ .modpad-frame/y2 LDZ2 #0008 ++
DUP2 .bitpad-frame/y STZ2 DUP2 .bitpad-frame/y STZ2 #000f ++ .bitpad-frame/y2 STZ2
#000f ++ .bitpad-frame/y2 STZ2
.center/x LDZ2 #0020 -- .center/x LDZ2 #0020 --
DUP2 .input-frame/x STZ2 DUP2 .input-frame/x STZ2 #0040 ++ .input-frame/x2 STZ2
#0040 ++ .input-frame/x2 STZ2
.center/y LDZ2 #002a -- .center/y LDZ2 #002a --
DUP2 .input-frame/y STZ2 DUP2 .input-frame/y STZ2 #0010 ++ .input-frame/y2 STZ2
#0010 ++ .input-frame/y2 STZ2
( theme support ) ( theme support )
;load-theme JSR2 ;load-theme JSR2
@ -124,40 +118,26 @@ BRK
@on-button ( -> ) @on-button ( -> )
.Controller/key DEI #00 ! ,&continue JCN
;redraw JSR2 BRK
&continue
.Controller/key DEI .Controller/key DEI
DUP #0d ! ,&no-enter JCN ( generics )
;do-push JSR2 POP BRK #00 !~ ,&no-release JCN ;redraw JSR2 POP BRK &no-release
&no-enter #0d !~ ,&no-enter JCN ;do-push JSR2 POP BRK &no-enter
( arithmetic ) #1b !~ ,&no-esc JCN ;do-pop JSR2 POP BRK &no-esc
DUP LIT '+ ! ,&no-add JCN #08 !~ ,&no-backspace JCN
;do-add JSR2 POP BRK &no-add
DUP LIT '- ! ,&no-sub JCN
;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
( bitwise )
DUP LIT '& ! ,&no-and JCN
;do-and JSR2 POP BRK &no-and
DUP LIT '| ! ,&no-ora JCN
;do-ora JSR2 POP BRK &no-ora
DUP LIT '^ ! ,&no-eor JCN
;do-eor JSR2 POP BRK &no-eor
DUP LIT '~ ! ,&no-not JCN
;do-not JSR2 POP BRK &no-not
( clear )
DUP #1b ! ,&no-esc JCN
;do-pop JSR2 POP BRK &no-esc
DUP #08 ! ,&no-backspace JCN
.input/value LDZ2 #04 SFT2 .input/value STZ2 .input/value LDZ2 #04 SFT2 .input/value STZ2
#ff ;draw-input JSR2 #ff ;draw-input JSR2 POP BRK
POP BRK
&no-backspace &no-backspace
( arithmetic )
LIT '+ !~ ,&no-add JCN ;do-add JSR2 POP BRK &no-add
LIT '- !~ ,&no-sub JCN ;do-sub JSR2 POP BRK &no-sub
LIT '* !~ ,&no-mul JCN ;do-mul JSR2 POP BRK &no-mul
LIT '/ !~ ,&no-div JCN ;do-div JSR2 POP BRK &no-div
( bitwise )
LIT '& !~ ,&no-and JCN ;do-and JSR2 POP BRK &no-and
LIT '| !~ ,&no-ora JCN ;do-ora JSR2 POP BRK &no-ora
LIT '^ !~ ,&no-eor JCN ;do-eor JSR2 POP BRK &no-eor
LIT '~ !~ ,&no-not JCN ;do-not JSR2 POP BRK &no-not
( value )
;key-value JSR2 ;push-input JSR2 ;key-value JSR2 ;push-input JSR2
BRK BRK
@ -182,14 +162,10 @@ BRK
.Mouse/state DEI .pointer/last STZ .Mouse/state DEI .pointer/last STZ
POP2 POP2
.Mouse/x DEI2 .Mouse/y DEI2 .Mouse/x DEI2 .Mouse/y DEI2
OVR2 OVR2 .keypad-frame OVR2 OVR2 .keypad-frame ;within-rect JSR2 ;click-keypad JCN2
;within-rect JSR2 ;click-keypad JCN2 OVR2 OVR2 .input-frame ;within-rect JSR2 ;click-input JCN2
OVR2 OVR2 .input-frame OVR2 OVR2 .modpad-frame ;within-rect JSR2 ;click-modpad JCN2
;within-rect JSR2 ;click-input JCN2 OVR2 OVR2 .bitpad-frame ;within-rect JSR2 ;click-bitpad JCN2
OVR2 OVR2 .modpad-frame
;within-rect JSR2 ;click-modpad JCN2
OVR2 OVR2 .bitpad-frame
;within-rect JSR2 ;click-bitpad JCN2
POP2 POP2 POP2 POP2
BRK BRK
&no-down &no-down
@ -217,17 +193,7 @@ BRK
( y ) .modpad-frame/y LDZ2 -- #24 SFT2 NIP STH ( y ) .modpad-frame/y LDZ2 -- #24 SFT2 NIP STH
( x ) .modpad-frame/x LDZ2 -- 10// ( x ) .modpad-frame/x LDZ2 -- 10//
( value ) NIP STHr + ( lookup ) STHr + 2** ;keypad/ops ++ LDA2 JSR2
DUP #00 ! ,&no-add JCN ;do-add JSR2 &no-add
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
DUP #04 ! ,&no-and JCN ;do-and JSR2 &no-and
DUP #05 ! ,&no-ora JCN ;do-ora JSR2 &no-ora
DUP #06 ! ,&no-eor JCN ;do-eor JSR2 &no-eor
DUP #07 ! ,&no-not JCN ;do-not JSR2 &no-not
POP
;draw-bitpad JSR2 ;draw-bitpad JSR2
RELEASE-MOUSE RELEASE-MOUSE
@ -595,25 +561,16 @@ RTN
#10 #00 #10 #00
&loop &loop
( state ) DUP #0f SWP - .input/value LDZ2 ROT SFT2 2MOD2 NIP STH ( y ) DUP 8/ TOS 8** .bitpad-frame/y LDZ2 ++ .Screen/y DEO2
( y ) DUP 8/ TOS 8** .bitpad-frame/y LDZ2 ++ STH2 ( x ) DUP 8MOD TOS 8** .bitpad-frame/x LDZ2 ++ .Screen/x DEO2
( x ) DUP 8MOD TOS 8** .bitpad-frame/x LDZ2 ++ ( state ) DUP #0f SWP - .input/value LDZ2 ROT SFT2 2MOD2
STH2r STHr #01 ,draw-bit JSR ( addr ) 8** ;bit-icns ++ .Screen/addr DEO2
#01 .Screen/sprite DEO
INC GTHk ,&loop JCN INC GTHk ,&loop JCN
POP2 POP2
RTN RTN
@draw-bit ( x* y* state color -- )
STH
( addr ) 8* TOS ;bit-icns ++ .Screen/addr DEO2
( y ) .Screen/y DEO2
( x ) .Screen/x DEO2
STHr .Screen/sprite DEO
RTN
@draw-key ( x* y* glyph* state color -- ) @draw-key ( x* y* glyph* state color -- )
( auto x addr ) #05 .Screen/auto DEO ( auto x addr ) #05 .Screen/auto DEO
@ -628,8 +585,7 @@ RTN
,&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
,&color LDR .Screen/sprite DEO ,&color LDR .Screen/sprite DEOk DEO
,&color LDR .Screen/sprite DEO
( glyph ) ( glyph )
,&glyph LDR2 .Screen/addr DEO2 ,&glyph LDR2 .Screen/addr DEO2
.Screen/x DEI2 #000c -- .Screen/x DEO2 .Screen/x DEI2 #000c -- .Screen/x DEO2
@ -650,8 +606,7 @@ RTN
( y ) .Screen/y DEO2 ( y ) .Screen/y DEO2
( x ) .Screen/x DEO2 ( x ) .Screen/x DEO2
( draw background ) ( draw background )
,&color LDR .Screen/sprite DEO ,&color LDR .Screen/sprite DEOk DEO
,&color LDR .Screen/sprite DEO
( glyph ) ( glyph )
,&glyph LDR2 .Screen/addr DEO2 ,&glyph LDR2 .Screen/addr DEO2
.Screen/y DEI2 #000c -- .Screen/y DEO2 .Screen/y DEI2 #000c -- .Screen/y DEO2
@ -742,6 +697,9 @@ RTN
0101 0102 0101 0102
0101 0102 0101 0102
0102 0202 0102 0202
&ops
:do-add :do-sub :do-mul :do-div
:do-and :do-ora :do-eor :do-not
@sin-pcm @sin-pcm
8083 8689 8c8f 9295 989b 9ea1 a4a7 aaad 8083 8689 8c8f 9295 989b 9ea1 a4a7 aaad
@ -783,29 +741,29 @@ RTN
0000 0060 920c 0000 0000 0060 920c 0000
@button-icns @button-icns
&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 ( full )
3f7f ffff ffff ffff 3f7f ffff ffff ffff
f8fc fefe fefe fefe f8fc fefe fefe fefe
ffff ffff ff7f 3f00 ffff ffff ff7f 3f00
fefe fefe fefc f800 fefe fefe fefc f800
@button-thin-icns @button-thin-icns
&outline ( outline )
3844 8282 8282 8282 3844 8282 8282 8282
8282 8282 8244 3800 8282 8282 8244 3800
&full ( full )
387c fefe fefe fefe 387c fefe fefe fefe
fefe fefe fe7c 3800 fefe fefe fe7c 3800
@bit-icns @bit-icns
&outline ( outline )
3844 8282 8244 3800 3844 8282 8244 3800
&full ( full )
387c fefe fe7c 3800 387c fefe fe7c 3800
@stack-icns @stack-icns