-
Notifications
You must be signed in to change notification settings - Fork 1
/
block-0100.fs
128 lines (99 loc) · 2.41 KB
/
block-0100.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
CR sys-info
last here
variable th th !
variable tl tl !
: forget-life tl @ (last) ! th @ (here) ! ;
\ ------------- Game of life -------------
: rows 50 ;
: cols 100 ;
variable grid
rows cols * ALLOT
: grid-sz rows cols * CELL + ;
: grid-0-fill grid grid-sz 0 FILL ;
grid-0-fill
: cell-new-val \ ( curr-val n -- new-val )
\ <2: die
\ 2: no change
\ 3: come alive
\ >3: die
DUP 2 = if DROP leave then
DUP 3 = if 2DROP 1 leave then
2DROP 0 ;
: cell-at \ ( r c -- addr )
swap cols * swap + grid + ;
\ ( addr -- 0|1 )
: is-alive? C@ 1 AND ; INLINE
: cell-sub \ ( n1 addr1 -- n2 addr2 )
SWAP OVER is-alive? + SWAP 1+ ;
: do-cell \ ( addr -- )
DUP T1 !
DUP is-alive? T2 !
cols - 1-
0 SWAP
cell-sub
cell-sub
cell-sub
3 - cols +
cell-sub
1+
cell-sub
3 - cols +
cell-sub
cell-sub
cell-sub
DROP
T2 @ SWAP cell-new-val 4 LSHIFT T2 @ +
T1 @ C! ;
: do-row cols 2- \ ( r -- )
TUCK cell-at SWAP
BEGIN
SWAP DUP do-cell 1- SWAP
1- DUP
WHILE 2DROP ;
: do-grid rows 2- \ ( -- )
BEGIN
DUP do-row
1- DUP
WHILE DROP ;
: show-cell \ ( addr -- addr+1 )
DUP is-alive?
IF 42 ELSE 32 THEN
EMIT 1+ ;
: show-row \ ( r -- )
1 cell-at
cols 2-
BEGIN
SWAP show-cell SWAP
1- DUP
WHILE 2DROP CR ;
: show-grid rows 2- \ ( -- )
0 0 gotoxy
BEGIN
rows 2- OVER - 1+ show-row
1- DUP
WHILE DROP ;
: cell-update \ ( addr1 -- addr2 )
DUP C@ 4 RSHIFT OVER C! 1+ ;
: update-grid
grid grid-sz
BEGIN
SWAP cell-update SWAP
1- DUP
WHILE 2DROP ;
: one-cycle CR do-grid show-grid update-grid ;
: slow-down 1000 * BEGIN 1- DUP WHILE DROP ;
: st start-timer swap slow-down elapsed ;
variable delay 1 delay !
: life BEGIN
one-cycle DUP . delay @ slow-down
1- DUP WHILE DROP ;
: set-cell cell-at 1 SWAP C! ;
: clr-cell cell-at 0 SWAP C! ;
: cell? cell-at C@ . ;
: reset-life TIMER 5000 MOD DUP .
grid grid-sz CMOVE ;
: go 50 life ;
reset-life go
CR sys-info
\ forget-life CR sys-info
\ ------------- END OF LIFE -------------