mirror of
https://git.sr.ht/~rabbits/uxn
synced 2024-11-01 03:52:39 +00:00
545 lines
11 KiB
Tal
545 lines
11 KiB
Tal
( 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 }
|
|
|
|
%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 }
|
|
%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 ]
|
|
|40 @Audio1 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|
|
|50 @Audio2 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|
|
|60 @Audio3 [ &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
|
|
@rect
|
|
&x1 $2 &y1 $2 &x2 $2 &y2 $2
|
|
@pointer
|
|
&x $2 &y $2 &lastx $2 &lasty $2 &state $1
|
|
@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
|
|
|
|
( 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 #0010 --
|
|
DUP2 .input-frame/x STZ2
|
|
#0040 ++ .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 BRK?
|
|
|
|
.Controller/key DEI
|
|
DUP #0d ! ,&no-enter JCN
|
|
;send-input 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
|
|
;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 BRK?
|
|
|
|
.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
|
|
POP
|
|
|
|
( release mouse ) #00 .Mouse/state DEO
|
|
|
|
BRK
|
|
|
|
@click-input ( x* y* -> )
|
|
|
|
POP2
|
|
.input-frame/x LDZ2 #0008 ++ -- 10// NIP
|
|
DUP #01 ! ,&no-push JCN
|
|
.input/value LDZ2 #0001 << ,&no-push-empty JCN
|
|
;send-input JSR2
|
|
&no-push-empty
|
|
&no-push
|
|
DUP #02 ! ,&no-pop JCN
|
|
;do-pop JSR2
|
|
&no-pop
|
|
POP
|
|
|
|
( release mouse ) #00 .Mouse/state DEO
|
|
|
|
BRK
|
|
|
|
@push-input ( key -- )
|
|
|
|
TOS .input/value LDZ2 #40 SFT2 ++ .input/value STZ2
|
|
.input/length LDZ INC .input/length STZ
|
|
;draw-input JSR2
|
|
|
|
RTN
|
|
|
|
@send-input ( -- )
|
|
|
|
.input/value LDZ2 ;push 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
|
|
;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
|
|
;draw-input JSR2
|
|
;draw-stack JSR2
|
|
|
|
RTN
|
|
|
|
@do-pop ( -- )
|
|
|
|
.stack/length LDZ BRK?
|
|
;pop JSR2 POP2
|
|
;draw-input JSR2
|
|
;draw-stack JSR2
|
|
|
|
RTN
|
|
|
|
@do-add ( -- )
|
|
|
|
.stack/length LDZ #01 > BRK?
|
|
;pop JSR2 ;pop JSR2 ADD2 ;push JSR2
|
|
|
|
RTN
|
|
|
|
@do-sub ( -- )
|
|
|
|
.stack/length LDZ #01 > BRK?
|
|
;pop JSR2 ;pop JSR2 SUB2 ;push JSR2
|
|
|
|
RTN
|
|
|
|
@do-mul ( -- )
|
|
|
|
.stack/length LDZ #01 > BRK?
|
|
;pop JSR2 ;pop JSR2 MUL2 ;push JSR2
|
|
|
|
RTN
|
|
|
|
@do-div ( -- )
|
|
|
|
.stack/length LDZ #01 > BRK?
|
|
;pop JSR2 ;pop JSR2 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 ( -- )
|
|
|
|
;draw-keypad JSR2
|
|
;draw-modpad JSR2
|
|
;draw-input JSR2
|
|
;draw-stack JSR2
|
|
|
|
RTN
|
|
|
|
@draw-stack ( -- )
|
|
|
|
#08 #00
|
|
&loop
|
|
( color ) DUP .stack/length LDZ < STH
|
|
( value ) DUP 2* .stack/items + LDZ2 STH2
|
|
( y ) DUP TOS 8** #0070 SWP2 -- 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
|
|
|
|
@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 )
|
|
|
|
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-keypad ( -- )
|
|
|
|
#10 #00
|
|
&loop
|
|
( color ) DUP TOS ;keypad/color ++ LDA 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 ;key-icns/full STHr ;draw-key JSR2
|
|
INC GTHk ,&loop JCN
|
|
POP2
|
|
|
|
RTN
|
|
|
|
@draw-modpad ( -- )
|
|
|
|
#04 #00
|
|
&loop
|
|
( color ) DUP TOS ;modpad/color ++ LDA 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 ;key-icns/full STHr ;draw-key JSR2
|
|
INC GTHk ,&loop JCN
|
|
POP2
|
|
|
|
RTN
|
|
|
|
@draw-key ( x* y* glyph* style* color -- )
|
|
|
|
( auto x addr ) #05 .Screen/auto DEO
|
|
( frame )
|
|
STH
|
|
( style ) .Screen/addr DEO2
|
|
STH2 ROTr
|
|
.Screen/y DEO2
|
|
.Screen/x DEO2
|
|
STHkr .Screen/sprite DEO
|
|
STHkr .Screen/sprite DEO
|
|
.Screen/x DEI2 #0010 -- .Screen/x DEO2
|
|
.Screen/y DEI2 #0008 ++ .Screen/y DEO2
|
|
STHkr .Screen/sprite DEO
|
|
STHkr .Screen/sprite DEO
|
|
( glyph )
|
|
ROTr ROTr STH2r .Screen/addr DEO2
|
|
.Screen/x DEI2 #000c -- .Screen/x DEO2
|
|
.Screen/y DEI2 #0005 -- .Screen/y DEO2
|
|
STHr #04 MUL .Screen/sprite DEO
|
|
( auto none ) #00 .Screen/auto DEO
|
|
|
|
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-rect ( rect color -- )
|
|
|
|
STH STH
|
|
( y2 ) STHkr #06 + LDZ2
|
|
( y1 ) STHkr #02 + LDZ2 #0001 -- ( flip sign ) GTH2k SWP2?
|
|
&ver
|
|
( save ) DUP2 .Screen/y DEO2
|
|
( x1 ) STHkr LDZ2 #0001 -- .Screen/x DEO2
|
|
OVRr STHr .Screen/pixel DEO
|
|
( x2 ) STHkr #04 + LDZ2 .Screen/x DEO2
|
|
OVRr STHr .Screen/pixel DEO
|
|
( incr )
|
|
INC2 GTH2k ,&ver JCN
|
|
POP2
|
|
( x2 ) STHkr #04 + LDZ2
|
|
( x1 ) STHkr LDZ2 #0001 -- ( flip sign ) GTH2k SWP2?
|
|
&hor
|
|
( save ) DUP2 .Screen/x DEO2
|
|
( y1 ) STHkr #02 + LDZ2 #0001 -- .Screen/y DEO2
|
|
OVRr STHr .Screen/pixel DEO
|
|
( y2 ) STHkr #06 + LDZ2 .Screen/y DEO2
|
|
OVRr STHr .Screen/pixel DEO
|
|
( incr )
|
|
INC2 GTH2k ,&hor JCN
|
|
POP2
|
|
POPr
|
|
.Screen/x DEO2
|
|
.Screen/y DEO2
|
|
STHr .Screen/pixel DEO
|
|
|
|
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
|
|
&color
|
|
0101 0102
|
|
0101 0102
|
|
0101 0102
|
|
0102 0202
|
|
|
|
@modpad
|
|
&color
|
|
0303 0303
|
|
0303 0303
|
|
|
|
@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
|
|
|
|
@key-icns
|
|
&full
|
|
3f7f ffff ffff ffff
|
|
f8fc fefe fefe fefe
|
|
ffff ffff ff7f 3f00
|
|
fefe fefe fefc f800
|
|
&outline
|
|
3f40 8080 8080 8080
|
|
f804 0202 0202 0202
|
|
8080 8080 8040 3f00
|
|
0202 0202 0204 f800
|
|
|
|
@stack-icns
|
|
&push
|
|
ffff ffef d7bb ffff
|
|
&pop
|
|
ffff efc7 83c7 efff
|
|
|
|
@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
|
|
80c0 e0f0 f8e0 1000
|