uxn/projects/examples/demos/snake.tal

( uxnemu snake.rom )

|00 @System &vector $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 &debug $1 &state $1
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|80 @Controller &vector $2 &button $1 &key $1
|c0 @DateTime &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1
|000

	@arena &w $1 &h $1
	@apple &pos &x $1 &y $1
	@snake &pos &x $1 &y $1 &direction $1 &length $1 &dead $1 &tail $40

|100

@on-reset ( -> )
	( | theme )
	#0f7e .System/r DEO2
	#0fe6 .System/g DEO2
	#0f62 .System/b DEO2
	( | vectors )
	;on-frame .Screen/vector DEO2
	;on-button .Controller/vector DEO2
	( | resize )
	#00c8 .Screen/width DEO2
	#0100 .Screen/height DEO2
	( | set arena )
	.Screen/width DEI2 #03 SFT2 .arena/w STZ
	POP .Screen/height DEI2 #03 SFT2 .arena/h STZ
	POP [ LIT2 01 -Screen/auto ] DEO
	reset BRK

@on-frame ( -> )
	[ LIT &f $1 ] INCk ,&f STR
	#04 GTH ?{ BRK }
	[ LIT2 00 _&f ] STR
	#00 <draw-snake>
	<move>
	[ LIT2 02 -snake/dead ] LDZ ADD <draw-snake>
	#83 <draw-apple>
	<draw-score>
	BRK

@on-button ( -> )
	.Controller/button DEI
	( ) DUP #f0 AND ?&arrow
	( ) #0f AND ?&button
	BRK
	&arrow ( button -> )
	#04 SFT .snake/direction STZ
	BRK
	&button ( -> )
	reset BRK

@reset ( -- )
	#00 <draw-snake>
	#00 <draw-apple>
	[ LIT2 00 -snake/dead ] STZ
	[ LIT2 00 -snake/length ] STZ
	[ LIT2 00 -snake/direction ] STZ
	.arena/w LDZ #01 SFT #01 SUB .snake/x STZ
	.arena/h LDZ #01 SFT #01 SUB .snake/y STZ
	#03 <draw-snake>
	!<add-apple>

@<move> ( -- )
	( | copy tail )
	[ LITr -snake/pos ] LDZ2r .snake/length LDZ #00
	&>loop ( -- )
		DUPk ADD .snake/tail ADD LDZ2k STH2
		SWP2r STH2r ROT STZ2
		INC GTHk ?&>loop
	POP2 POP2r
	( ) .snake/dead LDZ ?&end
	.snake/direction LDZ
	( ) DUP #01 NEQ ?{
		.snake/y LDZk #01 SUB .arena/h set-pos }
	DUP #02 NEQ ?{
		.snake/y LDZk INC .arena/h set-pos }
	DUP #04 NEQ ?{
		.snake/x LDZk #01 SUB .arena/w set-pos }
	DUP #08 NEQ ?{
		.snake/x LDZk INC .arena/w set-pos }
	POP
	( | detect collision with apple )
	.snake/pos LDZ2 .apple/pos LDZ2 NEQ2 ?{
		#00 <draw-apple>
		.snake/length LDZk INC SWP STZ
		<add-apple>
		!<move> }
	( | detect collision with body )
	.snake/length LDZ #01
	&>loop-body ( -- )
		DUPk ADD .snake/tail ADD LDZ2 .snake/pos LDZ2 NEQ2 ?{
			[ LIT2 01 -snake/dead ] STZ
			#03 <draw-snake> }
		INC GTHk ?&>loop-body
	POP2 &end JMP2r

@set-pos ( z mod max -- )
	LDZ OVR INC ?{ ROT STZ
		POP JMP2r }
	DIVk MUL SUB SWP STZ
	JMP2r

@<add-apple> ( -- )
	.DateTime/hour DEI2 .DateTime/minute DEI2 MUL2
	( ) DUP2 #1234 MUL2 ADD .arena/w LDZ DIVk MUL SUB .apple/x STZ
	( ) #abcd MUL2 ADD .arena/h LDZ DIVk MUL SUB .apple/y STZ
	JMP2r

(
@|drawing )

@<draw-snake> ( color -- )
	STH
	( | draw tail )
	;snake-icns .Screen/addr DEO2
	[ LIT2 -snake/tail -snake/length ] LDZ DUP ADD OVR ADD SWP
	&>loop ( -- )
		LDZ2k #0005 SFT2 .Screen/y DEO2
		#0005 SFT2 .Screen/x DEO2
		DUPr [ LITr -Screen/sprite ] DEOr
		INC INC GTHk ?&>loop
	POP2
	( | draw head )
	.snake/pos LDZ2 #0005 SFT2 .Screen/y DEO2
	#0005 SFT2 .Screen/x DEO2
	;snake-icns/face .Screen/addr DEO2
	[ LITr -Screen/sprite ] DEOr
	JMP2r

@<draw-apple> ( color -- )
	.apple/x LDZ #0005 SFT2 .Screen/x DEO2
	.apple/y LDZ #0005 SFT2 .Screen/y DEO2
	STHk ;apple-chr ;fill-icn [ LITr 01 JCNr SWP2 POP2 ] .Screen/addr DEO2
	.Screen/sprite DEO
	JMP2r

@<draw-score> ( -- )
	#0010 DUP2 .Screen/x DEO2
	.Screen/y DEO2
	.snake/length LDZ
	( x0 ) DUP #04 SFT <draw-num>
	( >> )

@<draw-num> ( num -- )
	#000f ROT AND #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2
	[ LIT2 41 -Screen/sprite ] DEO
	JMP2r

(
@|assets )

@snake-icns [ 7eff ffff ffff ff7e ]
	&face [ 7eff ffdb ffe7 ff7e ]

@apple-chr [
	0000 76ff ffff 7e3c 1008 0000 0000 0000 ]

@fill-icn [ ffff ffff ffff ffff ]

@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 ]