142 lines
2.6 KiB
Tal
142 lines
2.6 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
|
|
|
|
|0100 ( -> )
|
|
|
|
( theme )
|
|
#0f00 .System/r DEO2
|
|
#0fff .System/g DEO2
|
|
#0f0f .System/b DEO2
|
|
( resize )
|
|
#0190 .Screen/width DEO2
|
|
#00f0 .Screen/height DEO2
|
|
( vectors )
|
|
;on-control .Controller/vector DEO2
|
|
redraw
|
|
|
|
BRK
|
|
|
|
(
|
|
@|vectors )
|
|
|
|
@on-control ( -> )
|
|
|
|
.Controller/button DEI
|
|
DUP #10 NEQ ?&no-u
|
|
redraw
|
|
&no-u
|
|
DUP #20 NEQ ?&no-d
|
|
redraw
|
|
&no-d
|
|
POP
|
|
|
|
|
|
BRK
|
|
|
|
(
|
|
@|drawing )
|
|
|
|
@redraw ( -- )
|
|
|
|
#0000
|
|
DUP2 .Screen/x DEO2
|
|
.Screen/y DEO2
|
|
#80 .Screen/pixel DEO
|
|
[ LIT &o $1 ] draw-lander
|
|
|
|
JMP2r
|
|
|
|
@draw-lander ( orientation -- )
|
|
|
|
POP
|
|
#0010 #0000
|
|
&l
|
|
DUP2 draw-circle
|
|
INC2 GTH2k ?&l
|
|
POP2 POP2
|
|
|
|
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-point ( id -- x* y* )
|
|
|
|
[ LIT2r &radius $2 ]
|
|
#1f AND DUP ADD
|
|
#00 SWP ;circle-tbl ADD2 LDA2
|
|
#00 SWP STH2kr MUL2 #04 SFT2
|
|
ROT
|
|
#00 SWP STH2r MUL2 #04 SFT2
|
|
SWP2
|
|
|
|
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
|
|
|
|
@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 ]
|
|
|