( 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 } %< { LTH } %> { GTH } %= { EQU } %! { NEQ } %++ { ADD2 } %-- { SUB2 } %<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 } %2/ { #01 SFT } %8/ { #03 SFT } %2// { #01 SFT2 } %8// { #03 SFT2 } %2** { #10 SFT2 } %8** { #30 SFT2 } %40** { #60 SFT2 } %8MOD { #07 AND } %2MOD { #01 AND } %TOS { #00 SWP } %RTN { JMP2r } %SFL { #40 SFT SFT } %WIDTH { #40 } %HEIGHT { #40 } %LENGTH { #0200 } %WIDTH-MOD { #3f AND } %HEIGHT-MOD { #3f AND } %IN-RANGE { INCk SWP SUB2 GTH } %BANK1 { #8000 } %BANK2 { #a000 } %GET-ITERATORS { SWP2k POP NIP } %GET-ITER { OVR2 NIP OVR SWP } %AUTO-NONE { #00 .Screen/auto DEO } %AUTO-X { #01 .Screen/auto DEO } ( devices ) |00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 ] |10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ] |20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 |30 @Audio0 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ] |80 @Controller [ &vector $2 &button $1 &key $1 ] |90 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &wheel $1 ] ( variables ) |0000 @world [ &frame $1 &count $2 ] @anchor [ &x $2 &y $2 ] @pointer [ &x $2 &y $2 ] @rle [ &x $1 &y $1 &n $1 ] ( program ) |0100 ( -> ) ( theme ) #02cf .System/r DEO2 #02ff .System/g DEO2 #024f .System/b DEO2 ( vectors ) ;on-input .Console/vector DEO2 ;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 BRK @on-frame-paused ( -> ) BRK @on-frame ( -> ) .Mouse/state DEI #00 = #01 JCN [ BRK ] ( incr frame ) .world/frame LDZ INC [ DUP ] .world/frame STZ ( reset count ) #0000 .world/count STZ2 #03 AND #00 = #01 JCN [ BRK ] ( clear buffer ) BANK2 LENGTH ;mclr JSR2 ( run grid ) #00 HEIGHT &ver #00 WIDTH &hor GET-ITERATORS ( x y ) DUP2 ( neighbours ) DUP2 ;get-neighbours JSR2 ( state ) ROT ROT ;get-cell JSR2 ,run-cell JSR SWP INC SWP LTHk ,&hor JCN POP2 SWP INC SWP LTHk ,&ver JCN POP2 ( move buffer ) BANK2 BANK1 LENGTH ;mcpy JSR2 ;draw-grid JSR2 BRK @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 TOS 8** ROT 8/ TOS ++ [ BANK2 ++ ] ( incr count ) .world/count LDZ2 INC2 .world/count STZ2 ( save in buffer ) STH2 DUP2 POP 8MOD #01 SWP SFL LDAkr STHr SWP ORA STH2r STA RTN @on-mouse ( -> ) ( clear last cursor ) ;cursor .Screen/addr DEO2 .pointer/x LDZ2 .Screen/x DEO2 .pointer/y LDZ2 .Screen/y DEO2 #40 .Screen/sprite DEO ( record pointer positions ) .Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2 .Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2 ( colorize on state ) #42 [ .Mouse/state DEI #00 ! ] + .Screen/sprite DEO .Mouse/state DEI #00 ! #01 JCN [ BRK ] .Mouse/x DEI2 DUP2 .anchor/x LDZ2 >> ROT ROT .anchor/x LDZ2 WIDTH DUP ADD TOS ++ INC2 << #0101 == .Mouse/y DEI2 DUP2 .anchor/y LDZ2 >> ROT ROT .anchor/y LDZ2 HEIGHT DUP ADD TOS ++ << #0101 == #0101 == #01 JCN [ BRK ] .Mouse/x DEI2 .anchor/x LDZ2 SUB2 2/ NIP .Mouse/y DEI2 .anchor/y LDZ2 SUB2 2/ NIP ;set-cell JSR2 ;draw-grid JSR2 BRK @on-control ( -> ) .Controller/key DEI #20 ! ,&no-toggle JCN ;on-frame .Screen/vector DEI2 ;on-frame-paused == ,&swap JCN POP2 ;on-frame-paused &swap .Screen/vector DEO2 &no-toggle .Controller/button DEI #08 ! ,&no-reset JCN BANK1 #1000 ;mclr JSR2 BANK2 #1000 ;mclr JSR2 &no-reset BRK @draw-grid ( -- ) ( draw cell count ) .anchor/x LDZ2 .Screen/x DEO2 .anchor/y LDZ2 HEIGHT DUP ADD TOS ++ .Screen/y DEO2 AUTO-X .world/count LDZ2 #03 ;draw-short JSR2 AUTO-NONE HEIGHT #00 &ver DUP TOS 2** .anchor/y LDZ2 ++ .Screen/y DEO2 WIDTH #00 &hor DUP TOS 2** .anchor/x LDZ2 ++ .Screen/x DEO2 GET-ITER ,get-cell JSR INC .Screen/pixel DEO INC GTHk ,&hor JCN POP2 INC GTHk ,&ver JCN POP2 RTN @get-index ( x y -- index* ) HEIGHT-MOD SWP WIDTH-MOD SWP TOS 8** ROT 8/ TOS ++ [ BANK1 ++ ] RTN @set-cell ( x y -- ) DUP2 ,get-index JSR STH2 POP 8MOD #01 SWP SFL LDAkr STHr SWP ORA STH2r STA RTN @unset-cell ( x y -- ) DUP2 ,get-index JSR STH2 POP 8MOD #01 SWP SFL #ff EOR LDAkr STHr SWP AND STH2r STA RTN @get-cell ( x y -- cell ) DUP2 ,get-index JSR LDA NIP SWP 8MOD SFT 2MOD RTN @get-neighbours ( x y -- neighbours ) ( -1,-1 ) DUP2 #01 - [ SWP #01 - SWP ] ,get-cell JSR STH ( 0,-1 ) DUP2 #01 - ,get-cell JSR STH ADDr ( +1,-1 ) DUP2 #01 - [ SWP INC SWP ] ,get-cell JSR STH ADDr ( -1, 0 ) DUP2 [ SWP #01 - SWP ] ,get-cell JSR STH ADDr ( +1, 0 ) DUP2 [ SWP INC SWP ] ,get-cell JSR STH ADDr ( -1,+1 ) DUP2 INC [ SWP #01 - SWP ] ,get-cell JSR STH ADDr ( 0,+1 ) DUP2 INC ,get-cell JSR STH ADDr ( +1,+1 ) INC [ SWP INC SWP ] ,get-cell JSR STH ADDr STHr RTN @draw-short ( short* color -- ) STH SWP STHkr ,draw-byte JSR STHr @draw-byte ( byte color -- ) STH DUP #04 SFT STHkr ,draw-hex JSR #0f AND STHr @draw-hex ( char color -- ) SWP TOS 8** ;font-hex ++ .Screen/addr DEO2 .Screen/sprite DEO RTN @mclr ( addr* len* -- ) OVR2 ++ SWP2 &loop STH2k #00 STH2r STA INC2 GTH2k ,&loop JCN POP2 POP2 JMP2r @mcpy ( src* dst* len* -- ) SWP2 STH2 OVR2 ++ SWP2 &loop LDAk STH2kr STA INC2r INC2 GTH2k ,&loop JCN POP2 POP2 POP2r JMP2r ( input ) @on-input ( -> ) ,&main JSR BRK &main .Console/read DEI #20 GTH JMP JMP2r ( ignore whitespace ) .Console/read DEI LIT 'b EQU ,unset-run JCN .Console/read DEI LIT 'o EQU ,set-run JCN .Console/read DEI LIT '$ EQU ,input-eol JCN .Console/read DEI LIT '! EQU ,input-eop JCN LIT2 '0 '9 .Console/read DEI IN-RANGE ,input-number JCN ;on-ignore-until-eol .Console/vector DEO2 JMP2r @unset-run ( -- ) ;unset-cell ,run JMP ( tail call ) @set-run ( -- ) ;set-cell ( fall through ) @run ( cell-fn* -- ) STH2 ;on-frame-paused .Screen/vector DEO2 .rle/n LDZk #00 ROT STZ DUP #00 NEQ JMP INC &loop ( count / cell-fn* ) DUP #00 EQU ,&end JCN .rle/x LDZ .rle/y LDZ STH2kr JSR2 .rle/x LDZk INC SWP STZ #01 SUB ,&loop JMP &end POP POP2r JMP2r @input-number ( -- ) .rle/n LDZk #0a MUL .Console/read DEI LIT '0 SUB ADD SWP STZ JMP2r @input-eol ( -- ) WIDTH .rle/x LDZ SUB .rle/n STZ ,unset-run JSR #00 .rle/x STZ .rle/y LDZk INC SWP STZ JMP2r @input-eop ( -- ) ,input-eol JSR HEIGHT .rle/y LDZ GTH ,input-eop JCN ;on-frame .Screen/vector DEO2 #00 .rle/y STZ BRK @on-ignore-until-eol ( -> ) .Console/read DEI #0a EQU JMP BRK ;on-input .Console/vector DEO2 BRK @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