uxn/projects/examples/demos/life.tal

( Game Of Life
	Any live cell with fewer than two live neighbours dies, as if by underpopulation.
	Any live cell with two or three live neighbours lives on to the next generation.
	Any live cell with more than three live neighbours dies, as if by overpopulation.
	Any dead cell with exactly three live neighbours becomes a live cell, as if by reproduction. )

%+  { ADD } %-   { SUB }  %*  { MUL } %/   { DIV }
%<  { LTH } %>   { GTH }  %=  { EQU } %!   { NEQ }
%++ { ADD2 } %-- { SUB2 } %** { MUL2 } %// { DIV2 }
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }

%TOS  { #00 SWP } %TOB  { SWP POP }
%RTN  { JMP2r }   %MOD  { DUP2 / * - }
%MOD8 { #07 AND } %MOD2 { #01 AND }
%SFL  { #40 SFT SFT }
%2//  { #01 SFT2 } %8//  { #03 SFT2 }
%2**  { #10 SFT2 } %8**  { #30 SFT2 }

%WIDTH { #40 }   %HEIGHT { #40 }
%BANK1 { #8000 } %BANK2 { #a000 }

%GET-SIZE { WIDTH TOS 8// HEIGHT TOS ** }
%GET-ITERATORS { SWP2k POP SWP POP }
%GET-ITER { OVR2 SWP POP OVR SWP }

( devices )

|00 @System     [ &vector $2 &wst      $1 &rst    $1 &pad   $4 &r      $2 &g     $2 &b      $2 ]
|20 @Screen     [ &vector $2 &width    $2 &height $2 &pad   $2 &x      $2 &y      $2 &addr  $2 &pixel $1 &sprite $1 ]
|80 @Controller [ &vector $2 &button   $1 &key    $1 ]
|90 @Mouse      [ &vector $2 &x        $2 &y      $2 &state $1 &wheel $1 ]

( variables )

|0000

@world   [ &frame $1 &count $2 ]
@anchor  [ &x $2 &y $2 ]
@pointer [ &x $2 &y $2 ]

( program )

|0100 ( -> )

	( theme ) 
	#02cf .System/r DEO2 
	#02ff .System/g DEO2 
	#024f .System/b DEO2

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

	( glider )
	#07 #03 ;set-cell JSR2
	#07 #04 ;set-cell JSR2
	#05 #04 ;set-cell JSR2
	#07 #05 ;set-cell JSR2
	#06 #05 ;set-cell JSR2

	.Screen/width DEI2 2// WIDTH TOS -- .anchor/x STZ2
	.Screen/height DEI2 2// HEIGHT TOS -- .anchor/y STZ2

BRK

@on-frame-paused ( -> )

BRK

@on-frame ( -> )
	
	.Mouse/state DEI #00 = #01 JCN [ BRK ]

	( incr frame ) .world/frame LDZ #01 + [ DUP ] .world/frame STZ
	( reset count ) #0000 .world/count STZ2

	#03 AND #00 = #01 JCN [ BRK ] 

	( clear buffer )
	BANK2 STH2k GET-SIZE ++ STH2r
	&clear-loop
		DUP2 #0000 SWP2 STA2
		#0002 ++ GTH2k ,&clear-loop JCN
	POP2 POP2

	( run grid )
	#00 HEIGHT
	&ver
		#00 WIDTH
		&hor
			GET-ITERATORS
			( x y ) DUP2
			( neighbours ) DUP2 ;get-neighbours JSR2
			( state ) ROT ROT ;get-cell JSR2
			,run-cell JSR
			SWP #01 + SWP
			LTHk ,&hor JCN
		POP2
		SWP #01 + SWP
		LTHk ,&ver JCN
	POP2

	( move buffer )
	BANK2 DUP2 GET-SIZE ++ SWP2
	&copy-loop
		DUP2 LDA2k
		SWP2 #2000 -- STA2
		#0002 ++ 
		GTH2k ,&copy-loop JCN
	POP2 POP2

	;draw-grid JSR2

BRK

@run-cell ( x y neighbours state -- )
	
	#00 = ,&dead JCN
	&alive
		DUP #02 < ,&dies JCN
		DUP #03 > ,&dies JCN
		&lives POP ,save-cell JSR RTN
		&dies POP POP2 RTN
	&dead
		DUP #03 = ,&birth JCN POP POP2 RTN
		&birth POP ,save-cell JSR RTN

RTN

@save-cell ( x y -- )
	
	( get index )
	HEIGHT MOD SWP WIDTH MOD SWP
	WIDTH #08 / TOS ROT TOS ** ROT #08 / TOS ++ [ BANK2 ++ ]
	( incr count )
	.world/count LDZ2 #0001 ADD2 .world/count STZ2
	( save in buffer )
	STH2
	DUP2 POP MOD8 #01 SWP SFL 
	LDAkr STHr SWP ORA
	STH2r STA

RTN

@on-mouse ( -> )
	
	( clear last cursor )
	;cursor .Screen/addr DEO2 
	.pointer/x LDZ2 .Screen/x DEO2 
	.pointer/y LDZ2 .Screen/y DEO2 
	#40 .Screen/sprite DEO

	( record pointer positions )
	.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
	.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2 

	( colorize on state )
	#42 [ .Mouse/state DEI #00 ! ] + .Screen/sprite DEO

	.Mouse/state DEI #00 ! #01 JCN [ BRK ]

	.Mouse/x DEI2 DUP2 .anchor/x LDZ2 >> ROT ROT .anchor/x LDZ2 WIDTH #02 * TOS ++ #0001 ++ << #0101 ==
	.Mouse/y DEI2 DUP2 .anchor/y LDZ2 >> ROT ROT .anchor/y LDZ2 HEIGHT #02 * TOS ++ << #0101 ==
	#0101 == #01 JCN [ BRK ]

	.Mouse/x DEI2 .anchor/x LDZ2 SUB2 #02 / TOB
	.Mouse/y DEI2 .anchor/y LDZ2 SUB2 #02 / TOB
	;set-cell JSR2
	
	;draw-grid JSR2

BRK

@on-control ( -> )

	.Controller/key DEI #00 ! #01 JCN [ BRK ]

	.Controller/key DEI #20 ! ,&no-toggle JCN
		;on-frame
		.Screen/vector DEI2 ;on-frame-paused == ,&swap JCN
			POP2 ;on-frame-paused
			&swap
		.Screen/vector DEO2
		&no-toggle

BRK

@draw-grid ( -- )
	
	( draw cell count )
	.anchor/x LDZ2 .Screen/x DEO2
	.anchor/y LDZ2 HEIGHT #02 * TOS ++ .Screen/y DEO2
	.world/count LDZ2 #03 ;draw-short JSR2

	HEIGHT #00
	&ver
		DUP TOS 2** .anchor/y LDZ2 ++ .Screen/y DEO2
		WIDTH #00
		&hor
			DUP TOS 2** .anchor/x LDZ2 ++ .Screen/x DEO2
			GET-ITER ,get-cell JSR #01 + .Screen/pixel DEO
			#01 + GTHk ,&hor JCN
		POP2
		#01 + GTHk ,&ver JCN
	POP2

RTN

@get-index ( x y -- index* )
	
	HEIGHT MOD SWP WIDTH MOD SWP
	WIDTH #08 / TOS ROT TOS ** ROT #08 / TOS ++ [ BANK1 ++ ]

RTN

@set-cell ( x y -- )
	
	DUP2 ,get-index JSR STH2
	POP MOD8 #01 SWP SFL 
	LDAkr STHr SWP ORA
	STH2r STA

RTN

@get-cell ( x y -- cell )
	
	DUP2 ,get-index JSR LDA 
	SWP POP SWP
	MOD8
	SFT MOD2

RTN 

@get-neighbours ( x y -- neighbours )
	
	( -1,-1 ) DUP2 #01 - [ SWP #01 - SWP ] ,get-cell JSR STH
	(  0,-1 ) DUP2 #01 -      ,get-cell JSR STH ADDr
	( +1,-1 ) DUP2 #01 - [ SWP #01 + SWP ] ,get-cell JSR STH ADDr
	( -1, 0 ) DUP2       [ SWP #01 - SWP ] ,get-cell JSR STH ADDr
	( +1, 0 ) DUP2       [ SWP #01 + SWP ] ,get-cell JSR STH ADDr
	( -1,+1 ) DUP2 #01 + [ SWP #01 - SWP ] ,get-cell JSR STH ADDr
	(  0,+1 ) DUP2 #01 +      ,get-cell JSR STH ADDr
	( +1,+1 )      #01 + [ SWP #01 + SWP ] ,get-cell JSR STH ADDr
	STHr

RTN

@draw-short ( short* color -- )

	STH SWP 
	DUP #04 SFT TOS 8** ;font-hex ++ .Screen/addr DEO2
	( draw ) STHkr .Screen/sprite DEO
	#0f AND TOS 8** ;font-hex ++ .Screen/addr DEO2
	.Screen/x DEI2 #0008 ++ .Screen/x DEO2
	( draw ) STHkr .Screen/sprite DEO
	DUP #04 SFT TOS 8** ;font-hex ++ .Screen/addr DEO2
	.Screen/x DEI2 #0008 ++ .Screen/x DEO2
	( draw ) STHkr .Screen/sprite DEO
	#0f AND TOS 8** ;font-hex ++ .Screen/addr DEO2
	.Screen/x DEI2 #0008 ++ .Screen/x DEO2
	( draw ) STHr .Screen/sprite DEO

RTN

@cursor 
	80c0 e0f0 f8e0 1000

@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