~rabbits/uxn

d4ee3a4760707907c2e516251810a2160cda839a — Devine Lu Linvega 8 days ago 1245b44
(life.tal) Migrated to immediate opcodes
1 files changed, 66 insertions(+), 69 deletions(-)

M projects/examples/demos/life.tal
M projects/examples/demos/life.tal => projects/examples/demos/life.tal +66 -69
@@ 24,18 24,19 @@
	#02ff .System/g DEO2
	#024f .System/b DEO2
	( resize )
	#00c0 .Screen/width DEO2
	#00c0 .Screen/height DEO2
	#00c0
		DUP2 .Screen/width DEO2
		.Screen/height DEO2
	( vectors )
	;on-frame .Screen/vector DEO2
	;on-mouse .Mouse/vector DEO2
	;on-control .Controller/vector DEO2
	( glider )
	#0703 ;set-cell JSR2
	#0704 ;set-cell JSR2
	#0504 ;set-cell JSR2
	#0705 ;set-cell JSR2
	#0605 ;set-cell JSR2
	#0703 set-cell
	#0704 set-cell
	#0504 set-cell
	#0705 set-cell
	#0605 set-cell
	( center )
	.Screen/width DEI2 #01 SFT2 #0040 SUB2
		DUP2 .anchor/x STZ2


@@ 47,19 48,19 @@
BRK

@on-frame ( -> )
	

	.Mouse/state DEI #00 EQU #01 JCN [ BRK ]
	#0000 .world/count STZ2
	.world/frame LDZ INC
		DUP .world/frame STZ
		#03 AND #00 EQU #01 JCN [ BRK ]
	;run JSR2
	run
	&paused

BRK

@on-mouse ( -> )
	

	( clear last cursor )
	;cursor .Screen/addr DEO2
	.pointer/x LDZ2 .Screen/x DEO2


@@ 72,29 73,29 @@ BRK
	#42 [ .Mouse/state DEI #00 NEQ ] ADD .Screen/sprite DEO
	( on touch in rect )
	.Mouse/state DEI #00 NEQ #01 JCN [ BRK ]
	.Mouse/x DEI2 .Mouse/y DEI2 .anchor ;within-rect JSR2 JMP [ BRK ]
	.Mouse/x DEI2 .Mouse/y DEI2 .anchor within-rect [ JMP BRK ]
	( paint )
	.Mouse/x DEI2 .anchor/x LDZ2 SUB2 #01 SFT NIP
	.Mouse/y DEI2 .anchor/y LDZ2 SUB2 #01 SFT NIP
		;set-cell JSR2
		set-cell
	( draw )
	;draw-grid JSR2
	draw-grid

BRK

@on-control ( -> )

	( toggle play )
	.Controller/key DEI #20 NEQ ,&no-toggle JCN
	.Controller/key DEI #20 NEQ ?&no-toggle
		;on-frame
		.Screen/vector DEI2 ;on-frame/paused EQU2 ,&swap JCN
		.Screen/vector DEI2 ;on-frame/paused EQU2 ?&swap
			POP2 ;on-frame/paused
			&swap
		.Screen/vector DEO2
		&no-toggle
	( clear on home )
	.Controller/button DEI #08 NEQ ,&no-reset JCN
		;bank1 #0400 ;mclr JSR2
	.Controller/button DEI #08 NEQ ?&no-reset
		;bank1 #0400 mclr
		&no-reset

BRK


@@ 102,88 103,87 @@ BRK
@run ( -- )

	( clear buffer )
	;bank2 #1000 ;mclr JSR2
	;bank2 #1000 mclr
	( run grid )
	#4000
	&ver
		STHk
		#4000
		&hor
			DUP STHkr ,run-cell JSR
			INC GTHk ,&hor JCN
			DUP STHkr run-cell
			INC GTHk ?&hor
		POP2
		POPr
		INC GTHk ,&ver JCN
		INC GTHk ?&ver
	POP2
	( move buffer )
	;bank2 ;bank1 #1000 ;mcpy JSR2
	;bank2 ;bank1 #1000 mcpy
	( draw )
	;draw-grid ( .. )

JMP2
!draw-grid

@run-cell ( x y -- )

	( x y ) DUP2k
	( neighbours ) ;get-neighbours JSR2
	( state ) ROT ROT ;get-cell JSR2
	#00 EQU ,&dead JCN
		DUP #02 LTH ,&dies JCN
		DUP #03 GTH ,&dies JCN
		POP ;&save JMP2
	( neighbours ) get-neighbours
	( state ) ROT ROT get-cell
	#00 EQU ?&dead
		DUP #02 LTH ?&dies
		DUP #03 GTH ?&dies
		POP !&save
		&dies POP POP2 JMP2r
	&dead
		DUP #03 EQU ,&birth JCN POP POP2 JMP2r
		&birth POP ;&save ( .. )
		DUP #03 EQU ?&birth POP POP2 JMP2r
		&birth POP 

!&save

JMP2
	&save ( x y -- ) 
		STH2 #01 STH2r ,get-index JSR [ #1000 ADD2 ] STA
	&save ( x y -- )
		STH2 #01 STH2r get-index #1000 ADD2 STA
		.world/count LDZ2 INC2 .world/count STZ2
	JMP2r

@get-index ( x y -- index* )
	
	( y ) #3f AND #00 SWP #60 SFT2 

	( y ) #3f AND #00 SWP #60 SFT2
	( x ) ROT #3f AND #00 SWP ADD2
		;bank1 ADD2

JMP2r

@set-cell ( x y -- )
	
	STH2 #01 STH2r ,get-index JSR STA

	STH2 #01 STH2r get-index STA

JMP2r

@get-cell ( x y -- cell )
	
	,get-index JSR LDA

	get-index LDA

JMP2r

@get-neighbours ( x y -- neighbours )
	

	,&origin STR2
	LITr 00
	#0800
	&loop
		#00 OVRk ADD2 ;&mask ADD2 LDA2 [ LIT2 &origin $2 ]
		ROT ADD STH ADD STHr ;get-cell JSR2 STH ADDr
		INC GTHk ,&loop JCN
		ROT ADD STH ADD STHr get-cell STH ADDr
		INC GTHk ?&loop
	POP2
	STHr

JMP2r
	&mask ffff 00ff 01ff ff00 0100 ff01 0001 0101
	&mask [ ffff 00ff 01ff ff00 0100 ff01 0001 0101 ]

@draw-grid ( -- )
	

	( draw cell count )
	.anchor/x LDZ2 .Screen/x DEO2
	.anchor/y2 LDZ2 #0008 ADD2 .Screen/y DEO2
	#01 .Screen/auto DEO
	.world/count LDZ2 ;draw-short JSR2
	.world/count LDZ2 draw-short
	#00 .Screen/auto DEO
	#4000
	&ver


@@ 192,53 192,50 @@ JMP2r
		#4000
		&hor
			#00 OVRk ADD2 .anchor/x LDZ2 ADD2 .Screen/x DEO2
			DUP STHkr ;get-cell JSR2 INC .Screen/pixel DEO
			INC GTHk ,&hor JCN
			DUP STHkr get-cell INC .Screen/pixel DEO
			INC GTHk ?&hor
		POP2
		POPr
		INC GTHk ,&ver JCN
		INC GTHk ?&ver
	POP2

JMP2r

@draw-short ( short* -- )

	SWP ,draw-byte JSR
	SWP draw-byte

@draw-byte ( byte color -- )

	DUP #04 SFT ,draw-hex JSR #0f AND
	DUP #04 SFT draw-hex #0f AND

@draw-hex ( char color -- )

	#00 SWP #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2
	#03 .Screen/sprite DEO
	[ LIT2 03 -Screen/sprite ] DEO

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

JMP2r
	POP2 POP2 POPr #00 JMP2r

@mclr ( addr* len* -- )

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

JMP2r


@@ 249,16 246,16 @@ JMP2r
	OVR2 ADD2 SWP2
	&loop
		LDAk STH2kr STA INC2r
		INC2 GTH2k ,&loop JCN
		INC2 GTH2k ?&loop
	POP2 POP2
	POP2r

JMP2r

@cursor
	80c0 e0f0 f8e0 1000
@cursor [
	80c0 e0f0 f8e0 1000 ]

@font-hex
@font-hex [
	7c82 8282 8282 7c00
	3010 1010 1010 3800
	7c82 027c 8080 fe00


@@ 274,6 271,6 @@ JMP2r
	7c82 8080 8082 7c00
	fc82 8282 8282 fc00
	fe80 80f0 8080 fe00
	fe80 80f0 8080 8000
	fe80 80f0 8080 8000 ]

@bank1 $1000 @bank2