-
Notifications
You must be signed in to change notification settings - Fork 4
/
Copy pathgol.fs
202 lines (170 loc) · 3.49 KB
/
gol.fs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
\ (c)copyright 2014 by Gerald Wodni
\ Implementation of Conways game of live
\ uses the highest byte of the color-buffer (during computation)
\ colors
$5F0000 constant gol-alive
$00007F constant gol-dead
\ fast modulo which assumes nominator is in [-denominator denominator*2)
: wrap ( n-nominator n-denominator -- n-remainder )
over 0< if
+ \ smaller than 0, just add denominator
else
2dup < if \ lower than denominator, okay
drop
else
- \ bigger, subtract denominator
then
then ;
\ calculate cartesian coordinates with overflow protection
: xy ( n-x n-y -- n-index )
rows wrap \ ensure bounds
cols * \ row-offset
swap cols wrap \ ensure bounds
+ ;
\ get color
: xy@ ( n-x n-y -- x-color )
xy led-n @ ;
\ set color
: xy! ( x-xolor n-x n-y -- )
xy led-n! ;
: alive? ( color -- f )
$FFFF00 and ;
\ currently alive
: alive@ ( n-x n-y -- f )
xy@ alive? ;
\ count living neighbors
0 variable cur-neighbors
: neighbors ( n-x n-y -- n-alive )
2dup alive@ if -1 else 0 then cur-neighbors ! \ subract the cell itself
1- 3 bounds do \ walk rows
dup 1- 3 bounds do \ walk columns
i j alive@ if 1 cur-neighbors +! then \ increment counter if alive
loop
loop drop cur-neighbors @ ;
\ check next iteration live value
: cell-alive ( n-x n-y -- f )
2dup neighbors >r
alive@ if
r@ 2 = r> 3 = or \ cell alive, keep alive?
else
r> 3 = \ cell dead, spawn live?
then ;
\ set msb if cell is alive in next iteration
: cell-step ( n-x n-y -- )
2dup xy led-n -rot cell-alive if
$80000000 swap bis!
else
$80000000 swap bic!
then ;
\ perform complete gol-step
: gol-step ( -- )
\ calculate next iteration
rows 0 do
cols 0 do
i j cell-step
loop
loop
\ paint next iteration
rows 0 do
cols 0 do
\ now on
i j xy@ dup $80000000 and if
\ previously off
dup $FFFF00 and 0= if
drop gol-alive
else
$FFFF00 and \ ensure only yellow
dup $FF00 and $E000 < if
$001000 + \ dimm
else
drop $5FF000 \ maximum value
then
then
\ now off
else
\ previously on, make full blue
dup alive? if
drop gol-dead
\ previously off
else
$FF and \ ensure only blue
dup $F > if
$F - \ dimm
else
drop $F \ minimum value
then
then
then
i j xy!
loop
loop
flush ;
: gol-steps ( n -- )
0 do gol-step 300 ms loop ;
\ kill all cells
: gol-off
buffer-off flush ;
\ set gol-cell
: g! ( n-x n-y -- )
gol-alive -rot xy! ;
: glider ( -- )
buffer-off
15 2 g!
16 3 g!
14 4 g! 15 4 g! 16 4 g!
flush ;
: lwss ( -- )
buffer-off
13 2 g! 16 2 g!
17 3 g!
13 4 g! 17 4 g!
14 5 g! 15 5 g! 16 5 g! 17 5 g!
flush ;
: gol-line ( n -- )
buffer-off
15 over 2/ - swap
bounds do
i 3 g!
loop
flush ;
: die-hard ( -- )
buffer-off
18 2 g!
17 4 g!
18 4 g!
19 4 g!
12 3 g!
13 3 g!
13 4 g!
flush ;
: acorn ( -- )
buffer-off
17 3 g!
18 4 g!
19 4 g!
20 4 g!
15 2 g!
15 4 g!
14 4 g!
flush ;
: quadpole ( -- )
buffer-off
11 0 g! 12 0 g!
11 1 g! 13 1 g!
13 3 g! 15 3 g!
15 5 g! 17 5 g!
16 6 g! 17 6 g!
flush ;
: schick ( -- )
buffer-off
15 3 g! 16 3 g!
14 4 g! 15 4 g! 16 4 g!
15 5 g! 16 5 g!
flush ;
: init-gol
init-delay
init-ws
10 gol-line
20 gol-steps
;
: g gol-step ;