mirror of https://git.sr.ht/~rabbits/uxn
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
760 lines
16 KiB
760 lines
16 KiB
( |
|
a simple calculator |
|
uxnasm projects/software/calc.tal bin/calc.rom && uxnemu bin/calc.rom ) |
|
|
|
%+ { ADD } %- { SUB } %* { MUL } %/ { DIV } |
|
%< { LTH } %> { GTH } %= { EQU } %! { NEQ } |
|
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 } |
|
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 } |
|
|
|
%2* { #10 SFT } %2/ { #01 SFT } %2** { #10 SFT2 } %2// { #01 SFT2 } |
|
%4* { #20 SFT } %4/ { #02 SFT } %4** { #20 SFT2 } %4// { #02 SFT2 } |
|
%8* { #30 SFT } %8/ { #03 SFT } %8** { #30 SFT2 } %8// { #03 SFT2 } |
|
%10* { #40 SFT } %10/ { #04 SFT } %10** { #40 SFT2 } %10// { #04 SFT2 } |
|
%20* { #50 SFT } %20/ { #05 SFT } %20** { #50 SFT2 } %20// { #05 SFT2 } |
|
|
|
%2MOD { #01 AND } %2MOD2 { #0001 AND2 } |
|
%4MOD { #03 AND } %4MOD2 { #0003 AND2 } |
|
%8MOD { #07 AND } %8MOD2 { #0007 AND2 } |
|
%10MOD { #0f AND } %10MOD2 { #000f AND2 } |
|
|
|
%!~ { NEQk NIP } |
|
|
|
%DEBUG { ;print-hex/byte JSR2 #0a .Console/write DEO } |
|
%DEBUG2 { ;print-hex/short JSR2 #0a .Console/write DEO } |
|
|
|
%AUTO-NONE { #00 .Screen/auto DEO } |
|
%AUTO-X { #01 .Screen/auto DEO } |
|
%AUTO-XADDR { #05 .Screen/auto DEO } |
|
%AUTO-YADDR { #06 .Screen/auto DEO } |
|
|
|
%RELEASE-MOUSE { #0096 DEO } |
|
|
|
%RTN { JMP2r } |
|
%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 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ] |
|
|
|
( variables ) |
|
|
|
|0000 |
|
|
|
@input |
|
&value $2 |
|
&mode $1 |
|
@stack |
|
&length $1 |
|
&items $10 |
|
@center |
|
&x $2 &y $2 |
|
@pointer |
|
&x $2 &y $2 &last $1 |
|
@keypad-frame |
|
&x $2 &y $2 &x2 $2 &y2 $2 |
|
@modpad-frame |
|
&x $2 &y $2 &x2 $2 &y2 $2 |
|
@bitpad-frame |
|
&x $2 &y $2 &x2 $2 &y2 $2 |
|
@input-frame |
|
&x $2 &y $2 &x2 $2 &y2 $2 |
|
|
|
( program ) |
|
|
|
|0100 ( -> ) |
|
|
|
( theme ) |
|
#0e7d .System/r DEO2 |
|
#0ec6 .System/g DEO2 |
|
#0e95 .System/b DEO2 |
|
|
|
( size ) |
|
#0090 .Screen/width DEO2 |
|
#0100 .Screen/height DEO2 |
|
|
|
( vectors ) |
|
;on-mouse .Mouse/vector DEO2 |
|
;on-button .Controller/vector DEO2 |
|
|
|
( setup synth ) |
|
#0010 .Audio0/adsr DEO2 |
|
;sin-pcm .Audio0/addr DEO2 |
|
#0100 .Audio0/length DEO2 |
|
#dd .Audio0/volume DEO |
|
|
|
( center ) |
|
.Screen/width DEI2 2// .center/x STZ2 |
|
.Screen/height DEI2 2// .center/y STZ2 |
|
|
|
.center/x LDZ2 #0020 -- |
|
DUP2 .keypad-frame/x STZ2 #0040 ++ .keypad-frame/x2 STZ2 |
|
.center/y LDZ2 #0018 -- |
|
DUP2 .keypad-frame/y STZ2 #003f ++ .keypad-frame/y2 STZ2 |
|
|
|
.keypad-frame/x LDZ2 |
|
DUP2 .modpad-frame/x STZ2 #0040 ++ .modpad-frame/x2 STZ2 |
|
.keypad-frame/y LDZ2 #0040 ++ |
|
DUP2 .modpad-frame/y STZ2 #001f ++ .modpad-frame/y2 STZ2 |
|
|
|
.keypad-frame/x LDZ2 |
|
DUP2 .bitpad-frame/x STZ2 #0040 ++ .bitpad-frame/x2 STZ2 |
|
.modpad-frame/y2 LDZ2 #0008 ++ |
|
DUP2 .bitpad-frame/y STZ2 #000f ++ .bitpad-frame/y2 STZ2 |
|
|
|
.center/x LDZ2 #0020 -- |
|
DUP2 .input-frame/x STZ2 #0040 ++ .input-frame/x2 STZ2 |
|
.center/y LDZ2 #002a -- |
|
DUP2 .input-frame/y STZ2 #0010 ++ .input-frame/y2 STZ2 |
|
|
|
( theme support ) |
|
;load-theme JSR2 |
|
|
|
BRK |
|
|
|
@on-button ( -> ) |
|
|
|
.Controller/key DEI |
|
( generics ) |
|
#00 !~ ,&no-empty JCN ;redraw JSR2 POP BRK &no-empty |
|
#09 !~ ,&no-tab JCN ;toggle-mode JSR2 POP BRK &no-tab |
|
#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 ;do-erase JSR2 POP BRK &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 |
|
|
|
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 |
|
|
|
( draw new cursor ) |
|
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2 |
|
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2 |
|
#41 .Mouse/state DEI #01 = + .Screen/sprite DEO |
|
|
|
.Mouse/state DEI .pointer/last LDZ |
|
( down ) |
|
DUP2 #0100 !! ,&no-down JCN |
|
.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 |
|
OVR2 OVR2 .bitpad-frame ;within-rect JSR2 ;click-bitpad JCN2 |
|
POP2 POP2 |
|
&no-down |
|
( up ) |
|
DUP2 #0001 !! ,&no-up JCN |
|
;redraw JSR2 |
|
&no-up |
|
POP2 |
|
( record ) |
|
.Mouse/state DEI .pointer/last STZ |
|
|
|
BRK |
|
|
|
@click-keypad ( state* x* y* -> ) |
|
|
|
( y ) .keypad-frame/y LDZ2 -- #24 SFT2 |
|
( x ) SWP2 .keypad-frame/x LDZ2 -- 10// 4MOD2 |
|
( value ) ++ ;keypad/layout ++ LDA ;push-input JSR2 |
|
RELEASE-MOUSE POP2 |
|
|
|
BRK |
|
|
|
@click-modpad ( state* x* y* -> ) |
|
|
|
( y ) .modpad-frame/y LDZ2 -- #24 SFT2 NIP STH |
|
( x ) .modpad-frame/x LDZ2 -- 10// |
|
( lookup ) STHr + 2** ;keypad/ops ++ LDA2 JSR2 |
|
;draw-bitpad JSR2 |
|
RELEASE-MOUSE POP2 |
|
|
|
BRK |
|
|
|
@click-input ( state* x* y* -> ) |
|
|
|
POP2 |
|
.input-frame/x LDZ2 -- 8// NIP |
|
DUP #00 ! ,&no-push JCN |
|
;do-push JSR2 &no-push |
|
DUP #01 ! ,&no-pop JCN |
|
;do-pop JSR2 &no-pop |
|
POP |
|
RELEASE-MOUSE POP2 |
|
|
|
BRK |
|
|
|
@click-bitpad ( state* x* y* -> ) |
|
|
|
( y ) .bitpad-frame/y LDZ2 -- 8// NIP 8* STH |
|
( x ) .bitpad-frame/x LDZ2 -- 8// NIP |
|
( value ) STHr + STHk |
|
|
|
#30 + .Audio0/pitch DEO |
|
|
|
( toggle bit ) |
|
.input/value LDZ2 #0001 |
|
[ STHr #0f SWP - ] #40 SFT SFT2 EOR2 |
|
.input/value STZ2 |
|
|
|
;draw-bitpad JSR2 |
|
#ff ;draw-input JSR2 |
|
RELEASE-MOUSE POP2 |
|
|
|
BRK |
|
|
|
@push-input ( key -- ) |
|
|
|
DUP #50 + .Audio0/pitch DEO |
|
DUP TOS ;keypad/series ++ LDA ;draw-keypad JSR2 |
|
( hex/dec ) |
|
TOS .input/value LDZ2 #00 [ #0a #10 .input/mode LDZ JMP SWP POP ] ** |
|
++ .input/value STZ2 |
|
#ff ;draw-input JSR2 |
|
;draw-bitpad JSR2 |
|
|
|
RTN |
|
|
|
@push ( value* -- ) |
|
|
|
( store ) .stack/length LDZ 2* .stack/items + STZ2 |
|
( INCZ ) .stack/length LDZk INC SWP 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 |
|
( DECZ ) .stack/length LDZk #01 - SWP STZ |
|
#01 ;draw-input JSR2 |
|
;draw-stack JSR2 |
|
|
|
RTN |
|
|
|
@toggle-mode ( -- ) |
|
|
|
.input/mode LDZk #00 = SWP STZ |
|
;redraw JSR2 |
|
|
|
RTN |
|
|
|
@do-push ( -- ) |
|
|
|
.input/value LDZ2 ADD #00 > JMP RTN |
|
.stack/length LDZ #07 < JMP RTN |
|
#40 .Audio0/pitch DEO |
|
.input/value LDZ2 ;push JSR2 |
|
;draw-bitpad JSR2 |
|
|
|
RTN |
|
|
|
@do-pop ( -- ) |
|
|
|
#0000 .input/value STZ2 |
|
.stack/length LDZ #00 = ,&continue JCN |
|
#41 .Audio0/pitch DEO |
|
;pop JSR2 POP2 |
|
;draw-stack JSR2 |
|
&continue |
|
#01 ;draw-input JSR2 |
|
;draw-bitpad JSR2 |
|
|
|
RTN |
|
|
|
@do-add ( -- ) |
|
|
|
.input/value LDZ2 #0000 == ,&no-push JCN |
|
;do-push JSR2 |
|
&no-push |
|
|
|
( stack empty ) .stack/length LDZ #01 > RTN? |
|
|
|
#42 .Audio0/pitch DEO |
|
#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? |
|
|
|
#43 .Audio0/pitch DEO |
|
#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? |
|
|
|
#44 .Audio0/pitch DEO |
|
#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? |
|
|
|
#45 .Audio0/pitch DEO |
|
#03 ;draw-modpad JSR2 |
|
;pop JSR2 ;pop JSR2 SWP2 DIV2 ;push JSR2 |
|
|
|
RTN |
|
|
|
@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 |
|
|
|
@do-erase ( -- ) |
|
|
|
.input/value LDZ2 #04 SFT2 .input/value STZ2 |
|
#ff ;draw-input JSR2 |
|
;draw-bitpad 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-bitpad JSR2 |
|
;draw-mode JSR2 |
|
;draw-stack JSR2 |
|
|
|
#0010 .Screen/x DEO2 |
|
#0010 .Screen/y DEO2 |
|
|
|
RTN |
|
|
|
@draw-mode ( -- ) |
|
|
|
AUTO-XADDR |
|
.input-frame/x LDZ2 .Screen/x DEO2 |
|
.input-frame/y LDZ2 #0014 -- .Screen/y DEO2 |
|
;modes #00 .input/mode LDZ #0018 MUL2 ++ .Screen/addr DEO2 |
|
#02 .input/mode LDZ + .Screen/sprite DEOk DEOk DEO |
|
AUTO-NONE |
|
|
|
RTN |
|
|
|
@draw-stack ( -- ) |
|
|
|
#08 #00 |
|
&loop |
|
.input-frame/x LDZ2 #0018 ++ .Screen/x DEO2 |
|
DUP TOS 8** .input-frame/y LDZ2 ++ #004c -- .Screen/y DEO2 |
|
( color ) DUP #08 .stack/length LDZ - #01 - > STH |
|
( value ) DUP 2* .stack/items + [ #10 .stack/length LDZ 2* - - ] LDZ2 |
|
STHr ;draw-number JSR2 |
|
INC GTHk ,&loop JCN |
|
POP2 |
|
|
|
RTN |
|
|
|
@draw-input ( key -- ) |
|
|
|
STH |
|
( draw value ) |
|
.input-frame/x LDZ2 #0018 ++ .Screen/x DEO2 |
|
.input-frame/y LDZ2 #0003 ++ .Screen/y DEO2 |
|
.input/value LDZ2 #02 ;draw-number JSR2 |
|
( controls ) |
|
.input-frame/x LDZ2 |
|
.input-frame/y LDZ2 |
|
;stack-icns/push [ STHkr #00 = ] #02 |
|
;draw-key-thin JSR2 |
|
.input-frame/x LDZ2 #0008 ++ |
|
.input-frame/y LDZ2 |
|
;stack-icns/pop [ STHkr #01 = ] #03 |
|
;draw-key-thin 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 |
|
#08 #00 |
|
&loop |
|
( state ) DUP STHkr = STH |
|
( glyph ) DUP TOS 8** ;mod-icns ++ STH2 |
|
( 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 |
|
INC GTHk ,&loop JCN |
|
POP2 |
|
POPr |
|
|
|
RTN |
|
|
|
@draw-bitpad ( -- ) |
|
|
|
#1000 |
|
&loop |
|
( 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 |
|
|
|
@draw-key ( x* y* glyph* state color -- ) |
|
|
|
( auto x addr ) AUTO-XADDR |
|
( 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 DEOk 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 ) AUTO-NONE |
|
|
|
RTN |
|
&color $1 &state $1 &glyph $2 |
|
|
|
@draw-key-thin ( x* y* glyph* state color -- ) |
|
|
|
AUTO-YADDR |
|
,&color STR ,&state STR ,&glyph STR2 |
|
( frame ) |
|
;button-thin-icns #00 [ LIT &state $1 ] 10** ++ .Screen/addr DEO2 |
|
.Screen/y DEO2 .Screen/x DEO2 |
|
[ LIT &color $1 ] .Screen/sprite DEOk DEO |
|
( glyph ) |
|
[ LIT2 &glyph $2 ] .Screen/addr DEO2 |
|
.Screen/y DEI2 #000c -- .Screen/y DEO2 |
|
#05 .Screen/sprite DEO |
|
AUTO-NONE |
|
|
|
RTN |
|
|
|
@draw-number ( number* color -- ) |
|
|
|
,&color STR |
|
.input/mode LDZ ,&decimal JCN |
|
( hexadecimal ) |
|
AUTO-X |
|
,&color LDR #00 ,&color STR |
|
#00 ,&digit JSR ,&color STR |
|
SWP |
|
STHk #04 SFT ,&digit JSR |
|
STHr #0f AND ,&digit JSR |
|
STHk #04 SFT ,&digit JSR |
|
STHr #0f AND ,&digit JSR |
|
AUTO-NONE |
|
RTN |
|
&decimal |
|
AUTO-X |
|
#2710 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2 |
|
#03e8 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2 |
|
#0064 DIV2k DUP2 NIP ,&digit JSR MUL2 SUB2 NIP |
|
#0a DIVk DUP ,&digit JSR MUL SUB |
|
,&digit JSR |
|
AUTO-NONE |
|
RTN |
|
&digit |
|
8* TOS ;font-hex ++ .Screen/addr DEO2 |
|
LIT &color $1 .Screen/sprite DEO |
|
RTN |
|
|
|
RTN |
|
|
|
( theme ) |
|
|
|
@theme-txt ".theme $1 |
|
|
|
@load-theme ( -- ) |
|
|
|
;theme-txt .File/name DEO2 |
|
#0006 .File/length DEO2 |
|
#fffa .File/read DEO2 |
|
|
|
.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 |
|
|
|
@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* -- ) |
|
|
|
SWP ,&byte JSR |
|
&byte ( byte -- ) |
|
STHk #04 SFT ,&parse JSR #18 DEO |
|
STHr #0f AND ,&parse JSR #18 DEO |
|
JMP2r |
|
&parse ( byte -- char ) DUP #09 GTH ,&above JCN #30 ADD JMP2r |
|
&above #57 ADD JMP2r |
|
|
|
JMP2r |
|
|
|
@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 |
|
&ops |
|
:do-add :do-sub :do-mul :do-div |
|
:do-and :do-ora :do-eor :do-not |
|
|
|
@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 |
|
|
|
@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 |
|
007e 8080 fe80 807e 007c 8280 f080 8080 |
|
|
|
@modes |
|
( hex ) |
|
0082 8282 fe82 8282 |
|
007e 8080 fe80 807e |
|
0082 4428 1028 4482 |
|
( dec ) |
|
00fc 8282 8282 82fc |
|
007e 8080 fe80 807e |
|
007c 8280 8080 827c |
|
|
|
@mod-icns |
|
0010 1010 fe10 1010 |
|
0000 0000 fe00 0000 |
|
0010 5428 c628 5410 |
|
0010 0000 fe00 0010 |
|
|
|
0078 8484 4836 8876 |
|
0010 1010 1010 1010 |
|
0000 1028 4482 0000 |
|
0000 0060 920c 0000 |
|
|
|
@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 |
|
|
|
@button-thin-icns |
|
( outline ) |
|
3844 8282 8282 8282 |
|
8282 8282 8244 3800 |
|
( full ) |
|
387c fefe fefe fefe |
|
fefe fefe fe7c 3800 |
|
|
|
@bit-icns |
|
( outline ) |
|
3844 8282 8244 3800 |
|
( full ) |
|
387c fefe fe7c 3800 |
|
|
|
@stack-icns |
|
&push |
|
0000 1028 1000 0000 |
|
&pop |
|
0000 2810 2800 0000 |
|
|
|
@pointer-icn |
|
80c0 e0f0 f8e0 1000
|
|
|