uxn/projects/demos/life.usm

( 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 }  

%INCR { #01 + }  %DECR { #01 - }
%TOS { #00 SWP } %TOB { SWP POP }
%RTN { JMP2r }
%MOD { DUP2 / * - }
%SFL { #40 SFT SFT }

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

%GET-SIZE { WIDTH TOS #0008 // HEIGHT TOS ** }

( 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 &color $1 ]
|90 @Mouse      [ &vector $2 &x        $2 &y      $2 &state $1 &chord $1 ]

( variables )

|0000

@timer $1
@anchor [ &x $2 &y $2 ]
@pointer [ &x $2 &y $2 ]

( program )

|0100 ( -> )

	( theme ) 
	#ef05 .System/r DEO2 
	#cf05 .System/g DEO2 
	#2f05 .System/b DEO2

	( vectors )
	;on-frame   .Screen/vector DEO2
	;on-mouse   .Mouse/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 #0002 // WIDTH TOS -- .anchor/x POK2
	.Screen/height DEI2 #0002 // HEIGHT TOS -- .anchor/y POK2

BRK

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

	.timer PEK #01 + [ DUP ] .timer POK

	#10 MOD #00 ! #01 JNZ [ BRK ] 

	( clear buffer )
	BANK2 DUP2 GET-SIZE ++
	&clear-loop
		OVR2 #0000 SWP2 STA2
		SWP2 #0002 ++ SWP2
		OVR2 OVR2 !! ,&clear-loop JNZ
	POP2 POP2

	;run-grid JSR2

	( move buffer )
	BANK2 DUP2 GET-SIZE ++
	&copy-loop
		OVR2 DUP2 LDA2 
		SWP2 #2000 -- STA2
		SWP2 #0002 ++ SWP2
		OVR2 OVR2 !! ,&copy-loop JNZ
	POP2 POP2

	;draw-grid JSR2

BRK

@on-mouse ( -> )
	
	( clear last cursor )
	#fff8 .Screen/addr DEO2 
	.pointer/x PEK2 .Screen/x DEO2 
	.pointer/y PEK2 .Screen/y DEO2 
	#30 .Screen/color DEO

	( record pointer positions )
	.Mouse/x DEI2 .pointer/x POK2 
	.Mouse/y DEI2 .pointer/y POK2

	( draw new cursor )
	;cursor .Screen/addr DEO2 
	.pointer/x PEK2 .Screen/x DEO2 
	.pointer/y PEK2 .Screen/y DEO2 

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

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

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

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

BRK

@draw-grid ( -- )

	#00 HEIGHT
	&ver
		OVR TOS #0002 ** .anchor/y PEK2 ++ .Screen/y DEO2
		OVR STH
		#00 WIDTH
		&hor
			OVR TOS #0002 ** .anchor/x PEK2 ++ .Screen/x DEO2
			OVR DUPr STHr ,get-cell JSR #01 + .Screen/color DEO
			SWP #01 + SWP
			DUP2 ! ,&hor JNZ
		POP2 POPr
		SWP #01 + SWP
		DUP2 ! ,&ver JNZ
	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 #08 MOD #01 SWP SFL 
	DUP2r LDAr STHr SWP ORA
	STH2r STA

RTN

@get-cell ( x y -- cell )
	
	DUP2 ,get-index JSR LDA 
	SWP POP SWP
	#08 MOD
	SFT #01 AND

RTN 

@get-neighbours ( x y -- neighbours )
	
	( -1,-1 ) DUP2 DECR SWP DECR SWP ,get-cell JSR STH
	(  0,-1 ) DUP2 DECR              ,get-cell JSR STH ADDr
	( +1,-1 ) DUP2 DECR SWP INCR SWP ,get-cell JSR STH ADDr
	( -1, 0 ) DUP2      SWP DECR SWP ,get-cell JSR STH ADDr
	( +1, 0 ) DUP2      SWP INCR SWP ,get-cell JSR STH ADDr
	( -1,+1 ) DUP2 INCR SWP DECR SWP ,get-cell JSR STH ADDr
	(  0,+1 ) DUP2 INCR              ,get-cell JSR STH ADDr
	( +1,+1 )      INCR SWP INCR SWP ,get-cell JSR STH ADDr
	STHr

RTN

@run-grid ( -- )
	
	#00 HEIGHT
	&ver
		OVR STH
		#00 WIDTH
		&hor
			OVR DUPr STHr STH2
			( x y ) DUP2r STH2r
			( neighbours ) DUP2r STH2r ,get-neighbours JSR
			( state ) STH2r ;get-cell JSR2
			,run-cell JSR
			SWP #01 + SWP
			DUP2 ! ,&hor JNZ
		POP2 POPr
		SWP #01 + SWP
		DUP2 ! ,&ver JNZ
	POP2

RTN 

@run-cell ( x y neighbours state -- )
	
	#00 = ,&dead JNZ
	&alive
		DUP #02 < ,&dies JNZ
		DUP #03 > ,&dies JNZ
		&lives POP ,save-cell JSR RTN
		&dies POP POP2 RTN
	&dead
		DUP #03 = ,&birth JNZ 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 ++ ]
	( save in buffer )
	STH2
	DUP2 POP #08 MOD #01 SWP SFL 
	DUP2r LDAr STHr SWP ORA
	STH2r STA

RTN

@cursor [ 
	80c0 e0f0 f8e0 1000 ]