uxn-utils/gui/lander/lander.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