( a simple calculator )
%+ { ADD } %- { SUB } %/ { DIV }
%< { LTH } %> { GTH } %= { EQU } %! { NEQ }
%++ { ADD2 } %-- { SUB2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }
%2* { #10 SFT }
%4* { #20 SFT } %4/ { #02 SFT }
%2** { #10 SFT2 } %2// { #01 SFT2 }
%4** { #20 SFT2 }
%8** { #30 SFT2 } %8// { #03 SFT2 }
%10** { #40 SFT2 } %10// { #04 SFT2 }
%20** { #50 SFT2 }
%4MOD { #03 AND }
%DEBUG { ;print-hex/byte JSR2 #0a .Console/write DEO }
%DEBUG2 { ;print-hex/short JSR2 #0a .Console/write DEO }
%RTN { JMP2r }
%SWP2? { #01 JCN SWP2 }
%BRK? { #01 JCN BRK }
%RTN? { #01 JCN 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 &offset-hs $2 &offset-ls $2 &name $2 &length $2 &load $2 &save $2 ]
|b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
( variables )
|0000
@input
&length $1 &value $2
@stack
&length $1
&items $10
@center
&x $2 &y $2
@pointer
&x $2 &y $2
@keypad-frame
&x $2 &y $2 &x2 $2 &y2 $2
@modpad-frame
&x $2 &y $2 &x2 $2 &y2 $2
@input-frame
&x $2 &y $2 &x2 $2 &y2 $2
( program )
|0100 ( -> )
( theme )
#0fef .System/r DEO2
#0fc5 .System/g DEO2
#0f25 .System/b DEO2
( size )
#0120 .Screen/width DEO2
#0160 .Screen/height DEO2
( vectors )
;on-mouse .Mouse/vector DEO2
;on-button .Controller/vector DEO2
( setup synth )
#0208 .Audio0/adsr DEO2
;saw-wav .Audio0/addr DEO2
#0100 .Audio0/length DEO2
#dd .Audio0/volume DEO ( TODO: turn ON )
( center )
.Screen/width DEI2 2// .center/x STZ2
.Screen/height DEI2 2// .center/y STZ2
.center/x LDZ2 #0028 --
DUP2 .keypad-frame/x STZ2
#0040 ++ .keypad-frame/x2 STZ2
.center/y LDZ2 #0020 --
DUP2 .keypad-frame/y STZ2
#0040 ++ .keypad-frame/y2 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 #0028 --
DUP2 .input-frame/x STZ2
#0050 ++ .input-frame/x2 STZ2
.center/y LDZ2 #0030 --
DUP2 .input-frame/y STZ2
#0010 ++ .input-frame/y2 STZ2
;redraw JSR2
BRK
@on-button ( -> )
.Controller/key DEI #00 ! ,&continue JCN
;redraw JSR2 BRK
&continue
.Controller/key DEI
DUP #0d ! ,&no-enter JCN
;do-push JSR2 POP BRK
&no-enter
DUP LIT '+ ! ,&no-add 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
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
#ff ;draw-input JSR2
POP BRK
&no-backspace
;key-value JSR2 ;push-input JSR2
BRK
@on-mouse ( -> )
;pointer-icn .Screen/addr DEO2
( clear last cursor )
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
#40 .Screen/sprite DEO
( record pointer positions )
.Mouse/x DEI2 .pointer/x STZ2
.Mouse/y DEI2 .pointer/y STZ2
( draw new cursor )
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
#41 .Mouse/state DEI #01 = + .Screen/sprite DEO
.Mouse/state DEI #00 ! ,&continue JCN
;redraw JSR2 BRK
&continue
.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 ( x* y* -> )
( get key )
.keypad-frame/y LDZ2 -- 10// 4**
SWP2 .keypad-frame/x LDZ2 -- 10// #0003 AND2
++ ;keypad/layout ++ LDA ;push-input 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 ;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
POP
( release mouse ) #00 .Mouse/state DEO
BRK
@click-input ( x* y* -> )
POP2
.input-frame/x LDZ2 #0008 ++ -- 10// NIP
DUP #03 ! ,&no-push JCN
.input/value LDZ2 #0001 << ,&no-push-empty JCN
;do-push JSR2
&no-push-empty
&no-push
DUP #04 ! ,&no-pop JCN
;do-pop JSR2
&no-pop
POP
( release mouse ) #00 .Mouse/state DEO
BRK
@push-input ( key -- )
DUP TOS ;keypad/notes ++ LDA .Audio0/pitch DEO
DUP TOS ;keypad/series ++ LDA ;draw-keypad JSR2
TOS .input/value LDZ2 #40 SFT2 ++ .input/value STZ2
.input/length LDZ INC .input/length STZ
#ff ;draw-input JSR2
RTN
@push ( value* -- )
( store ) .stack/length LDZ 2* .stack/items + STZ2
( incr ) .stack/length LDZ INC .stack/length STZ
( reset ) #0000 .input/value STZ2
#00 ;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
#01 ;draw-input JSR2
;draw-stack JSR2
RTN
@do-push ( -- )
.stack/length LDZ #07 < ,&continue JCN
RTN
&continue
.input/value LDZ2 ;push JSR2
RTN
@do-pop ( -- )
#0000 .input/value STZ2
.stack/length LDZ #00 = ,&continue JCN
;pop JSR2 POP2
;draw-stack JSR2
&continue
#01 ;draw-input JSR2
RTN
@do-add ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
#00 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 ADD2 ;push JSR2
RTN
@do-sub ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
#01 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 SUB2 ;push JSR2
RTN
@do-mul ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
#02 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 MUL2 ;push JSR2
RTN
@do-div ( -- )
.input/value LDZ2 #0000 == ,&no-push JCN
;do-push JSR2
&no-push
( stack empty ) .stack/length LDZ #01 > RTN?
#03 ;draw-modpad JSR2
;pop JSR2 ;pop JSR2 SWP2 DIV2 ;push JSR2
RTN
@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
@redraw ( -- )
#ff ;draw-keypad JSR2
#ff ;draw-modpad JSR2
#ff ;draw-input JSR2
;draw-stack JSR2
RTN
@draw-stack ( -- )
#08 #00
&loop
( color ) DUP #08 .stack/length LDZ - #01 - > STH
( value ) DUP 2* .stack/items + [ #10 .stack/length LDZ 2* - - ] LDZ2 STH2
( y ) DUP TOS 8** .input-frame/y LDZ2 ++ #0048 -- STH2
( x ) #0088 STH2r STH2r STHr ;draw-short JSR2
INC GTHk ,&loop JCN
POP2
RTN
@draw-short ( x* y* value* color -- )
STH 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
ROTr STHkr ROTr ROTr .Screen/sprite DEO
INC GTHk ,&loop JCN
POP2
POP2r POPr
RTN
@get-length ( short* -- length )
DUP2 #0fff << ,&no4 JCN POP2 #04 RTN &no4
DUP2 #00ff << ,&no3 JCN POP2 #03 RTN &no3
DUP2 #000f << ,&no2 JCN POP2 #02 RTN &no2
#0000 !!
RTN
@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
&loop
( color ) DUP TOS ;keypad/color ++ LDA STH
( state ) DUP OVRr STHr = STH
( 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 ++
STH2r STHr STHr ;draw-key JSR2
INC GTHk ,&loop JCN
POP2
POPr
RTN
@draw-modpad ( key -- )
STH
#04 #00
&loop
( color ) #03 STH
( state ) DUP OVRr STHr = STH
( layout ) DUP TOS 8** ;mod-icns ++ STH2
( x ) #0000 STH2
( y ) DUP TOS 10**
( origin-x ) STH2r .modpad-frame/x LDZ2 ++ SWP2
( origin-y ) .modpad-frame/y LDZ2 ++
STH2r STHr STHr ;draw-key JSR2
INC GTHk ,&loop JCN
POP2
POPr
RTN
@draw-key ( x* y* glyph* state color -- )
( auto x addr ) #05 .Screen/auto DEO
( 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
( draw background )
,&color LDR .Screen/sprite DEO
,&color LDR .Screen/sprite DEO
.Screen/x DEI2 #0010 -- .Screen/x DEO2
.Screen/y DEI2 #0008 ++ .Screen/y DEO2
,&color LDR .Screen/sprite DEO
,&color LDR .Screen/sprite DEO
( glyph )
,&glyph LDR2 .Screen/addr DEO2
.Screen/x DEI2 #000c -- .Screen/x DEO2
.Screen/y DEI2 #0005 -- .Screen/y DEO2
,&color LDR [ ,&state LDR #09 MUL + ] .Screen/sprite DEO
( auto none ) #00 .Screen/auto DEO
RTN
&color $1 &state $1 &glyph $2
@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
@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
@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
&series
0c08 090a
0405 0600
0102 0d0e
0f0b 0703
&color
0101 0102
0101 0102
0101 0102
0102 0202
¬es
484a 4c4d
4f51 5354
5658 595b
5d5f 6062
6465 6769
@saw-wav
0003 0609 0c0f 1215 181b 1e21 2427 2a2d
3033 3639 3b3e 4143 4649 4b4e 5052 5557
595b 5e60 6264 6667 696b 6c6e 7071 7274
7576 7778 797a 7b7b 7c7d 7d7e 7e7e 7e7e
7f7e 7e7e 7e7e 7d7d 7c7b 7b7a 7978 7776
7574 7271 706e 6c6b 6967 6664 6260 5e5b
5957 5552 504e 4b49 4643 413e 3b39 3633
302d 2a27 2421 1e1b 1815 120f 0c09 0603
00fd faf7 f4f1 eeeb e8e5 e2df dcd9 d6d3
d0cd cac7 c5c2 bfbd bab7 b5b2 b0ae aba9
a7a5 a2a0 9e9c 9a99 9795 9492 908f 8e8c
8b8a 8988 8786 8585 8483 8382 8282 8282
8182 8282 8282 8383 8485 8586 8788 898a
8b8c 8e8f 9092 9495 9799 9a9c 9ea0 a2a5
a7a9 abae b0b2 b5b7 babd bfc2 c5c7 cacd
d0d3 d6d9 dcdf e2e5 e8eb eef1 f4f7 fafd
@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
@button-icns
&outline
3f40 8080 8080 8080
f804 0202 0202 0202
8080 8080 8040 3f00
0202 0202 0204 f800
&full
3f7f ffff ffff ffff
f8fc fefe fefe fefe
ffff ffff ff7f 3f00
fefe fefe fefc f800
@stack-icns
&push
0000 0010 2844 0000
&pop
0000 1038 7c38 1000
@pointer-icn
80c0 e0f0 f8e0 1000