Differences between current version and revision by previous author of LifeInForth.
Other diffs: Previous Major Revision, Previous Revision, or view the Annotated Edit History
| Newer page: | version 3 | Last edited on Tuesday, March 27, 2007 1:32:29 pm | by AristotlePagaltzis | |
| Older page: | version 2 | Last edited on Tuesday, April 6, 2004 1:46:02 am | by LeoWong | Revert |
@@ -1,163 +1,165 @@
This is a poem, and artifical life simulator, in [Forth] by Leo Wong:
-
\ Conway's Game of Life, or Occam's Razor Dulled
+<verbatim>
+
\ Conway's Game of Life, or Occam's Razor Dulled
-
MARKER Genesis
+MARKER Genesis
-
\ ANS Forth this life is remains and
- 1 CHARS CONSTANT /Char
- : C+! ( char c-addr -- ) DUP >R C@ + R> C! ;
+\ 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
+\ 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 wrap
+: World
+
CREATE ( -- ) Homes CHARS ALLOT
+
DOES> ( u -- c-addr ) SWAP Homes + Homes MOD CHARS + ;
-
World old
- World new
+World old
+World new
-
\ biostatistics
+\ biostatistics
-
\ begin hexadecimal numbering
- HEX \ hex xy : x holds life , y holds neighbors count
+\ begin hexadecimal numbering
+HEX \ hex xy : x holds life , y holds neighbors count
-
10 CONSTANT Alive \ 0y = not alive
+10 CONSTANT Alive \ 0y = not alive
-
\ Conway's rules:
- \ a life depends on the number of its next-door neighbors
+\ 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 fewer than 2 neighbors
+: Lonely ( char -- flag ) 12 < ;
-
\ it dies if it has more than 3 neighbors
- : Crowded ( char -- flag ) 13 > ;
+\ it dies if it has more than 3 neighbors
+: Crowded ( char -- flag ) 13 > ;
-
: -Sustaining ( char -- flag )
-
DUP Lonely SWAP Crowded OR ;
+: -Sustaining ( char -- flag )
+
DUP Lonely SWAP Crowded OR ;
-
\ it is born if it has exactly 3 neighbors
- : Quickening ( char -- flag )
-
03 = ;
+\ it is born if it has exactly 3 neighbors
+: Quickening ( char -- flag )
+
03 = ;
-
\ back to decimal
- DECIMAL
+\ back to decimal
+DECIMAL
-
\ compass points
- : N ( i -- j ) How-Wide - ;
- : S ( i -- j ) How-Wide + ;
- : E ( i -- j ) 1+ ;
- : W ( i -- j ) 1- ;
+\ 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+! ;
+\ census
+: Home+! ( -1|1 i -- ) >R Alive * R> new C+! ;
-
: Neighbors+! ( -1||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+! ;
+: Neighbors+! ( -1||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+! ;
+: Bureau-of-Vital-Statistics ( -1|1 i -- )
+
2DUP Home+! Neighbors+! ;
-
\ mortal coils
- CHAR ? CONSTANT Soul
-
BL CONSTANT Body
+\ mortal coils
+CHAR ? CONSTANT Soul
+
BL CONSTANT Body
-
\ at home
- : Home ( char i -- ) How-Wide /MOD AT-XY EMIT ;
+\ 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 ;
+\ 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 / ;
+\ 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 ;
+: 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 ;
+\ 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." ;
+\ 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 ;
+\ spirit
+: Say ( -- addr u )
+
PAGE
+
." Say: " 0 new DUP Homes ACCEPT ;
-
\ before history
- : Innocence ( -- )
-
Homes
-
DO I new C@ Alive / I Neighbors+! LOOP ;
+\ before history
+: Innocence ( -- )
+
Homes
+
DO I new C@ Alive / I Neighbors+! LOOP ;
-
\ children become parents
- : Passes ( -- ) 0 new 0 old Homes CMOVE ;
+\ children become parents
+: Passes ( -- ) 0 new 0 old Homes CMOVE ;
-
\ a garden
- : Paradise ( addr u -- )
-
>R How-Deep How-Wide * How-Deep 2 MOD = How-Wide AND -
-
R@ - 2/ old
-
R> CMOVE
-
0 old Homes
-
DO COUNT BL <>
-
DUP Alive AND I new C!
-
IF Soul I Home THEN
-
LOOP DROP
-
Serpent
-
Innocence Passes ;
+\ a garden
+: Paradise ( addr u -- )
+
>R How-Deep How-Wide * How-Deep 2 MOD = How-Wide AND -
+
R@ - 2/ old
+
R> CMOVE
+
0 old Homes
+
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 ;
+: Creation ( -- ) Chaos Say Paradise ;
+: Generation ( -- ) Everything Passes ;
-
\ the human element
+\ the human element
-
100 VALUE Ideas
- : Dreams ( -- ) Ideas MS ;
+100 VALUE Ideas
+: Dreams ( -- ) Ideas MS ;
-
100 CONSTANT Images
- : Meditation ( -- ) Images MS ;
+100 CONSTANT Images
+: Meditation ( -- ) Images MS ;
-
\ free will
- : Action ( -- char )
-
KEY? DUP
-
IF DROP KEY
-
DUP BL = IF Creation THEN
-
THEN ;
+\ free will
+: Action ( -- char )
+
KEY? DUP
+
IF DROP KEY
+
DUP BL = IF Creation THEN
+
THEN ;
-
\ illusion
- : Samsara ( -- char ) Dreams Action Meditation ;
+\ 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 = UNTIL ;
+\ life without comments
+27 CONSTANT Escape
+: Acceptance ( char -- flag ) Escape <> ;
+: Mutability ( -- flag ) Generation Samsara Acceptance ;
+: Goes-On ( -- ) BEGIN Mutability = UNTIL ;
-
: Life ( -- ) Creation Goes-On ;
+: Life ( -- ) Creation Goes-On ;
-
Life
+Life
-
\ 950724 + 970702 +
+\ 950724 + 970702 +
+</verbatim>
