Penguin

This is a poem, and artifical life simulator, in Forth by Leo Wong:

\ 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

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

100 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 ;
: Goes-On  ( -- )  BEGIN  Mutability  0= UNTIL ;

: Life  ( -- )  Creation Goes-On ;

Life

\ 950724 + 970702 +