( 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 { SWP #01 + SWP }
%DECR { SWP #01 - SWP }
%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 }
( 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 ]
|80 @Controller [ &vector $2 &button $1 &key $1 ]
|90 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &wheel $1 ]
( variables )
|0000
@world [ &paused $1 &frame $1 &count $2 ]
@anchor [ &x $2 &y $2 ]
@pointer [ &x $2 &y $2 ]
( program )
|0100 ( -> )
( theme )
#02fe .System/r DEO2
#02fc .System/g DEO2
#02f2 .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
#01 .world/paused STZ
BRK
@on-frame ( -> )
.Mouse/state DEI #00 = #01 JCN [ BRK ]
.world/paused LDZ #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 DUP2 GET-SIZE ++
&clear-loop
OVR2 #0000 SWP2 STA2
SWP2 #0002 ++ SWP2
NEQ2k ,&clear-loop JCN
POP2 POP2
;run-grid JSR2
( move buffer )
BANK2 DUP2 GET-SIZE ++
©-loop
OVR2 DUP2 LDA2
SWP2 #2000 -- STA2
SWP2 #0002 ++ SWP2
NEQ2k ,©-loop JCN
POP2 POP2
;draw-grid JSR2
( draw cell count )
.anchor/x LDZ2 .Screen/x DEO2
.anchor/y LDZ2 HEIGHT #02 * TOS ++ .Screen/y DEO2
.world/count LDZ2 #22 ;draw-short JSR2
BRK
@on-mouse ( -> )
( clear last cursor )
;cursor .Screen/addr DEO2
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
#30 .Screen/color DEO
( record pointer positions )
.Mouse/x DEI2 .pointer/x STZ2
.Mouse/y DEI2 .pointer/y STZ2
( draw new cursor )
.pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2
( colorize on state )
#32 [ .Mouse/state DEI #00 ! ] + .Screen/color 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
.world/paused LDZ #01 ! .world/paused STZ
&no-toggle
BRK
@draw-grid ( -- )
#00 HEIGHT
&ver
OVR TOS 2** .anchor/y LDZ2 ++ .Screen/y DEO2
#00 WIDTH
&hor
OVR TOS 2** .anchor/x LDZ2 ++ .Screen/x DEO2
GET-ITERATORS ,get-cell JSR #01 + .Screen/color DEO
INCR
NEQk ,&hor JCN
POP2
INCR
NEQk ,&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 - DECR ,get-cell JSR STH
( 0,-1 ) DUP2 #01 - ,get-cell JSR STH ADDr
( +1,-1 ) DUP2 #01 - INCR ,get-cell JSR STH ADDr
( -1, 0 ) DUP2 DECR ,get-cell JSR STH ADDr
( +1, 0 ) DUP2 INCR ,get-cell JSR STH ADDr
( -1,+1 ) DUP2 #01 + DECR ,get-cell JSR STH ADDr
( 0,+1 ) DUP2 #01 + ,get-cell JSR STH ADDr
( +1,+1 ) #01 + INCR ,get-cell JSR STH ADDr
STHr
RTN
@run-grid ( -- )
#00 HEIGHT
&ver
#00 WIDTH
&hor
GET-ITERATORS
( x y ) DUP2
( neighbours ) DUP2 ,get-neighbours JSR
( state ) ROT ROT ;get-cell JSR2
,run-cell JSR
INCR
NEQk ,&hor JCN
POP2
INCR
NEQk ,&ver JCN
POP2
RTN
@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
@draw-short ( short* color -- )
STH SWP
DUP #04 SFT TOS 8** ;font-hex ++ .Screen/addr DEO2
( draw ) STHkr .Screen/color DEO
#0f AND TOS 8** ;font-hex ++ .Screen/addr DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
( draw ) STHkr .Screen/color DEO
DUP #04 SFT TOS 8** ;font-hex ++ .Screen/addr DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
( draw ) STHkr .Screen/color DEO
#0f AND TOS 8** ;font-hex ++ .Screen/addr DEO2
.Screen/x DEI2 #0008 ++ .Screen/x DEO2
( draw ) STHr .Screen/color 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