0
0
Fork 0
mirror of https://git.sr.ht/~rabbits/uxn synced 2024-11-20 12:55:11 +00:00
uxn/projects/software/calc.tal

777 lines
16 KiB
Tal
Raw Normal View History

2021-10-20 18:52:51 +00:00
(
a simple calculator
uxnasm projects/software/calc.tal bin/calc.rom && uxnemu bin/calc.rom )
2021-09-18 19:01:34 +00:00
2021-11-12 20:45:06 +00:00
%+ { ADD } %- { SUB } %/ { DIV }
2021-09-18 19:01:34 +00:00
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
2021-11-12 20:45:06 +00:00
%++ { ADD2 } %-- { SUB2 } %// { DIV2 }
2021-09-18 19:01:34 +00:00
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
2021-11-21 15:54:38 +00:00
%!~ { NEQk NIP }
2021-09-19 15:25:23 +00:00
%2* { #10 SFT }
%4* { #20 SFT } %4/ { #02 SFT }
2021-09-23 00:48:04 +00:00
%8* { #30 SFT } %8/ { #03 SFT }
2021-09-18 19:01:34 +00:00
%2** { #10 SFT2 } %2// { #01 SFT2 }
2021-09-19 15:25:23 +00:00
%4** { #20 SFT2 }
2021-09-18 19:01:34 +00:00
%8** { #30 SFT2 } %8// { #03 SFT2 }
2021-09-18 19:27:19 +00:00
%10** { #40 SFT2 } %10// { #04 SFT2 }
2021-09-20 22:36:13 +00:00
%20** { #50 SFT2 }
2021-09-18 19:01:34 +00:00
2021-11-17 20:07:14 +00:00
%2MOD2 { #0001 AND2 }
2021-11-17 19:35:59 +00:00
%4MOD { #03 AND } %4MOD2 { #0003 AND2 }
2021-11-17 20:07:14 +00:00
%8MOD { #07 AND }
2021-09-18 19:01:34 +00:00
%DEBUG { ;print-hex/byte JSR2 #0a .Console/write DEO }
%DEBUG2 { ;print-hex/short JSR2 #0a .Console/write DEO }
2021-11-17 19:44:48 +00:00
%RELEASE-MOUSE { #0096 DEO }
2021-09-18 19:01:34 +00:00
%RTN { JMP2r }
%BRK? { #01 JCN BRK }
2021-09-20 22:36:13 +00:00
%RTN? { #01 JCN RTN }
2021-09-18 19:01:34 +00:00
%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 ]
2021-11-07 19:10:30 +00:00
|a0 @File [ &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ]
2021-09-18 19:01:34 +00:00
( variables )
|0000
2021-09-18 19:27:19 +00:00
@input
&length $1 &value $2
2021-09-19 04:25:50 +00:00
@stack
&length $1
&items $10
2021-09-18 19:01:34 +00:00
@center
&x $2 &y $2
@pointer
2021-10-20 18:52:51 +00:00
&x $2 &y $2 &last $1
2021-09-18 19:01:34 +00:00
@keypad-frame
&x $2 &y $2 &x2 $2 &y2 $2
@modpad-frame
2021-09-19 04:25:50 +00:00
&x $2 &y $2 &x2 $2 &y2 $2
@bitpad-frame
&x $2 &y $2 &x2 $2 &y2 $2
2021-09-19 03:24:39 +00:00
@input-frame
2021-09-19 04:25:50 +00:00
&x $2 &y $2 &x2 $2 &y2 $2
2021-09-18 19:01:34 +00:00
( program )
|0100 ( -> )
( theme )
2021-10-20 18:52:51 +00:00
#0e7d .System/r DEO2
#0ec6 .System/g DEO2
#0e95 .System/b DEO2
2021-09-18 19:01:34 +00:00
2021-09-20 20:42:23 +00:00
( size )
2021-09-26 22:21:16 +00:00
#0090 .Screen/width DEO2
#0100 .Screen/height DEO2
2021-09-20 20:42:23 +00:00
( vectors )
;on-mouse .Mouse/vector DEO2
;on-button .Controller/vector DEO2
2021-09-21 19:31:48 +00:00
( setup synth )
2021-09-21 23:37:19 +00:00
#0110 .Audio0/adsr DEO2
;sin-pcm .Audio0/addr DEO2
2021-09-21 19:31:48 +00:00
#0100 .Audio0/length DEO2
2021-11-21 15:54:38 +00:00
#dd .Audio0/volume DEO
2021-09-21 19:31:48 +00:00
2021-09-18 19:01:34 +00:00
( center )
.Screen/width DEI2 2// .center/x STZ2
.Screen/height DEI2 2// .center/y STZ2
2021-09-26 22:21:16 +00:00
.center/x LDZ2 #0020 --
2021-11-21 15:54:38 +00:00
DUP2 .keypad-frame/x STZ2 #0040 ++ .keypad-frame/x2 STZ2
2021-09-26 22:21:16 +00:00
.center/y LDZ2 #0018 --
2021-11-21 15:54:38 +00:00
DUP2 .keypad-frame/y STZ2 #003f ++ .keypad-frame/y2 STZ2
2021-09-18 19:01:34 +00:00
.keypad-frame/x LDZ2
2021-11-21 15:54:38 +00:00
DUP2 .modpad-frame/x STZ2 #0040 ++ .modpad-frame/x2 STZ2
.keypad-frame/y LDZ2 #0040 ++
2021-11-21 15:54:38 +00:00
DUP2 .modpad-frame/y STZ2 #001f ++ .modpad-frame/y2 STZ2
.keypad-frame/x LDZ2
2021-11-21 15:54:38 +00:00
DUP2 .bitpad-frame/x STZ2 #0040 ++ .bitpad-frame/x2 STZ2
2021-11-12 20:26:45 +00:00
.modpad-frame/y2 LDZ2 #0008 ++
2021-11-21 15:54:38 +00:00
DUP2 .bitpad-frame/y STZ2 #000f ++ .bitpad-frame/y2 STZ2
2021-09-18 19:01:34 +00:00
2021-09-26 22:21:16 +00:00
.center/x LDZ2 #0020 --
2021-11-21 15:54:38 +00:00
DUP2 .input-frame/x STZ2 #0040 ++ .input-frame/x2 STZ2
2021-10-20 18:52:51 +00:00
.center/y LDZ2 #002a --
2021-11-21 15:54:38 +00:00
DUP2 .input-frame/y STZ2 #0010 ++ .input-frame/y2 STZ2
2021-09-19 03:24:39 +00:00
2021-09-21 23:37:19 +00:00
( theme support )
;load-theme JSR2
2021-09-18 19:01:34 +00:00
BRK
2021-09-20 20:42:23 +00:00
@on-button ( -> )
.Controller/key DEI
2021-11-21 15:54:38 +00:00
( generics )
#00 !~ ,&no-release JCN ;redraw JSR2 POP BRK &no-release
#0d !~ ,&no-enter JCN ;do-push JSR2 POP BRK &no-enter
#1b !~ ,&no-esc JCN ;do-pop JSR2 POP BRK &no-esc
#08 !~ ,&no-backspace JCN
2021-09-20 22:36:13 +00:00
.input/value LDZ2 #04 SFT2 .input/value STZ2
2021-11-21 15:54:38 +00:00
#ff ;draw-input JSR2 POP BRK
2021-09-20 22:36:13 +00:00
&no-backspace
2021-11-21 15:54:38 +00:00
( 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 )
2021-09-20 20:42:23 +00:00
;key-value JSR2 ;push-input JSR2
BRK
2021-09-18 19:01:34 +00:00
@on-mouse ( -> )
2021-09-19 03:24:39 +00:00
;pointer-icn .Screen/addr DEO2
2021-11-17 19:35:59 +00:00
2021-09-18 19:01:34 +00:00
( clear last cursor )
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
#40 .Screen/sprite DEO
( draw new cursor )
2021-11-17 19:35:59 +00:00
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
2021-09-18 19:01:34 +00:00
#41 .Mouse/state DEI #01 = + .Screen/sprite DEO
2021-10-20 18:52:51 +00:00
( handle events )
.Mouse/state DEI .pointer/last LDZ
DUP2 #0100 !! ,&no-down JCN
.Mouse/state DEI .pointer/last STZ
POP2
.Mouse/x DEI2 .Mouse/y DEI2
2021-11-21 15:54:38 +00:00
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
2021-10-20 18:52:51 +00:00
POP2 POP2
BRK
&no-down
DUP2 #0001 !! ,&no-up JCN
.Mouse/state DEI .pointer/last STZ
POP2 ;redraw JSR2 BRK
&no-up
POP2
.Mouse/state DEI .pointer/last STZ
2021-09-18 19:01:34 +00:00
BRK
2021-09-19 04:25:50 +00:00
@click-keypad ( x* y* -> )
2021-09-18 19:01:34 +00:00
2021-11-17 19:35:59 +00:00
( y ) .keypad-frame/y LDZ2 -- #24 SFT2
( x ) SWP2 .keypad-frame/x LDZ2 -- 10// 4MOD2
( value ) ++ ;keypad/layout ++ LDA
;push-input JSR2
2021-09-18 19:27:19 +00:00
2021-11-17 19:44:48 +00:00
RELEASE-MOUSE
2021-09-18 19:01:34 +00:00
BRK
2021-09-19 04:25:50 +00:00
@click-modpad ( x* y* -> )
2021-11-17 19:35:59 +00:00
( y ) .modpad-frame/y LDZ2 -- #24 SFT2 NIP STH
2021-11-17 20:07:14 +00:00
( x ) .modpad-frame/x LDZ2 -- 10//
2021-11-21 15:54:38 +00:00
( lookup ) STHr + 2** ;keypad/ops ++ LDA2 JSR2
2021-09-23 00:48:04 +00:00
;draw-bitpad JSR2
2021-11-17 19:44:48 +00:00
RELEASE-MOUSE
2021-09-19 04:25:50 +00:00
BRK
@click-bitpad ( x* y* -> )
2021-11-17 20:07:14 +00:00
( y ) .bitpad-frame/y LDZ2 -- 8// NIP 8* STH
( x ) .bitpad-frame/x LDZ2 -- 8// NIP
( value ) STHr + STHk
2021-09-23 00:48:04 +00:00
#30 + .Audio0/pitch DEO
( toggle bit )
.input/value LDZ2 #0001
[ STHr #0f SWP - ] #40 SFT SFT2 EOR2
.input/value STZ2
;draw-bitpad JSR2
2021-11-17 19:44:48 +00:00
RELEASE-MOUSE
BRK
2021-09-19 04:25:50 +00:00
@click-input ( x* y* -> )
POP2
.input-frame/x LDZ2 -- 8// NIP
2021-10-20 18:52:51 +00:00
DUP #00 ! ,&no-push JCN
;do-push JSR2
2021-09-19 04:25:50 +00:00
&no-push
2021-10-20 18:52:51 +00:00
DUP #01 ! ,&no-pop JCN
2021-09-20 20:42:23 +00:00
;do-pop JSR2
2021-09-19 04:25:50 +00:00
&no-pop
POP
2021-11-17 19:44:48 +00:00
RELEASE-MOUSE
2021-09-19 04:25:50 +00:00
BRK
2021-09-20 20:42:23 +00:00
@push-input ( key -- )
2021-09-18 19:27:19 +00:00
2021-09-21 23:37:19 +00:00
DUP #50 + .Audio0/pitch DEO
2021-09-20 22:36:13 +00:00
DUP TOS ;keypad/series ++ LDA ;draw-keypad JSR2
2021-11-17 20:07:14 +00:00
TOS .input/value LDZ2 10** ++ .input/value STZ2
( INCZ ) .input/length LDZk INC SWP STZ
2021-09-20 22:36:13 +00:00
#ff ;draw-input JSR2
2021-09-23 00:48:04 +00:00
;draw-bitpad JSR2
2021-09-20 20:42:23 +00:00
RTN
2021-09-19 04:25:50 +00:00
@push ( value* -- )
( store ) .stack/length LDZ 2* .stack/items + STZ2
2021-11-17 20:07:14 +00:00
( INCZ ) .stack/length LDZk INC SWP STZ
2021-09-19 04:25:50 +00:00
( reset ) #0000 .input/value STZ2
2021-09-20 22:36:13 +00:00
#00 ;draw-input JSR2
2021-09-19 04:25:50 +00:00
;draw-stack JSR2
RTN
@pop ( -- value* )
.stack/length LDZ #01 - 2* .stack/items + LDZ2
2021-11-17 20:07:14 +00:00
( clear ) #0000 [ .stack/length LDZ #01 - 2* .stack/items + ] STZ2
( DECZ ) .stack/length LDZk #01 - SWP STZ
2021-09-20 22:36:13 +00:00
#01 ;draw-input JSR2
2021-09-19 04:25:50 +00:00
;draw-stack JSR2
RTN
2021-09-20 22:36:13 +00:00
@do-push ( -- )
2021-11-17 20:07:14 +00:00
.input/value LDZ2 ADD #00 > JMP RTN
.stack/length LDZ #07 < JMP RTN
2021-09-21 23:37:19 +00:00
#40 .Audio0/pitch DEO
2021-09-20 22:36:13 +00:00
.input/value LDZ2 ;push JSR2
RTN
2021-09-20 20:42:23 +00:00
@do-pop ( -- )
2021-09-20 22:36:13 +00:00
#0000 .input/value STZ2
.stack/length LDZ #00 = ,&continue JCN
2021-09-21 23:37:19 +00:00
#41 .Audio0/pitch DEO
2021-09-20 22:36:13 +00:00
;pop JSR2 POP2
;draw-stack JSR2
&continue
#01 ;draw-input JSR2
2021-09-20 20:42:23 +00:00
RTN
@do-add ( -- )
2021-09-20 22:51:54 +00:00
.input/value LDZ2 #0000 == ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
2021-09-21 23:37:19 +00:00
#42 .Audio0/pitch DEO
2021-09-20 22:36:13 +00:00
#00 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 ADD2 ;push JSR2
2021-09-20 20:42:23 +00:00
RTN
@do-sub ( -- )
2021-09-20 22:51:54 +00:00
.input/value LDZ2 #0000 == ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
2021-09-21 23:37:19 +00:00
#43 .Audio0/pitch DEO
2021-09-20 22:36:13 +00:00
#01 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 SUB2 ;push JSR2
2021-09-20 20:42:23 +00:00
RTN
@do-mul ( -- )
2021-09-20 22:51:54 +00:00
.input/value LDZ2 #0000 == ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
2021-09-21 23:37:19 +00:00
#44 .Audio0/pitch DEO
2021-09-20 22:36:13 +00:00
#02 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 MUL2 ;push JSR2
2021-09-20 20:42:23 +00:00
RTN
@do-div ( -- )
2021-09-20 22:51:54 +00:00
.input/value LDZ2 #0000 == ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
2021-09-21 23:37:19 +00:00
#45 .Audio0/pitch DEO
2021-09-20 22:36:13 +00:00
#03 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 DIV2 ;push JSR2
2021-09-20 20:42:23 +00:00
RTN
2021-11-12 20:26:45 +00:00
@do-and ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
#46 .Audio0/pitch DEO
#04 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 AND2 ;push JSR2
RTN
@do-ora ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
#47 .Audio0/pitch DEO
#05 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 ORA2 ;push JSR2
RTN
@do-eor ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
#48 .Audio0/pitch DEO
#06 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 EOR2 ;push JSR2
RTN
@do-not ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #00 > RTN?
#49 .Audio0/pitch DEO
#07 ;draw-modpad JSR2
;pop JSR2 #ffff EOR2 ;push JSR2
RTN
2021-09-20 20:42:23 +00:00
@key-value ( key -- value )
DUP #2f > OVR #3a < #0101 !! ,&no-num JCN
#30 - RTN
&no-num
DUP #60 > OVR #67 < #0101 !! ,&no-lc JCN
#57 - RTN ( #61 - #0a + )
&no-lc
DUP #40 > OVR #47 < #0101 !! ,&no-uc JCN
#37 - RTN ( #41 - #0a + )
&no-uc
POP #00
RTN
2021-09-18 19:01:34 +00:00
@redraw ( -- )
2021-09-20 22:36:13 +00:00
#ff ;draw-keypad JSR2
#ff ;draw-modpad JSR2
#ff ;draw-input JSR2
;draw-bitpad JSR2
2021-10-20 18:52:51 +00:00
,draw-stack JSR
2021-09-19 04:25:50 +00:00
RTN
@draw-stack ( -- )
#08 #00
&loop
2021-09-20 22:36:13 +00:00
( color ) DUP #08 .stack/length LDZ - #01 - > STH
( value ) DUP 2* .stack/items + [ #10 .stack/length LDZ 2* - - ] LDZ2 STH2
2021-10-20 18:52:51 +00:00
( y ) DUP TOS 8** .input-frame/y LDZ2 ++ #004c -- STH2
( x ) .input-frame/x LDZ2 #0020 ++ STH2r STH2r STHr ,draw-short JSR
2021-09-19 04:25:50 +00:00
INC GTHk ,&loop JCN
POP2
RTN
@draw-short ( x* y* value* color -- )
2021-09-19 15:25:23 +00:00
STH STH2
2021-09-19 04:25:50 +00:00
.Screen/y DEO2
2021-10-20 18:52:51 +00:00
#0020 ++ .Screen/x DEO2
2021-11-17 20:07:14 +00:00
#0400
2021-09-19 04:25:50 +00: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
2021-10-20 18:52:51 +00:00
( get color ) ROTr STHkr
( place stack ) ROTr ROTr
( no leading zeros )
OVR STH2kr ,get-length JSR < ,&visible JCN
POP #00
&visible
( draw ) .Screen/sprite DEO
2021-09-19 04:25:50 +00:00
INC GTHk ,&loop JCN
POP2
2021-09-19 15:25:23 +00:00
POP2r POPr
2021-09-18 19:27:19 +00:00
RTN
2021-09-20 22:36:13 +00:00
@get-length ( short* -- length )
2021-09-26 22:21:16 +00:00
DUP2 #1000 << ,&no4 JCN POP2 #04 RTN &no4
DUP2 #0100 << ,&no3 JCN POP2 #03 RTN &no3
DUP2 #0010 << ,&no2 JCN POP2 #02 RTN &no2
2021-09-20 22:36:13 +00:00
#0000 !!
RTN
2021-11-17 20:54:47 +00:00
@draw-decimal ( -- )
.bitpad-frame/y2 LDZ2 #0008 ++ .Screen/y DEO2
.center/x LDZ2 #0014 -- .Screen/x DEO2
#01 .Screen/auto DEO
.input/value LDZ2
( 10,000 ) #2710 DIV2k DUP2 NIP ,&digit JSR [ MUL2 SUB2 ]
( 1,000 ) #03e8 DIV2k DUP2 NIP ,&digit JSR [ MUL2 SUB2 ]
( 100 ) #0064 DIV2k DUP2 NIP ,&digit JSR [ MUL2 SUB2 NIP ]
( 10 ) #0a DIVk DUP ,&digit JSR [ MUL SUB ]
( 1 ) ,&digit JSR
#00 .Screen/auto DEO
RTN
&digit ( num -- )
8* TOS ;font-hex ++ .Screen/addr DEO2
#03 .Screen/sprite DEO
RTN
2021-09-20 22:36:13 +00:00
@draw-input ( key -- )
STH
2021-10-20 18:52:51 +00:00
( draw value )
.input-frame/x LDZ2 #0020 ++
.input-frame/y LDZ2 #0003 ++
.input/value LDZ2
#02
;draw-short JSR2
2021-09-18 19:01:34 +00:00
2021-09-19 03:24:39 +00:00
( controls )
2021-10-20 18:52:51 +00:00
.input-frame/x LDZ2
2021-09-19 03:24:39 +00:00
.input-frame/y LDZ2
;stack-icns/push [ STHkr #00 = ] #02
;draw-key-thin JSR2
2021-09-19 03:24:39 +00:00
2021-10-20 18:52:51 +00:00
.input-frame/x LDZ2 #0008 ++
2021-09-19 03:24:39 +00:00
.input-frame/y LDZ2
;stack-icns/pop [ STHkr #01 = ] #03
;draw-key-thin JSR2
2021-09-19 03:24:39 +00:00
2021-09-20 22:36:13 +00:00
( line )
.input-frame/x LDZ2
.input-frame/x2 LDZ2
.input-frame/y LDZ2 #0004 -- #02
;line-hor-dotted JSR2
2021-09-19 03:24:39 +00:00
2021-09-20 22:36:13 +00:00
POPr
2021-09-19 03:24:39 +00:00
2021-11-17 20:54:47 +00:00
;draw-decimal JSR2
2021-09-18 19:01:34 +00:00
RTN
2021-09-20 22:36:13 +00:00
@draw-keypad ( key -- )
2021-09-18 19:01:34 +00:00
2021-09-20 22:36:13 +00:00
STH
2021-09-18 19:01:34 +00:00
#10 #00
&loop
( color ) DUP TOS ;keypad/color ++ LDA STH
2021-09-20 22:36:13 +00:00
( state ) DUP OVRr STHr = STH
2021-09-18 19:01:34 +00:00
( layout ) DUP TOS ;keypad/layout ++ LDA
( layout addr ) TOS 8** ;font-hex ++ STH2
( x ) DUP 4MOD TOS 10** STH2
( y ) DUP 4/ TOS 10**
( origin-x ) STH2r .keypad-frame/x LDZ2 ++ SWP2
( origin-y ) .keypad-frame/y LDZ2 ++
2021-09-20 22:36:13 +00:00
STH2r STHr STHr ;draw-key JSR2
2021-09-18 19:01:34 +00:00
INC GTHk ,&loop JCN
POP2
2021-09-20 22:36:13 +00:00
POPr
2021-09-18 19:01:34 +00:00
RTN
2021-09-20 22:36:13 +00:00
@draw-modpad ( key -- )
2021-09-18 19:01:34 +00:00
2021-09-20 22:36:13 +00:00
STH
2021-11-12 20:26:45 +00:00
#08 #00
2021-09-18 19:01:34 +00:00
&loop
( state ) DUP STHkr = STH
( glyph ) DUP TOS 8** ;mod-icns ++ STH2
2021-11-12 20:26:45 +00:00
( y ) DUP 4/ TOS 10** .modpad-frame/y LDZ2 ++ STH2
( x ) DUP 4MOD TOS 10** .modpad-frame/x LDZ2 ++ STH2
STH2r STH2r STH2r STHr #03 ;draw-key JSR2
2021-09-18 19:01:34 +00:00
INC GTHk ,&loop JCN
POP2
2021-09-20 22:36:13 +00:00
POPr
2021-09-18 19:01:34 +00:00
RTN
@draw-bitpad ( -- )
#10 #00
&loop
2021-11-21 15:54:38 +00:00
( y ) DUP 8/ TOS 8** .bitpad-frame/y LDZ2 ++ .Screen/y DEO2
( x ) DUP 8MOD TOS 8** .bitpad-frame/x LDZ2 ++ .Screen/x DEO2
( state ) DUP #0f SWP - .input/value LDZ2 ROT SFT2 2MOD2
( addr ) 8** ;bit-icns ++ .Screen/addr DEO2
#01 .Screen/sprite DEO
INC GTHk ,&loop JCN
POP2
RTN
2021-09-20 22:36:13 +00:00
@draw-key ( x* y* glyph* state color -- )
2021-09-18 19:01:34 +00:00
2021-09-19 03:24:39 +00:00
( auto x addr ) #05 .Screen/auto DEO
2021-09-20 22:36:13 +00:00
( color ) ,&color STR
( state ) ,&state STR
( glyph ) ,&glyph STR2
( state ) ;button-icns [ #00 ,&state LDR 20** ++ ] .Screen/addr DEO2
( y ) .Screen/y DEO2
( x ) .Screen/x DEO2
2021-09-20 22:36:13 +00:00
( draw background )
,&color LDR .Screen/sprite DEO
,&color LDR .Screen/sprite DEO
2021-09-18 19:01:34 +00:00
.Screen/x DEI2 #0010 -- .Screen/x DEO2
.Screen/y DEI2 #0008 ++ .Screen/y DEO2
2021-11-21 15:54:38 +00:00
,&color LDR .Screen/sprite DEOk DEO
2021-09-18 19:01:34 +00:00
( glyph )
2021-09-20 22:36:13 +00:00
,&glyph LDR2 .Screen/addr DEO2
2021-09-18 19:01:34 +00:00
.Screen/x DEI2 #000c -- .Screen/x DEO2
.Screen/y DEI2 #0005 -- .Screen/y DEO2
2021-09-20 22:36:13 +00:00
,&color LDR [ ,&state LDR #09 MUL + ] .Screen/sprite DEO
2021-09-19 03:24:39 +00:00
( auto none ) #00 .Screen/auto DEO
2021-09-18 19:01:34 +00:00
RTN
2021-09-20 22:36:13 +00:00
&color $1 &state $1 &glyph $2
2021-09-18 19:01:34 +00:00
@draw-key-thin ( x* y* glyph* state color -- )
( auto y addr ) #06 .Screen/auto DEO
( color ) ,&color STR
( state ) ,&state STR
( glyph ) ,&glyph STR2
( state ) ;button-thin-icns [ #00 ,&state LDR 10** ++ ] .Screen/addr DEO2
( y ) .Screen/y DEO2
( x ) .Screen/x DEO2
( draw background )
2021-11-21 15:54:38 +00:00
,&color LDR .Screen/sprite DEOk DEO
( glyph )
,&glyph LDR2 .Screen/addr DEO2
.Screen/y DEI2 #000c -- .Screen/y DEO2
#05 .Screen/sprite DEO
( auto none ) #00 .Screen/auto DEO
RTN
&color $1 &state $1 &glyph $2
2021-09-21 23:37:19 +00:00
( theme )
@theme-txt ".theme $1
@load-theme ( -- )
;theme-txt .File/name DEO2
#0006 .File/length DEO2
2021-11-07 19:10:30 +00:00
#fffa .File/read DEO2
2021-09-21 23:37:19 +00:00
.File/success DEI2 #0006 !! ,&ignore JCN
#fffa LDA2 .System/r DEO2
#fffc LDA2 .System/g DEO2
#fffe LDA2 .System/b DEO2
&ignore
;redraw JSR2
RTN
2021-09-18 19:01:34 +00:00
@within-rect ( x* y* rect -- flag )
STH
( y < rect.y1 ) DUP2 STHkr #02 ADD 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
RTN
&skip
POP2 POP2 POPr
#00
RTN
2021-09-20 22:36:13 +00:00
@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
2021-09-18 19:01:34 +00:00
@print-hex ( value* -- )
&short ( value* -- )
SWP ,&echo JSR
&byte ( value -- )
,&echo JSR
RTN
&echo ( value -- )
STHk #04 SFT ,&parse JSR .Console/write DEO
STHr #0f AND ,&parse JSR .Console/write DEO
RTN
&parse ( value -- char )
DUP #09 GTH ,&above JCN #30 + RTN &above #09 - #60 + RTN
RTN
@keypad
&layout
0708 090f
0405 060e
0102 030d
000a 0b0c
2021-09-20 22:36:13 +00:00
&series
0c08 090a
0405 0600
0102 0d0e
0f0b 0703
2021-09-18 19:01:34 +00:00
&color
0101 0102
0101 0102
0101 0102
0102 0202
2021-11-21 15:54:38 +00:00
&ops
:do-add :do-sub :do-mul :do-div
:do-and :do-ora :do-eor :do-not
2021-09-21 23:37:19 +00:00
@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
2021-09-18 19:01:34 +00:00
@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 007c 8202 1e02 0202
007c 8282 7c82 827c 007c 8282 7e02 827c
007c 8202 7e82 827e 00fc 8282 fc82 82fc
007c 8280 8080 827c 00fc 8282 8282 82fc
007c 8280 f080 827c 007c 8280 f080 8080
@mod-icns
0010 1010 fe10 1010
0000 0000 fe00 0000
0010 5428 c628 5410
0010 0000 fe00 0010
2021-11-12 20:26:45 +00:00
0078 8484 4836 8876
0010 1010 1010 1010
0000 1028 4482 0000
0000 0060 920c 0000
2021-09-20 22:36:13 +00:00
@button-icns
2021-11-21 15:54:38 +00:00
( outline )
2021-09-19 03:24:39 +00:00
3f40 8080 8080 8080
f804 0202 0202 0202
8080 8080 8040 3f00
0202 0202 0204 f800
2021-11-21 15:54:38 +00:00
( full )
2021-09-20 22:36:13 +00:00
3f7f ffff ffff ffff
f8fc fefe fefe fefe
ffff ffff ff7f 3f00
fefe fefe fefc f800
2021-09-19 03:24:39 +00:00
@button-thin-icns
2021-11-21 15:54:38 +00:00
( outline )
3844 8282 8282 8282
8282 8282 8244 3800
2021-11-21 15:54:38 +00:00
( full )
387c fefe fefe fefe
fefe fefe fe7c 3800
@bit-icns
2021-11-21 15:54:38 +00:00
( outline )
2021-09-23 00:48:04 +00:00
3844 8282 8244 3800
2021-11-21 15:54:38 +00:00
( full )
2021-09-23 00:48:04 +00:00
387c fefe fe7c 3800
2021-09-19 03:24:39 +00:00
@stack-icns
&push
0000 1028 1000 0000
2021-09-19 03:24:39 +00:00
&pop
0000 2810 2800 0000
2021-09-19 03:24:39 +00:00
@pointer-icn
2021-09-18 19:01:34 +00:00
80c0 e0f0 f8e0 1000