\ Conway's Game of Life, or Occam's Razor Dulled

MARKER Genesis

\ ANS Forth this life is remains and 1 CHARS CONSTANT /Char : C+! ( char c-addr -- ) DUP >R C@ + R> C! ;

\ the universal pattern 25 CONSTANT How-Deep 80 CONSTANT How-Wide How-Wide How-Deep * 1- \ 1- prevents scrolling on my screen

CONSTANT Homes

\ world wrap : World

CREATE ( -- ) Homes CHARS ALLOT

DOES> ( u -- c-addr ) SWAP Homes + Homes MOD CHARS + ;

World old World new

\ biostatistics

\ begin hexadecimal numbering HEX \ hex xy : x holds life , y holds neighbors count

10 CONSTANT Alive \ 0y = not alive

\ Conway's rules: \ a life depends on the number of its next-door neighbors

\ it dies if it has fewer than 2 neighbors : Lonely ( char -- flag ) 12 < ;

\ it dies if it has more than 3 neighbors : Crowded ( char -- flag ) 13 > ;

: -Sustaining ( char -- flag )

DUP Lonely SWAP Crowded OR ;

\ it is born if it has exactly 3 neighbors : Quickening ( char -- flag )

03 = ;

\ back to decimal DECIMAL

\ compass points : N ( i -- j ) How-Wide - ; : S ( i -- j ) How-Wide + ; : E ( i -- j ) 1+ ; : W ( i -- j ) 1- ;

\ census : Home+! ( -1|1 i -- ) >R Alive * R> new C+! ;

: Neighbors+! ( -1|0|1 i -- )

2DUP N W new C+! 2DUP N new C+! 2DUP N E new C+! 2DUP W new C+! ( i ) 2DUP E new C+! 2DUP S W new C+! 2DUP S new C+! S E new C+! ;

: Bureau-of-Vital-Statistics ( -1|1 i -- )

2DUP Home+! Neighbors+! ;

\ mortal coils CHAR ? CONSTANT Soul

BL CONSTANT Body

\ at home : Home ( char i -- ) How-Wide /MOD AT-XY EMIT ;

\ changes, changes : Is-Born ( i -- )

Soul OVER Home 1 SWAP Bureau-of-Vital-Statistics ;

: Dies ( i -- )

Body OVER Home

• 1 SWAP Bureau-of-Vital-Statistics ;

\ the one and the many : One ( c-addr -- i )

0 old - /Char / ;

: Everything ( -- )

0 old Homes BEGIN DUP WHILE OVER C@ DUP Alive AND

IF -Sustaining IF OVER One Dies THEN ELSE Quickening IF OVER One Is-Born THEN THEN 1 /STRING

REPEAT 2DROP How-Wide 1- How-Deep 1- AT-XY ;

\ in the beginning : Chaos ( -- )

0 old Homes BLANK ;

\ an angel : Serpent ( -- )

0 2 AT-XY ." Press a key for knowledge." KEY DROP 0 2 AT-XY ." Press space to re-start, Esc to escape life." ;

\ spirit : Say ( -- addr u )

PAGE ." Say: " 0 new DUP Homes ACCEPT ;

\ before history : Innocence ( -- )

Homes 0 DO I new C@ Alive / I Neighbors+! LOOP ;

\ children become parents : Passes ( -- ) 0 new 0 old Homes CMOVE ;

\ a garden : Paradise ( addr u -- )

R How-Deep How-Wide * How-Deep 2 MOD 0= How-Wide AND -

R@ - 2/ old R> CMOVE 0 old Homes 0 DO COUNT BL <>

DUP Alive AND I new C! IF Soul I Home THEN

LOOP DROP Serpent Innocence Passes ;

: Creation ( -- ) Chaos Say Paradise ; : Generation ( -- ) Everything Passes ;

\ the human element

1000 VALUE Ideas : Dreams ( -- ) Ideas MS ;

1000 CONSTANT Images : Meditation ( -- ) Images MS ;

\ free will : Action ( -- char )

KEY? DUP IF DROP KEY

DUP BL = IF Creation THEN

THEN ;

\ illusion : Samsara ( -- char ) Dreams Action Meditation ;

\ life without comments 27 CONSTANT Escape : Acceptance ( char -- flag ) Escape <> ; : Mutability ( -- flag ) Generation Samsara Acceptance ;

THEN ;

\ illusion : Samsara ( -- char ) Dreams Action Meditation ;

\ life without comments 27 CONSTANT Escape : Acceptance ( char -- flag ) Escape <> ; : Mutability ( -- flag ) Generation Samsara Acceptance ; : Goes-On ( -- ) BEGIN Mutability 0= UNTIL ;

: Life ( -- ) Creation Goes-On ;

Life

\ 950724 + 970702 +