( wireworld )

|00 @System &vector $2 &wst $1 &rst $1 &pad $4 &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 &modx $2 &mody $2

|000

	@color/value $1
	@timer/play $1

|100

@on-reset ( -> )
	;meta #06 DEO2
	( | theme )
	#07fe .System/r DEO2
	#07c6 .System/g DEO2
	#0fc6 .System/b DEO2
	( | size )
	#0200 .Screen/width DEO2
	#0100 .Screen/height DEO2
	( | vectors )
	;on-frame .Screen/vector DEO2
	;on-mouse .Mouse/vector DEO2
	;on-button .Controller/vector DEO2
	( | init )
	ui/<draw>
	world/<init>
	timer/<toggle>
	#01 color/<set>
	BRK

@meta $1
	( name ) "Wireworld 0a
	( desc ) "Celluar 20 "Automata 0a
	( auth ) "By 20 "Devine 20 "Lu 20 "Linvega 0a
	( date ) "27 20 "Apr 20 "2025 $1 00

@on-frame ( -> )
	[ LIT2 00 -Mouse/state ] DEI NEQ ?{
		[ LIT2 00 -timer/play ] LDZ EQU ?{
			[ LIT2 03 &f $1 ] INCk ,&f STR
			( every 4th ) AND ?{ run } } }
	BRK

@on-mouse ( -> )
	cursor/<update>
	.Mouse/state DEI ?{ BRK }
	.Mouse/y DEI2 #0019 LTH2 ?&on-menu
	( color ) .color/value LDZ .Mouse/state DEI #01 GTH #00 EQU MUL STHk
	( color x* y* ) .Mouse/x DEI2 #03 SFT2 .Mouse/y DEI2 #03 SFT2
	( color x* y* color ) OVR2 OVR2 get-addr/ LDA STHr NEQ ?{ POP2 POP2 POP BRK }
	( color x* y* ) NIP ROT POP <set-cell>
	world/<draw>
	BRK

	&on-menu ( -> )
	.Mouse/x DEI2 #03 SFT2 NIP
	( ) DUP #01 NEQ ?{ #01 color/<set> }
	( ) DUP #02 NEQ ?{ #02 color/<set> }
	( ) DUP #03 NEQ ?{ #03 color/<set> }
	( ) DUP #05 NEQ ?{
		timer/<toggle>
		[ LIT2 00 -Mouse/state ] DEO }
	POP BRK

@on-button ( -> )
	.Controller/button DEI2
	( | keys )
	( ) DUP #20 NEQ ?{ timer/<toggle> }
	( ) DUP #08 NEQ ?{ world/<reset> }
	POP
	( | buttons )
	( ) [ #01 ] NEQk NIP ?{ #01 color/<set> }
	( ) [ #02 ] NEQk NIP ?{ #02 color/<set> }
	( ) [ #04 ] NEQk NIP ?{ #03 color/<set> }
	( ) [ #08 ] NEQk NIP ?{ world/<reset> }
	POP BRK

(
@|core )

@get-addr ( x y -- addr* )
	SWP #0000 ROT SWP2 SWP & #60 SFT2 ADD2 [ LIT2 &current =world/mem ] ADD2 JMP2r

@<set-cell> ( cell x y -- addr* )
	get-addr STA
	JMP2r

@run ( -- )
	;cell-icn .Screen/addr DEO2
	#2000
	&>ver ( -- )
		DUP ,&y STR
		STHk #4000
		&>hor ( -- )
			DUP ,&x STR
			( x,y ) DUP STHkr
			( cell ) DUP2 get-addr STH2k LDA
			( update ) transform
			( draw ) STHk #00 EQU ?{
				( x ) [ LIT2 00 &x $1 ] #30 SFT2 .Screen/x DEO2
				( x ) [ LIT2 00 &y $1 ] #30 SFT2 .Screen/y DEO2
				DUPr [ LITr -Screen/sprite ] DEOr }
			STHr STH2r [ LIT2 &future 1000 ] ADD2 STA
			INC GTHk ?&>hor
		POP2 POPr INC GTHk ?&>ver
	POP2
	( | Swap worlds )
	;get-addr/current LDA2 ;run/future LDA2 STH2k ADD2 ;get-addr/current STA2
	#0000 STH2r SUB2 ;run/future STA2
	JMP2r

@transform ( xy* cell -- cell )
	DUP ?{ NIP NIP JMP2r }
	DUP #03 NEQ ?{ POP POP2 #02 JMP2r }
	DUP #02 NEQ ?{ POP POP2 #01 JMP2r }
	DUP #01 NEQ ?{
		POP LITr 00 DUP2 #01 SUB get-addr
		( tl ) #0001 SUB2 LDAk #03 [ NEQ JMP INCr ]
		( tc ) INC2 LDAk #03 [ NEQ JMP INCr ]
		( tr ) INC2 LDA #03 [ NEQ JMP INCr ] DUP2 get-addr
		( ml ) #0001 SUB2 LDAk #03 [ NEQ JMP INCr ]
		( mr ) INC2 INC2 LDA #03 [ NEQ JMP INCr ] INC get-addr
		( bl ) #0001 SUB2 LDAk #03 [ NEQ JMP INCr ]
		( bc ) INC2 LDAk #03 [ NEQ JMP INCr ]
		( br ) INC2 LDA #03 [ NEQ JMP INCr ]
		( .. ) STHkr #02 EQU STHr #01 EQU ORA DUP ADD INC JMP2r }
	( unknown ) NIP NIP JMP2r

(
@|drawing )

@ui/<draw> ( -- )
	[ LIT2 01 -Screen/auto ] DEO
	#0008 DUP2 .Screen/x DEO2
	.Screen/y DEO2
	;cell-icn .Screen/addr DEO2
	[ LIT2 01 -Screen/sprite ] DEO
	[ LIT2 02 -Screen/sprite ] DEO
	[ LIT2 03 -Screen/sprite ] DEO
	#0000 .Screen/x DEO2
	#0017 .Screen/y DEO2
	#00
	&>l ( -- )
		[ LIT2 01 -Screen/pixel ] DEO
		[ LIT2 00 -Screen/pixel ] DEO
		INC DUP ?&>l
	POP JMP2r

@world/<reset> ( -- )
	;&memend ;&mem
	&>loop ( -- )
		#0000 OVR2 STA2
		INC2 INC2 GTH2k ?&>loop
	POP2 POP2 run
	( >> )

@world/<draw> ( -- )
	( | clear )
	#0000 .Screen/x DEO2
	#0018 .Screen/y DEO2
	[ LIT2 80 -Screen/pixel ] DEO
	( | paint )
	;cell-icn .Screen/addr DEO2
	#0800 #0000
	&>l ( -- )
		DUP2 ;get-addr/current LDA2 ADD2 LDA STHk #00 EQU ?{
			DUP2 #003f AND2 #30 SFT2 .Screen/x DEO2
			DUP2 #36 SFT2 .Screen/y DEO2
			DUPr [ LITr -Screen/sprite ] DEOr }
		POPr INC2 GTH2k ?&>l
	POP2 POP2 JMP2r

@world/<init> ( -- )
	#01 #1010 <set-cell>
	#01 #110f <set-cell>
	#02 #120f <set-cell>
	#03 #130f <set-cell>
	#01 #1410 <set-cell>
	#01 #1111 <set-cell>
	#01 #1211 <set-cell>
	#01 #1311 <set-cell>
	#01 #1410 <set-cell>
	#01 #1510 <set-cell>
	#01 #1610 <set-cell>
	( | up )
	#01 #170f <set-cell>
	#01 #180e <set-cell>
	#01 #190d <set-cell>
	#01 #190c <set-cell>
	#01 #180b <set-cell>
	#01 #190b <set-cell>
	#01 #1a0b <set-cell>
	#01 #180a <set-cell>
	#01 #1a0a <set-cell>
	#01 #1909 <set-cell>
	#01 #1908 <set-cell>
	#01 #1907 <set-cell>
	( | down )
	#01 #1711 <set-cell>
	#01 #1812 <set-cell>
	#01 #1913 <set-cell>
	#01 #1914 <set-cell>
	#01 #1815 <set-cell>
	#01 #1a15 <set-cell>
	#01 #1816 <set-cell>
	#01 #1916 <set-cell>
	#01 #1a16 <set-cell>
	#01 #1917 <set-cell>
	#01 #1918 <set-cell>
	#01 #1919 <set-cell>
	JMP2r

(
@|Objects )

@timer/<toggle> ( -- )
	.&play LDZk #00
	( | draw )
	SWPk #30 SFT2 ;toggle-icn ADD2 .Screen/addr DEO2
	#0028 .Screen/x DEO2
	#0008 .Screen/y DEO2
	[ LIT2 01 -Screen/sprite ] DEO
	( | set )
	EQU SWP STZ
	JMP2r

@color/<set> ( color -- )
	DUP .&value LDZ NEQ ?{ POP JMP2r }
	.&value STZ
	( >> )

@cursor/<update> ( -- )
	#40 /<draw>
	.Mouse/x DEI2 ,&x STR2
	.Mouse/y DEI2 ,&y STR2
	[ LIT2 40 -color/value ] LDZ ADD
	( >> )

@cursor/<draw> ( color -- )
	;&sprite-icn .Screen/addr DEO2
	[ LIT2 &x $2 ] .Screen/x DEO2
	[ LIT2 &y $2 ] .Screen/y DEO2
	.Screen/sprite DEO
	JMP2r

@cursor/sprite-icn [ 80c0 e0f0 f8e0 1000 ]

(
@|assets )

@cell-icn [ 7cfe fefe fefe 7c00 ]

@toggle-icn [ 6666 6666 6666 6600 4666 767e 7666 4600 ]

@world/mem $2000
	&memend ( I live in the atom with the happy protons and neutrons.
	| I'm also so negative all the freakin time.
	| What do I do?
	| How do I find peace? )