( wireworld )

( 
	#00 empty - black
	#01 conductor - yellow
	#02 electron tail - red
	#03 electron head - blue 

	RULES

	- electron head(3), becomes electron tail(2)
    - electron tail(2), becomes conductor(1)
    - conductor(1), becomes electron head(3) 
    	if there are exactly 1 or 2 electron heads around it. )

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

%2*  { #10 SFT } %2/  { #01 SFT } %2**  { #10 SFT2 } %2//  { #01 SFT2 }
%4*  { #20 SFT } %4/  { #02 SFT } %4**  { #20 SFT2 } %4//  { #02 SFT2 }
%8*  { #30 SFT } %8/  { #03 SFT } %8**  { #30 SFT2 } %8//  { #03 SFT2 }
%10* { #40 SFT } %10/ { #04 SFT } %10** { #40 SFT2 } %10// { #04 SFT2 }
%20* { #50 SFT } %20/ { #05 SFT } %20** { #50 SFT2 } %20// { #05 SFT2 }

%RTN   { JMP2r }
%TOS { #00 SWP }

%WIDTH  { #40 }
%HEIGHT { #40 }
%LENGTH { #1000 }

( devices )

|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 &pad    $2 &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

|0000

@color $1
@pointer 
	&x $2 &y $2
@timer 
	&frame $1 &play $1

( program )

|0100 ( -> )

	( theme ) 
	#0f7f .System/r DEO2 
	#0fe0 .System/g DEO2 
	#0fc0 .System/b DEO2
	( size )
	#00 WIDTH 4** .Screen/width DEO2
	#00 HEIGHT 4** .Screen/height DEO2
	( vectors ) 
	;on-frame .Screen/vector DEO2
	;on-mouse .Mouse/vector DEO2
	;on-button .Controller/vector DEO2
	( setup )
	#01 .timer/play STZ
	#01 .color STZ
	;redraw JSR2

BRK

@on-frame ( -> )

	.timer/play LDZ JMP BRK
	( every 4th )
	.timer/frame LDZk 
		#03 AND ,&no-run JCN 
			;run JSR2 
			;past-world LENGTH ++ ;past-world LENGTH ;mcpy JSR2
			;redraw JSR2
			&no-run
		LDZk INC SWP STZ

BRK

@on-button ( -> )

	.Controller/button DEI
	DUP #01 ! ,&no-a JCN      #01 .color STZ &no-a
	DUP #02 ! ,&no-b JCN      #02 .color STZ &no-b
	DUP #04 ! ,&no-select JCN #03 .color STZ &no-select
	DUP #08 ! ,&no-start JCN  #00 .color STZ &no-start
	DUP #0c ! ,&no-both JCN
		;past-world LENGTH 2** ;mclr JSR2
		;redraw JSR2
		&no-both
	POP
	( space )
	.Controller/key DEI #20 ! ,&no-space JCN
		.timer/play LDZk #00 = SWP STZ &no-space

BRK

@on-mouse ( -> )

	;pointer-icn .Screen/addr DEO2
	( clear last cursor )
	.pointer/x LDZ2 .Screen/x DEO2
	.pointer/y LDZ2 .Screen/y DEO2
	#40 .Screen/sprite DEO
	( draw new cursor )
	.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2 
	.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
	#41 .Mouse/state DEI #00 ! + .timer/play LDZ + .Screen/sprite DEO
	( paint )
	.Mouse/state DEI #00 = ,&no-down JCN
		( color ) .color LDZ .Mouse/state DEI #01 > #00 = *
		( cell* ) .Mouse/x DEI2 4// NIP .Mouse/y DEI2 4// NIP
			;get-addr JSR2 STA
		;redraw JSR2
		&no-down

BRK

@redraw ( -- )

	;cell-icn .Screen/addr DEO2
	HEIGHT #00
	&ver
		DUP TOS 4** .Screen/y DEO2
		STHk
		WIDTH #00
		&hor
			DUP TOS 4** .Screen/x DEO2
			DUP STHkr ,get-addr JSR LDA .Screen/sprite DEO
			INC GTHk ,&hor JCN
		POP2
		POPr
		INC GTHk ,&ver JCN
	POP2

RTN

@run ( -- )

	HEIGHT #00
	&ver
		STHk
		WIDTH #00
		&hor
			( x,y ) DUP STHkr 
			( cell ) DUP2 ,get-addr JSR STH2k LDA 
			( transform ) ,transform JSR STH2r ( future ) LENGTH ++ STA
			INC GTHk ,&hor JCN
		POP2
		POPr
		INC GTHk ,&ver JCN
	POP2

RTN

@get-addr ( x y -- addr* )

	TOS [ #00 WIDTH ] ** ROT TOS ++ ;past-world ++

RTN

@transform ( xy cell -- cell )

	DUP #00 ! ,&no-null JCN NIP NIP RTN &no-null
	DUP #03 ! ,&no-head JCN POP POP2 #02 RTN &no-head
	DUP #02 ! ,&no-tail JCN POP POP2 #01 RTN &no-tail
	DUP #01 ! ,&no-cond JCN POP 
		LITr 00
		DUP2 #01 - ,get-addr JSR 
			( tl ) #0001 -- LDAk #03 ! JMP INCr
			( tc ) INC2 LDAk #03 ! JMP INCr
			( tr ) INC2 LDA #03 ! JMP INCr
		DUP2 ,get-addr JSR
			( ml ) #0001 -- LDAk #03 ! JMP INCr
			( mr ) INC2 INC2 LDA #03 ! JMP INCr
		INC ,get-addr JSR
			( bl ) #0001 -- LDAk #03 ! JMP INCr
			( bc ) INC2 LDAk #03 ! JMP INCr
			( br ) INC2 LDA #03 ! JMP INCr
		STHkr #02 = STHr #01 = #0000 >>
		#02 * INC RTN 
		&no-cond
	( unknown )
	NIP NIP

RTN

@mcpy ( src* dst* len* -- )

	SWP2 STH2
	OVR2 ++ SWP2
	&loop
		LDAk STH2kr STA INC2r
		INC2 GTH2k ,&loop JCN
	POP2 POP2
	POP2r

JMP2r

@mclr ( addr* len* -- )

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

JMP2r

@pointer-icn 
	80c0 e0f0 f8e0 1000
@cell-icn 
	e0e0 e000 0000 0000

( 
	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? )

@past-world