220 lines
4.3 KiB
Tal
220 lines
4.3 KiB
Tal
( uxnemu lander.rom )
|
|
|
|
|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2
|
|
|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
|
|
|
|
|0000
|
|
|
|
@pos &x $2 &y $2
|
|
@force &x $2 &y $2
|
|
@angle $2
|
|
|
|
|0100 ( -> )
|
|
|
|
( theme )
|
|
#0ff0 .System/r DEO2
|
|
#0f0f .System/g DEO2
|
|
#0f0f .System/b DEO2
|
|
( resize )
|
|
#0200 .Screen/width DEO2
|
|
#0160 .Screen/height DEO2
|
|
( vectors )
|
|
;on-frame .Screen/vector DEO2
|
|
;on-control .Controller/vector DEO2
|
|
redraw
|
|
|
|
BRK
|
|
|
|
(
|
|
@|vectors )
|
|
|
|
@on-frame ( -> )
|
|
|
|
[ LIT &f $1 ] INCk ,&f STR
|
|
#01 AND ?&no-read
|
|
.Controller/button DEI
|
|
DUP #10 NEQ ?&no-u
|
|
.force/y LDZ2 #0008 SUB2 .force/y STZ2
|
|
&no-u
|
|
DUP #40 NEQ ?&no-l
|
|
.angle LDZ2 #0001 SUB2 .angle STZ2
|
|
;draw-lander/plume LDA INC ;draw-lander/plume STA
|
|
&no-l
|
|
DUP #80 NEQ ?&no-r
|
|
.angle LDZ2 INC2 .angle STZ2
|
|
;draw-lander/plume LDA INC ;draw-lander/plume STA
|
|
&no-r
|
|
POP
|
|
|
|
&no-read
|
|
apply-force
|
|
( .force/y LDZ2 phex #0a18 DEO )
|
|
redraw
|
|
|
|
BRK
|
|
|
|
@on-control ( -> )
|
|
|
|
BRK
|
|
|
|
(
|
|
@|core )
|
|
|
|
@apply-force ( -- )
|
|
|
|
.force/y LDZ2 INC2 .force/y STZ2
|
|
.force/y LDZ2 reduce .pos/y LDZ2 ADD2 .pos/y STZ2
|
|
|
|
JMP2r
|
|
|
|
@reduce ( force* -- )
|
|
|
|
DUP2 #8000 AND2 ORA ?&neg
|
|
#02 SFT2
|
|
JMP2r
|
|
&neg abs2 #02 SFT2 #0000 SWP2 SUB2 JMP2r
|
|
|
|
(
|
|
@|drawing )
|
|
|
|
@redraw ( -- )
|
|
|
|
#0000
|
|
DUP2 .Screen/x DEO2
|
|
.Screen/y DEO2
|
|
#80 .Screen/pixel DEO
|
|
draw-lander
|
|
|
|
JMP2r
|
|
|
|
@draw-lander ( orientation -- )
|
|
|
|
( base )
|
|
#0c06 get-pt #1406 get-pt #01 draw-line
|
|
#0d08 get-pt #1308 get-pt #01 draw-line
|
|
#0c06 get-pt #0d08 get-pt #01 draw-line
|
|
#1406 get-pt #1308 get-pt #01 draw-line
|
|
( legs )
|
|
#0d08 get-pt #0d0c get-pt #01 draw-line
|
|
#1308 get-pt #130c get-pt #01 draw-line
|
|
#0d0c get-pt #0e0f get-pt #01 draw-line
|
|
#130c get-pt #120f get-pt #01 draw-line
|
|
( plume )
|
|
[ LIT &plume $1 ] #03 AND #0c ADD STH
|
|
#0e08 get-pt #1208 get-pt #02 draw-line
|
|
#0e08 get-pt #10 STHkr get-pt #02 draw-line
|
|
#1208 get-pt #10 STHr get-pt #02 draw-line
|
|
( face )
|
|
#26 .Screen/auto DEO
|
|
;face-icn .Screen/addr DEO2
|
|
#0014 .pos/x LDZ2 ADD2 .Screen/x DEO2
|
|
#0014 .pos/y LDZ2 ADD2 .Screen/y DEO2
|
|
#05 .Screen/sprite DEOk DEOk DEO
|
|
#00 .Screen/auto DEO
|
|
|
|
JMP2r
|
|
|
|
@draw-circle ( radius* -- )
|
|
|
|
;get-point/radius STA2
|
|
#2000
|
|
&l
|
|
STHk
|
|
INCk get-point
|
|
STHr get-point
|
|
#01 draw-line
|
|
INC GTHk ?&l
|
|
POP2
|
|
|
|
JMP2r
|
|
|
|
@get-pt ( id rad -- x* y* )
|
|
|
|
#00 SWP STH2
|
|
|
|
.angle LDZ2 NIP ADD
|
|
|
|
!get-point/force
|
|
|
|
@get-point ( id -- x* y* )
|
|
|
|
[ LIT2r &radius $2 ]
|
|
&force
|
|
#1f AND DUP ADD
|
|
#00 SWP ;circle-tbl ADD2 LDA2
|
|
#00 SWP STH2kr MUL2 #04 SFT2
|
|
( center ) #0080 STH2kr #30 SFT2 SUB2 ADD2 #02 SFT2
|
|
( pos ) .pos/y LDZ2 ADD2
|
|
ROT
|
|
#00 SWP STH2kr MUL2 #04 SFT2
|
|
( center ) #0080 STH2kr #30 SFT2 SUB2 ADD2 #02 SFT2
|
|
( pos ) .pos/x LDZ2 ADD2
|
|
SWP2
|
|
POP2r
|
|
|
|
JMP2r
|
|
|
|
@draw-line ( x1* y1* x2* y2* color -- )
|
|
|
|
,&color STR
|
|
,&y STR2
|
|
,&x STR2
|
|
,&y2 STR2
|
|
,&x2 STR2
|
|
,&x LDR2 ,&x2 LDR2 SUB2 abs2 ,&dx STR2
|
|
#0000 ,&y LDR2 ,&y2 LDR2 SUB2 abs2 SUB2 ,&dy STR2
|
|
#ffff [ LIT2 00 _&x2 ] LDR2 ,&x LDR2 lts2 DUP2 ADD2 ADD2 ,&sx STR2
|
|
#ffff [ LIT2 00 _&y2 ] LDR2 ,&y LDR2 lts2 DUP2 ADD2 ADD2 ,&sy STR2
|
|
[ LIT2 &dx $2 ] [ LIT2 &dy $2 ] ADD2 STH2
|
|
&while
|
|
[ LIT2 &x2 $2 ] DUP2 .Screen/x DEO2 [ LIT2 &x $2 ] EQU2
|
|
[ LIT2 &y2 $2 ] DUP2 .Screen/y DEO2 [ LIT2 &y $2 ] EQU2
|
|
[ LIT2 &color $1 -Screen/pixel ] DEO
|
|
AND ?&end
|
|
STH2kr DUP2 ADD2 DUP2
|
|
,&dy LDR2 lts2 ?&skipy
|
|
STH2r ,&dy LDR2 ADD2 STH2
|
|
,&x2 LDR2 [ LIT2 &sx $2 ] ADD2 ,&x2 STR2
|
|
&skipy
|
|
,&dx LDR2 gts2 ?&while
|
|
STH2r ,&dx LDR2 ADD2 STH2
|
|
,&y2 LDR2 [ LIT2 &sy $2 ] ADD2 ,&y2 STR2
|
|
!&while
|
|
&end
|
|
POP2r
|
|
|
|
JMP2r
|
|
|
|
(
|
|
@|stdlib )
|
|
|
|
@abs2 DUP2 #0f SFT2 EQU ?&end #0000 SWP2 SUB2 &end JMP2r
|
|
@lts2 #8000 STH2k ADD2 SWP2 STH2r ADD2 GTH2 JMP2r
|
|
@gts2 #8000 STH2k ADD2 SWP2 STH2r ADD2 LTH2 JMP2r
|
|
|
|
@phex ( short* -- )
|
|
SWP phex/b
|
|
&b DUP #04 SFT phex/c
|
|
&c #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
|
|
JMP2r
|
|
|
|
@face-icn [
|
|
0000 0000 0102 0408 0000 007e 8100 3cc3
|
|
0000 0000 8040 2010 0911 1212 1212 1109
|
|
0000 0042 0042 3c00 9088 4848 4848 8890
|
|
0804 0201 0000 0000 c33c 0081 7e00 0000
|
|
1020 4080 0000 0000
|
|
|
|
]
|
|
|
|
@circle-tbl [
|
|
8000 9802 b009 c715 da25 ea38 f64f fd67
|
|
ff80 fd98 f6b0 eac7 dada c7ea b0f6 98fd
|
|
80ff 67fd 4ff6 38ea 25da 15c7 09b0 0298
|
|
0080 0267 094f 1538 2525 3815 4f09 6702 ]
|
|
|