333 lines
6.7 KiB
Tal
333 lines
6.7 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
|
|
|c0 @DateTime &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1
|
|
|
|
|0000
|
|
|
|
@pos &x $2 &y $2
|
|
@force &x $2 &y $2
|
|
@angle $2
|
|
@stage
|
|
&w $1 &h $1 &id $2
|
|
|
|
|0100 ( -> )
|
|
|
|
( theme )
|
|
#0ff0 .System/r DEO2
|
|
#0f0f .System/g DEO2
|
|
#0f0f .System/b DEO2
|
|
( resize )
|
|
#0260 .Screen/width DEO2
|
|
#01a0 .Screen/height DEO2
|
|
( vectors )
|
|
;on-frame .Screen/vector DEO2
|
|
;on-control .Controller/vector DEO2
|
|
prng-init
|
|
( get stage )
|
|
.Screen/width DEI2 #03 SFT2 NIP .stage/w STZ
|
|
.Screen/height DEI2 #03 SFT2 NIP .stage/h STZ
|
|
|
|
#0100 .pos/x STZ2
|
|
#00a0 .pos/y STZ2
|
|
set-terrain
|
|
redraw
|
|
|
|
BRK
|
|
|
|
(
|
|
@|vectors )
|
|
|
|
@on-frame ( -> )
|
|
|
|
[ LIT &f $1 ] INCk ,&f STR
|
|
#01 AND ?&no-read
|
|
.Controller/button DEI
|
|
DUP #10 AND #00 EQU ?&no-u
|
|
.angle LDZ2 thruster
|
|
&no-u
|
|
DUP #20 AND #00 EQU ?&no-d
|
|
#0010 .force/y STZ2
|
|
&no-d
|
|
DUP #40 AND #00 EQU ?&no-l
|
|
.angle LDZ2 #0001 SUB2 #001f AND2 .angle STZ2
|
|
&no-l
|
|
DUP #80 AND #00 EQU ?&no-r
|
|
.angle LDZ2 INC2 #001f AND2 .angle STZ2
|
|
&no-r
|
|
POP
|
|
|
|
&no-read
|
|
apply-force
|
|
( .force/y LDZ2 phex #0a18 DEO )
|
|
redraw
|
|
draw-stage
|
|
|
|
BRK
|
|
|
|
@on-control ( -> )
|
|
|
|
BRK
|
|
|
|
(
|
|
@|core )
|
|
|
|
@thruster ( angle* -- )
|
|
|
|
#10 SFT2 ;circle-tbl ADD2 LDA2 POP
|
|
( make short )
|
|
#80 SUB
|
|
DUP #80 AND #00 NEQ STH #ff00 STHr [ JMP SWP POP ] SWP
|
|
reduce3 .force/x LDZ2 ADD2 .force/x STZ2
|
|
.angle LDZ2 #0020 ADD2 #001f AND2 #10 SFT2 ;circle-tbl ADD2 LDA2 NIP
|
|
( make short )
|
|
#80 ADD
|
|
DUP #80 AND #00 NEQ STH #ff00 STHr [ JMP SWP POP ] SWP
|
|
reduce3
|
|
.force/y LDZ2 ADD2 .force/y STZ2
|
|
#08 ;draw-lander/plume STA
|
|
|
|
JMP2r
|
|
|
|
@apply-force ( -- )
|
|
|
|
[ LIT &f $1 ] INCk ,&f STR
|
|
#03 AND ?&skip
|
|
.force/y LDZ2 INC2 .force/y STZ2
|
|
;draw-lander/plume LDA #00 EQU ?&skip
|
|
;draw-lander/plume LDA #01 SUB ;draw-lander/plume STA
|
|
&skip
|
|
.force/y LDZ2 reduce .pos/y LDZ2 ADD2 .pos/y STZ2
|
|
.force/x LDZ2 reduce .pos/x LDZ2 ADD2 .pos/x STZ2
|
|
|
|
JMP2r
|
|
|
|
@reduce ( force* -- )
|
|
|
|
DUP2 #8000 AND2 ORA ?&neg
|
|
#01 SFT2
|
|
|
|
JMP2r
|
|
&neg abs2 #01 SFT2 #0000 SWP2 SUB2 JMP2r
|
|
|
|
@reduce3 ( force* -- )
|
|
|
|
DUP2 #8000 AND2 ORA ?&neg
|
|
#05 SFT2
|
|
|
|
JMP2r
|
|
&neg abs2 #05 SFT2 #0000 SWP2 SUB2 JMP2r
|
|
|
|
(
|
|
@|terrain )
|
|
|
|
@set-terrain ( -- )
|
|
|
|
.stage/w LDZ INC INC #00
|
|
&loop
|
|
( height/2 ) .stage/h LDZ #01 SFT
|
|
( rand ) prng #0a SFT2 NIP ADD #01 SFT
|
|
( v offset ) #10 ADD
|
|
( store ) OVR #00 SWP ;terrain ADD2 STA
|
|
INC GTHk ,&loop JCN
|
|
POP2
|
|
( soften )
|
|
#0800
|
|
&loop-soften
|
|
soften
|
|
INC GTHk ?&loop-soften
|
|
POP2
|
|
|
|
JMP2r
|
|
|
|
@soften ( -- )
|
|
|
|
.stage/w LDZ #00
|
|
&loop2
|
|
( a ) #00 OVR ;terrain ADD2 LDA STH
|
|
( b ) #00 OVR INC ;terrain ADD2 LDA STH
|
|
( c ) #00 OVR INC INC ;terrain ADD2 LDA STH
|
|
#00 STHr #00 STHr ADD2 #00 STHr ADD2 #0003 DIV2 NIP
|
|
( store ) OVR #00 SWP ;terrain ADD2 STA
|
|
INC GTHk ,&loop2 JCN
|
|
POP2
|
|
|
|
JMP2r
|
|
|
|
@create-platform ( x -- height )
|
|
|
|
#01 SUB
|
|
#00 SWP ;terrain ADD2 DUP2
|
|
( average ) LDAk STH INC2 LDAk STH INC2 ADDr LDAk STH INC2 ADDr LDA STH ADDr
|
|
LITr 04 DIVr
|
|
( flatten ) STHkr ROT ROT STAk INC2 STAk INC2 STAk INC2 STA
|
|
STHr
|
|
|
|
JMP2r
|
|
|
|
(
|
|
@|drawing )
|
|
|
|
@redraw ( -- )
|
|
|
|
#0000
|
|
DUP2 .Screen/x DEO2
|
|
.Screen/y DEO2
|
|
[ LIT2 80 -Screen/pixel ] DEO
|
|
|
|
@draw-lander ( -- )
|
|
|
|
( 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 )
|
|
[ LIT2r &plume $1 09 ] ADDr
|
|
#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-stage ( color -- )
|
|
|
|
( x ) #0000 .Screen/x DEO2
|
|
.stage/w LDZ #00
|
|
&loop
|
|
STHk
|
|
( a )
|
|
#00 OVR #30 SFT2
|
|
#00 STHr ;terrain ADD2 STH2k LDA #01 SUB #00 SWP #30 SFT2
|
|
( b )
|
|
OVR2 #0008 ADD2
|
|
STH2r INC2 LDA #01 SUB #00 SWP #30 SFT2
|
|
#43 draw-line
|
|
INC GTHk ?&loop
|
|
POP2
|
|
|
|
JMP2r
|
|
|
|
@get-pt ( id rad -- x* y* )
|
|
|
|
#00 SWP STH2
|
|
.angle LDZ2 #001f AND2 NIP ADD
|
|
|
|
#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 #03ff AND2
|
|
ROT
|
|
#00 SWP STH2kr MUL2 #04 SFT2
|
|
( center ) #0080 STH2kr #30 SFT2 SUB2 ADD2 #02 SFT2
|
|
( pos ) .pos/x LDZ2 ADD2 #03ff AND2
|
|
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
|
|
|
|
(
|
|
@|prng )
|
|
|
|
@prng-init ( -- )
|
|
|
|
( seed )
|
|
#00 .DateTime/second DEI
|
|
#00 .DateTime/minute DEI #60 SFT2 EOR2
|
|
#00 .DateTime/hour DEI #c0 SFT2 EOR2 ,prng/x STR2
|
|
#00 .DateTime/hour DEI #04 SFT2
|
|
#00 .DateTime/day DEI #10 SFT2 EOR2
|
|
#00 .DateTime/month DEI #60 SFT2 EOR2
|
|
.DateTime/year DEI2 #a0 SFT2 EOR2 ,prng/y STR2
|
|
|
|
JMP2r
|
|
|
|
@prng ( -- number* )
|
|
|
|
LIT2 &x $2
|
|
DUP2 #50 SFT2 EOR2
|
|
DUP2 #03 SFT2 EOR2
|
|
LIT2 &y $2 DUP2 ,&x STR2
|
|
DUP2 #01 SFT2 EOR2 EOR2
|
|
,&y STR2k POP
|
|
|
|
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 ]
|
|
|
|
@terrain
|
|
|