Penguin
Recent Changes
Annotated edit history of LifeInForth version 3, including all changes. View license author blame.
Rev Author # Line
1 GlynWebster 1 This is a poem, and artifical life simulator, in [Forth] by Leo Wong:
2
3 AristotlePagaltzis 3 <verbatim>
4 \ Conway's Game of Life, or Occam's Razor Dulled
1 GlynWebster 5
3 AristotlePagaltzis 6 MARKER Genesis
1 GlynWebster 7
3 AristotlePagaltzis 8 \ ANS Forth this life is remains and
9 1 CHARS CONSTANT /Char
10 : C+! ( char c-addr -- ) DUP >R C@ + R> C! ;
1 GlynWebster 11
3 AristotlePagaltzis 12 \ the universal pattern
13 25 CONSTANT How-Deep
14 80 CONSTANT How-Wide
15 How-Wide How-Deep * 1- \ 1- prevents scrolling on my screen
16 CONSTANT Homes
1 GlynWebster 17
3 AristotlePagaltzis 18 \ world wrap
19 : World
20 CREATE ( -- ) Homes CHARS ALLOT
21 DOES> ( u -- c-addr ) SWAP Homes + Homes MOD CHARS + ;
1 GlynWebster 22
3 AristotlePagaltzis 23 World old
24 World new
1 GlynWebster 25
3 AristotlePagaltzis 26 \ biostatistics
1 GlynWebster 27
3 AristotlePagaltzis 28 \ begin hexadecimal numbering
29 HEX \ hex xy : x holds life , y holds neighbors count
1 GlynWebster 30
3 AristotlePagaltzis 31 10 CONSTANT Alive \ 0y = not alive
1 GlynWebster 32
3 AristotlePagaltzis 33 \ Conway's rules:
34 \ a life depends on the number of its next-door neighbors
1 GlynWebster 35
3 AristotlePagaltzis 36 \ it dies if it has fewer than 2 neighbors
37 : Lonely ( char -- flag ) 12 < ;
1 GlynWebster 38
3 AristotlePagaltzis 39 \ it dies if it has more than 3 neighbors
40 : Crowded ( char -- flag ) 13 > ;
1 GlynWebster 41
3 AristotlePagaltzis 42 : -Sustaining ( char -- flag )
43 DUP Lonely SWAP Crowded OR ;
1 GlynWebster 44
3 AristotlePagaltzis 45 \ it is born if it has exactly 3 neighbors
46 : Quickening ( char -- flag )
47 03 = ;
1 GlynWebster 48
3 AristotlePagaltzis 49 \ back to decimal
50 DECIMAL
1 GlynWebster 51
3 AristotlePagaltzis 52 \ compass points
53 : N ( i -- j ) How-Wide - ;
54 : S ( i -- j ) How-Wide + ;
55 : E ( i -- j ) 1+ ;
56 : W ( i -- j ) 1- ;
1 GlynWebster 57
3 AristotlePagaltzis 58 \ census
59 : Home+! ( -1|1 i -- ) >R Alive * R> new C+! ;
1 GlynWebster 60
3 AristotlePagaltzis 61 : Neighbors+! ( -1|0|1 i -- )
62 2DUP N W new C+! 2DUP N new C+! 2DUP N E new C+!
63 2DUP W new C+! ( i ) 2DUP E new C+!
64 2DUP S W new C+! 2DUP S new C+! S E new C+! ;
1 GlynWebster 65
3 AristotlePagaltzis 66 : Bureau-of-Vital-Statistics ( -1|1 i -- )
67 2DUP Home+! Neighbors+! ;
1 GlynWebster 68
3 AristotlePagaltzis 69 \ mortal coils
70 CHAR ? CONSTANT Soul
71 BL CONSTANT Body
1 GlynWebster 72
3 AristotlePagaltzis 73 \ at home
74 : Home ( char i -- ) How-Wide /MOD AT-XY EMIT ;
1 GlynWebster 75
3 AristotlePagaltzis 76 \ changes, changes
77 : Is-Born ( i -- )
78 Soul OVER Home
79 1 SWAP Bureau-of-Vital-Statistics ;
80 : Dies ( i -- )
81 Body OVER Home
82 -1 SWAP Bureau-of-Vital-Statistics ;
1 GlynWebster 83
3 AristotlePagaltzis 84 \ the one and the many
85 : One ( c-addr -- i )
86 0 old - /Char / ;
1 GlynWebster 87
3 AristotlePagaltzis 88 : Everything ( -- )
89 0 old Homes
90 BEGIN DUP
91 WHILE OVER C@ DUP Alive AND
92 IF -Sustaining IF OVER One Dies THEN
93 ELSE Quickening IF OVER One Is-Born THEN THEN
94 1 /STRING
95 REPEAT 2DROP
96 How-Wide 1- How-Deep 1- AT-XY ;
1 GlynWebster 97
3 AristotlePagaltzis 98 \ in the beginning
99 : Chaos ( -- )
100 0 old Homes BLANK ;
1 GlynWebster 101
3 AristotlePagaltzis 102 \ an angel
103 : Serpent ( -- )
104 0 2 AT-XY ." Press a key for knowledge." KEY DROP
105 0 2 AT-XY ." Press space to re-start, Esc to escape life." ;
1 GlynWebster 106
3 AristotlePagaltzis 107 \ spirit
108 : Say ( -- addr u )
109 PAGE
110 ." Say: " 0 new DUP Homes ACCEPT ;
1 GlynWebster 111
3 AristotlePagaltzis 112 \ before history
113 : Innocence ( -- )
114 Homes 0
115 DO I new C@ Alive / I Neighbors+! LOOP ;
1 GlynWebster 116
3 AristotlePagaltzis 117 \ children become parents
118 : Passes ( -- ) 0 new 0 old Homes CMOVE ;
1 GlynWebster 119
3 AristotlePagaltzis 120 \ a garden
121 : Paradise ( addr u -- )
122 >R How-Deep How-Wide * How-Deep 2 MOD 0= How-Wide AND -
123 R@ - 2/ old
124 R> CMOVE
125 0 old Homes 0
126 DO COUNT BL <>
127 DUP Alive AND I new C!
128 IF Soul I Home THEN
129 LOOP DROP
130 Serpent
131 Innocence Passes ;
1 GlynWebster 132
3 AristotlePagaltzis 133 : Creation ( -- ) Chaos Say Paradise ;
134 : Generation ( -- ) Everything Passes ;
1 GlynWebster 135
3 AristotlePagaltzis 136 \ the human element
1 GlynWebster 137
3 AristotlePagaltzis 138 100 VALUE Ideas
139 : Dreams ( -- ) Ideas MS ;
1 GlynWebster 140
3 AristotlePagaltzis 141 100 CONSTANT Images
142 : Meditation ( -- ) Images MS ;
1 GlynWebster 143
3 AristotlePagaltzis 144 \ free will
145 : Action ( -- char )
146 KEY? DUP
147 IF DROP KEY
148 DUP BL = IF Creation THEN
149 THEN ;
1 GlynWebster 150
3 AristotlePagaltzis 151 \ illusion
152 : Samsara ( -- char ) Dreams Action Meditation ;
1 GlynWebster 153
3 AristotlePagaltzis 154 \ life without comments
155 27 CONSTANT Escape
156 : Acceptance ( char -- flag ) Escape <> ;
157 : Mutability ( -- flag ) Generation Samsara Acceptance ;
158 : Goes-On ( -- ) BEGIN Mutability 0= UNTIL ;
1 GlynWebster 159
3 AristotlePagaltzis 160 : Life ( -- ) Creation Goes-On ;
1 GlynWebster 161
3 AristotlePagaltzis 162 Life
1 GlynWebster 163
3 AristotlePagaltzis 164 \ 950724 + 970702 +
165 </verbatim>

PHP Warning

lib/blame.php:177: Warning: Invalid argument supplied for foreach()