uxn-utils/gui/minesweeper/minesweeper.tal

( minesweeper )

|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $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 &func $1
|90 @Mouse &vector $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2
|c0 @DateTime &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2

|0000

	@game &started $1 &timer $2 &dead $1
	@pointer &x $2 &y $2
	@grid &x $2 &y $2 &x2 $2 &y2 $2

( program )

|0100 ( -> )

	( theme )
	#cf80 .System/r DEO2
	#cf80 .System/g DEO2
	#cf80 .System/b DEO2

	( DOS resolution )
	#00a0 .Screen/width DEO2
	#00d0 .Screen/height DEO2

	prng-init
	load-theme

	( place grid )
	#0010 DUP2 .grid/x STZ2 #007f ADD2 .grid/x2 STZ2
	#0040 DUP2 .grid/y STZ2 #007f ADD2 .grid/y2 STZ2

	( draw frames )
	#0008 DUP2 #1004 draw-frame
	#0008 #0038 #1010 draw-frame

	draw-grid
	draw-progress
	draw-status
	draw-timer

	( vectors )
	;on-mouse .Mouse/vector DEO2
	;on-frame .Screen/vector DEO2
	;on-button .Controller/vector DEO2

BRK

@on-frame ( -> )

	.game/started LDZ #00 NEQ [ JMP BRK ]

	[ LIT &f $1 ] #3c NEQ ,&no-second JCN
		#00 ,&f STR
		.game/timer LDZ2k INC2 ROT STZ2
		draw-timer
		&no-second

	,&f LDR INC ,&f STR

BRK

@on-button ( -> )

	.game/dead LDZ #00 EQU ,&alive JCN
		reset
		&alive

BRK

@on-mouse ( -> )

	( clear last cursor )
	.pointer/x LDZ2 .Screen/x DEO2
	.pointer/y LDZ2 .Screen/y DEO2
	#40 .Screen/sprite DEO

	;pointer-icn .Screen/addr DEO2

	( draw new cursor )
	.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
	.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
	#43 .Mouse/state DEI #00 NEQ DUP ADD SUB .Screen/sprite DEO

	.Mouse/state DEI #00 NEQ [ JMP BRK ]

	.Mouse/x DEI2 .Mouse/y DEI2
		OVR2 OVR2 .grid within-rect ;touch-grid JCN2
	POP2 POP2

	.game/dead LDZ #00 EQU ,&alive JCN
		reset
		&alive

	#00 .Mouse/state DEO

BRK

@touch-grid ( x* y* -> )

	.grid/y LDZ2 SUB2 #04 SFT2 NIP STH
	.grid/x LDZ2 SUB2 #04 SFT2 NIP STHr

	( skip on death )
	.game/dead LDZ ,&skip JCN

	.Mouse/state DEI #01 GTH ,touch-grid-flag JCN

	DUP2 reveal

	&skip
	POP2
	#00 .Mouse/state DEO

BRK

@touch-grid-flag ( x y -> )

	( unset )
	DUP2 #30 SFT ADD #00 SWP ;world/flags ADD2 LDA #00 EQU ,&add-flag JCN
		#00 ,&set-flag JSR BRK
		&add-flag
	( add flag if have flags left )
	count-flags ,&has-flags JCN
		POP2 BRK
		&has-flags
	( can set )
	#01 ,&set-flag JSR
	( test victory )
	count-left ,&no-victory JCN
		victory
		&no-victory

BRK
	&set-flag ( x y value -- )
		STH
		#30 SFT ADD #00 SWP ;world/flags ADD2 STHr ROT ROT STA
		draw-progress
		draw-grid
		#00 .Mouse/state DEO
	JMP2r

(
@|core )

@reset ( -- )

	#0000 .game/timer STZ2
	#00 .game/started STZ
	#00 .game/dead STZ

	;world #0100 mclr

	draw-status
	draw-progress
	draw-timer
	draw-grid

JMP2r

@explode ( -- )

	#01 .game/dead STZ
	#00 .game/started STZ
	draw-status
	draw-grid

JMP2r

@victory ( -- )

	#02 .game/dead STZ
	#00 .game/started STZ
	draw-status
	draw-grid

JMP2r

@start ( x y -- )

	#01 .game/started STZ
	prng-init
	#1000
	&while
		#01 prng #003f AND2 ;world ADD2 STA
		INC GTHk ,&while JCN
	POP2
	( remove mine on first click )
	#00 ROT ROT #30 SFT ADD #00 SWP ;world/mines ADD2 STA
	update-values

JMP2r

@reveal ( x y -- )

	( start on idle )
	.game/started LDZ ,&started JCN
		DUP2 start
		&started
	( ignore already revealed )
	DUP2 get-revealed #00 EQU ,&unrevealed JCN
		POP2 JMP2r
		&unrevealed
	( ignore flagged )
	DUP2 #30 SFT ADD #00 SWP ;world/flags ADD2 LDA #00 EQU ,&unflagged JCN
		POP2 JMP2r
		&unflagged
	( test if killing )
	DUP2 get-mine #00 EQU ,&survive JCN
		POP2 explode JMP2r
		&survive
	open
	draw-grid
	draw-progress

JMP2r

@open ( x y -- )

	DUP2 set-revealed

	STH2
	#0800
	&loop
		#00 OVRk ADD2 ;neighbors ADD2 LDA2
		STH2kr ROT ADD ROT ROT ADD SWP
		DUP2 get-revealed ,&continue JCN
		DUP2 get-value ,&continue JCN
			DUP2 open-zone
			&continue
		POP2
		INC GTHk ,&loop JCN
	POP2
	POP2r

JMP2r

@open-zone ( x y -- )

	STH2
	#0800
	&loop
		#00 OVRk ADD2 ;neighbors ADD2 LDA2
		STH2kr ROT ADD ROT ROT ADD SWP
		set-revealed
		INC GTHk ,&loop JCN
	POP2
	STH2r open

JMP2r

@get-value ( x y -- value )

	OVR #08 LTH ,&in-x JCN POP2 #ff JMP2r &in-x
	DUP #08 LTH ,&in-y JCN POP2 #ff JMP2r &in-y
	#30 SFT ADD #00 SWP
	DUP2 ;world/mines ADD2 LDA #00 EQU ,&no-mine JCN
		POP2 #ff JMP2r
		&no-mine
	;world/values ADD2 LDA

JMP2r

@get-revealed ( x y -- value )

	OVR #08 LTH ,&in-x JCN POP2 #ff JMP2r &in-x
	DUP #08 LTH ,&in-y JCN POP2 #ff JMP2r &in-y
	#30 SFT ADD #00 SWP ;world/revealed ADD2 LDA

JMP2r

@set-revealed ( x y -- )

	OVR #08 LTH ,&in-x JCN POP2 JMP2r &in-x
	DUP #08 LTH ,&in-y JCN POP2 JMP2r &in-y
	#30 SFT ADD #00 SWP ;world/revealed ADD2 #01 ROT ROT STA

JMP2r

@update-values ( -- )

	#0800
	&ver
		STHk
		#0800
		&hor
			DUP STHkr ,count-mines-neighbors JSR
			OVR STHkr #30 SFT ADD #00 SWP ;world/values ADD2 STA
			INC GTHk ,&hor JCN
		POP2
		POPr
		#0010 .Screen/x DEO2
		.Screen/y DEI2k #0010 ADD2 ROT DEO2
		INC GTHk ,&ver JCN
	POP2

JMP2r

@count-mines-neighbors ( x y -- count )

	,&origin STR2
	LITr 00
	#0800
	&loop
		( load neighbor ) #00 OVRk ADD2 ;neighbors ADD2 LDA2
		( add positions ) [ LIT2 &origin $2 ] ROT ADD ROT ROT ADD SWP
			( incr counter ) ,get-mine JSR STH ADDr
		INC GTHk ,&loop JCN
	POP2
	STHr

JMP2r

@get-mine ( x y -- flag )

	OVR #08 LTH ,&in-x JCN POP2 #00 JMP2r &in-x
	DUP #08 LTH ,&in-y JCN POP2 #00 JMP2r &in-y
	#30 SFT ADD #00 SWP ;world/mines ADD2 LDA

JMP2r

@count-flags ( -- flags )

	LITr 00
	#4000
	&loop
		#00 OVR ;world/mines ADD2 LDA STH ADDr
		#00 OVR ;world/flags ADD2 LDA STH SUBr
		INC GTHk ,&loop JCN
	POP2
	STHr

JMP2r

@count-left ( -- mines )

	LITr 00
	#4000
	&loop
		#00 OVR ;world/mines ADD2 LDA STH
		#00 OVR ;world/flags ADD2 LDA STH LIT2r 0100 EQU2r ADDr
		INC GTHk ,&loop JCN
	POP2
	STHr

JMP2r

( drawing )

@draw-frame ( x* y* w h -- )

	DUP ,&h2 STR ,&h1 STR
	DUP ,&w2 STR ,&w1 STR
	DUP2 .Screen/y DEO2
	OVR2 .Screen/x DEO2
	#01 .Screen/auto DEO
	;frame-chrs/tl .Screen/addr DEO2
	#81 .Screen/sprite DEO
	;frame-chrs/tc .Screen/addr DEO2
	[ LIT &w1 $1 ] ,&repeat JSR
	#02 .Screen/auto DEO
	;frame-chrs/tr .Screen/addr DEO2
	#81 .Screen/sprite DEO
	;frame-chrs/mr .Screen/addr DEO2
	[ LIT &h1 $1 ] ,&repeat JSR
	( left )
	#0008 ADD2 .Screen/y DEO2
	.Screen/x DEO2
	;frame-chrs/ml .Screen/addr DEO2
	[ LIT &h2 $1 ] ,&repeat JSR
	#01 .Screen/auto DEO
	;frame-chrs/bl .Screen/addr DEO2
	#81 .Screen/sprite DEO
	;frame-chrs/bc .Screen/addr DEO2
	[ LIT &w2 $1 ] ,&repeat JSR
	;frame-chrs/br .Screen/addr DEO2
	#81 .Screen/sprite DEO

JMP2r
	&repeat
		#00 &repeat-loop #81 .Screen/sprite DEO INC GTHk ,&repeat-loop JCN POP2
	JMP2r

@draw-grid ( -- )

	#05 .Screen/auto DEO
	#0010 .Screen/x DEO2
	#0040 .Screen/y DEO2

	#0800
	&ver
		STHk
		#0800
		&hor
			#00 OVR STHkr #30 SFT ADD ,get-tile JSR #81 draw-tile
			INC GTHk ,&hor JCN
		POP2
		POPr
		#0010 .Screen/x DEO2
		.Screen/y DEI2k #0010 ADD2 ROT DEO2
		INC GTHk ,&ver JCN
	POP2
	#00 .Screen/auto DEO

JMP2r

@get-tile ( id* -- sprite* )

	( mine )
	.game/dead LDZ #00 EQU ,&alive JCN
		DUP2 ;world ADD2 LDA #00 EQU ,&no-mine JCN
			POP2 ;tile-chrs/mine JMP2r
			&no-mine
		&alive
	( flag )
	DUP2 ;world/flags ADD2 LDA #00 EQU ,&no-flag JCN
		POP2 ;tile-chrs/flagged JMP2r
		&no-flag
	( revealed )
	DUP2 ;world/revealed ADD2 LDA ,&no-seen JCN
		POP2 ;tile-chrs/untouched JMP2r
		&no-seen
	( digits )
	;world/values ADD2 LDA #00 SWP #60 SFT2 ;tile-chrs/digits ADD2

JMP2r

@draw-tile ( addr* color -- )

	STH
	.Screen/addr DEO2
	STHkr .Screen/sprite DEOk DEO
	.Screen/x DEI2k #0010 SUB2 ROT DEO2
	.Screen/y DEI2k #0008 ADD2 ROT DEO2
	STHr .Screen/sprite DEOk DEO
	.Screen/y DEI2k #0008 SUB2 ROT DEO2

JMP2r

@draw-status ( -- )

	#05 .Screen/auto DEO
	#0048 .Screen/x DEO2
	#0018 .Screen/y DEO2
	;status-chrs/alive #00 .game/dead LDZ #60 SFT2 ADD2 #81 ,draw-tile JSR
	#00 .Screen/auto DEO

JMP2r

@draw-progress ( -- )

	#0018 .Screen/x DEO2
	#0018 .Screen/y DEO2
	#00 count-flags ,draw-display JSR

JMP2r

@draw-timer ( -- )

	#0058 .Screen/x DEO2
	#0018 .Screen/y DEO2
	.game/timer LDZ2 ,draw-display JSR

JMP2r

@draw-display ( value* -- )

	#05 .Screen/auto DEO
	DUP2 #0064 DIV2 NIP ,draw-display-char JSR
	DUP2 #000a DIV2 NIP ,draw-display-char JSR
	NIP

@draw-display-char ( addr* color -- )

	#0a ( MOD ) DIVk MUL SUB #00 SWP #60 SFT2 ;digits-chrs ADD2 #85 draw-tile

JMP2r

( stdlib )

@mclr ( addr* len* -- )

	OVR2 ADD2 SWP2
	&loop
		STH2k #00 STH2r STA
		INC2 GTH2k ,&loop JCN
	POP2 POP2

JMP2r

@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 DUP2 ADD2 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

@within-rect ( x* y* rect -- flag )

	STH
	( y < rect.y1 ) DUP2 STHkr INC INC LDZ2 LTH2 ,&skip JCN
	( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ,&skip JCN
	SWP2
	( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ,&skip JCN
	( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN
	POP2 POP2 POPr
	#01
JMP2r
	&skip
	POP2 POP2 POPr
	#00

JMP2r

( theme )

@load-theme ( -- )

	;&path .File/name DEO2
	#0002 .File/length DEO2
	;&r .File/read DEO2
	;&g .File/read DEO2
	;&b .File/read DEO2
	.File/success DEI2 ORA #01 JCN JMP2r
	LIT2 &r $2 .System/r DEO2
	LIT2 &g $2 .System/g DEO2
	LIT2 &b $2 .System/b DEO2

JMP2r
	&path ".theme $1

(
@|assets )

@neighbors
	ffff 00ff 01ff
	ff00 0100
	ff01 0001 0101

@pointer-icn
	80c0 e0f0 f8e0 1000

@tile-chrs
	&untouched
	ffff c0c0 c0c0 c0c0 0000 0000 0000 0000
	fefc 0000 0000 0000 0001 0303 0303 0303
	c0c0 c0c0 c0c0 8000 0000 0000 0000 3f7f
	0000 0000 0000 0000 0303 0303 0303 ffff
	&mine
	0001 0117 0f1f 1f7f 0001 0117 0b15 1b7f
	0000 00d0 e0f0 f0fc 0100 01d0 e1f0 f1fc
	1f1f 0f17 0101 0000 1f1f 0f17 0101 00aa
	f0f0 e0d0 0000 0000 f1f0 e1d0 0100 01ab
	&flagged
	ffff c0c0 c1c1 c1c1 0000 0000 0103 0703
	fefc 0000 0000 0000 0001 0303 0303 0303
	c1c0 c7cf c0c0 8000 0101 070f 0000 3f7f
	0000 c0e0 0000 0000 0303 c3e3 0303 ffff
	&digits
	0000 0000 0000 0000 0000 0000 0000 0000
	0000 0000 0000 0000 0100 0100 0100 0100
	0000 0000 0000 0000 0000 0000 0000 00aa
	0000 0000 0000 0000 0100 0100 0100 01ab
	( 1 )
	0000 0003 0301 0101 0000 0003 0301 0101
	0000 0080 8080 8080 0100 0180 8180 8180
	0101 0101 0100 0000 0101 0101 0100 00aa
	8080 8080 8000 0000 8180 8180 8100 01ab
	( 2 )
	0000 001f 1f00 000f 0000 001f 1f00 000f
	0000 00f0 f818 18f8 0100 01f0 f918 19f8
	1f18 181f 1f00 0000 1f18 181f 1f00 00aa
	f000 00f8 f800 0000 f100 01f8 f900 01ab
	( 3 )
	0000 001f 1f00 001f 0000 001f 1f00 001f
	0000 00f0 f818 18f0 0100 01f0 f918 19f0
	1f00 001f 1f00 0000 1f00 001f 1f00 00aa
	f018 18f8 f000 0000 f118 19f8 f100 01ab
	( 4 )
	0000 0018 1818 181f 0000 0018 1818 181f
	0000 0018 1818 18f8 0100 0118 1918 19f8
	0f00 0000 0000 0000 0f00 0000 0000 00aa
	f818 1818 1800 0000 f918 1918 1900 01ab
	( 5 )
	0000 001f 1f18 181f 0000 001f 1f18 181f
	0000 00f8 f800 00f0 0100 01f8 f900 01f0
	0f00 001f 1f00 0000 0f00 001f 1f00 00aa
	f818 18f8 f000 0000 f918 19f8 f100 01ab
	( 6 )
	0000 000f 1f18 181f 0000 000f 1f18 181f
	0000 00f8 f800 00f0 0100 01f8 f900 01f0
	1f18 181f 0f00 0000 1f18 181f 0f00 00aa
	f818 18f8 f000 0000 f918 19f8 f100 01ab
	( 7 )
	0000 001f 1f00 0000 0000 001f 1f00 0000
	0000 00f0 f818 1838 0100 01f0 f918 1938
	0000 0000 0000 0000 0000 0000 0000 00aa
	3818 1818 1800 0000 3918 1918 1900 01ab
	( 8 )
	0000 000f 1f18 180f 0000 000f 1f18 180f
	0000 00f0 f818 18f0 0100 01f0 f918 19f0
	0f18 181f 0f00 0000 0f18 181f 0f00 00aa
	f018 18f8 f000 0000 f118 19f8 f100 01ab

@frame-chrs
	&tl 0000 0000 0000 0000 0000 0000 0000 0303
	&tc 0000 0000 0000 0000 0000 0000 0000 ffff
	&tr 0000 0000 0000 0040 0000 0000 0000 8000
	&ml 0000 0000 0000 0000 0303 0303 0303 0303
	&mr c0c0 c0c0 c0c0 c0c0 0000 0000 0000 0000
	&bl 0001 0000 0000 0000 0200 0000 0000 0000
	&bc ffff 0000 0000 0000 0000 0000 0000 0000
	&br c0c0 0000 0000 0000 0000 0000 0000 0000

@status-chrs
	&alive
	0007 1f3f 3f7f 7f7f 0007 1820 2040 4044
	00e0 f8fc fcfe fefe 00e0 1804 0402 0222
	7f7f 7f3f 3f1f 0700 4048 4720 2018 0700
	fefe fefc fcf8 e000 0212 e204 0418 e000
	&dead
	0007 1f3f 3f7f 7f7f 0007 1820 2040 4a44
	00e0 f8fc fcfe fefe 00e0 1804 0402 5222
	7f7f 7f3f 3f1f 0700 4a40 4728 2018 0700
	fefe fefc fcf8 e000 5202 e214 0418 e000
	&victory
	0007 1f3f 3f7f 7f7f 0007 1820 2040 444a
	00e0 f8fc fcfe fefe 00e0 1804 0402 2252
	7f7f 7f3f 3f1f 0700 4040 4221 2018 0700
	fefe fefc fcf8 e000 0202 4284 0418 e000

@digits-chrs
	( 0 )
	ffff ffff ffff ffe0 ffc0 a09f 9f9f 9fbf
	ffff ffff ffff ff07 ff03 05f9 f9f9 f9fd
	f0ff ffff ffff ffff 9f9f 9f9f 9fa0 c0ff
	0fff ffff ffff ffff f9f9 f9f9 f905 03ff
	( 1 )
	ffc0 a09f 9f9f 9fa0 ffff ffff ffff ffff
	ff03 07ff ffff ff07 ffff fdf9 f9f9 f9fd
	909f 9f9f 9fa0 c0ff ffff ffff ffff ffff
	0fff ffff ff07 03ff f9f9 f9f9 f9fd ffff
	( 2 )
	ffff bf9f 9f9f 9fbf ffc0 e0ff ffff ffe0
	ffff ffff ffff ffff ff03 05f9 f9f9 f905
	ffff ffff ffff ffff 909f 9f9f 9fa0 c0ff
	f9f9 f9f9 f9fd ffff 0fff ffff ff07 03ff
	( 3 )
	ffff bf9f 9f9f 9fbf ffc0 e0ff ffff ffe0
	ffff ffff ffff ffff ff03 05f9 f9f9 f905
	9f9f 9f9f 9fbf ffff f0ff ffff ffe0 c0ff
	ffff ffff ffff ffff 09f9 f9f9 f905 03ff
	( 4 )
	ffc0 e0ff ffff ffff ffff bf9f 9f9f 9fa0
	ff03 07ff ffff ffff ffff fdf9 f9f9 f905
	9f9f 9f9f 9fa0 c0ff f0ff ffff ffff ffff
	ffff ffff ff07 03ff 09f9 f9f9 f9fd ffff
	( 5 )
	ffff ffff ffff ffff ffc0 a09f 9f9f 9fa0
	ffff fdf9 f9f9 f9fd ff03 07ff ffff ff07
	9f9f 9f9f 9fbf ffff f0ff ffff ffe0 c0ff
	ffff ffff ffff ffff 09f9 f9f9 f905 03ff
	( 6 )
	ffc0 e0ff ffff ffff ffff bf9f 9f9f 9fa0
	ff03 05f9 f9f9 f9fd ffff ffff ffff ff07
	ffff ffff ffff ffff 909f 9f9f 9fa0 c0ff
	ffff ffff ffff ffff 09f9 f9f9 f905 03ff
	( 7 )
	ffff bf9f 9f9f 9fa0 ffc0 e0ff ffff ffff
	ffff ffff ffff ff07 ff03 05f9 f9f9 f9fd
	909f 9f9f 9fa0 c0ff ffff ffff ffff ffff
	0fff ffff ff07 03ff f9f9 f9f9 f9fd ffff
	( 8 )
	ffff ffff ffff ffff ffc0 a09f 9f9f 9fa0
	ffff ffff ffff ffff ff03 05f9 f9f9 f905
	ffff ffff ffff ffff 909f 9f9f 9fa0 c0ff
	ffff ffff ffff ffff 09f9 f9f9 f905 03ff
	( 9 )
	ffff ffff ffff ffff ffc0 a09f 9f9f 9fa0
	ffff ffff ffff ffff ff03 05f9 f9f9 f905
	9f9f 9f9f 9fa0 c0ff f0ff ffff ffff ffff
	ffff ffff ff07 03ff 09f9 f9f9 f9fd ffff

@world
	&mines $40
	&revealed $40
	&values $40
	&flags $40