blob: e0732a60bec482570ca6568c505d09b7ddefd8f7 (
plain)
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
|
(define current-cells (make-hash-table))
(define neighbors
'((-1 . -1) (0 . -1) (1 . -1) (-1 . 0) (1 . 0) (-1 . 1) (0 . 1) (1 . 1)))
(define sum-cells
(lambda (c1 c2)
(cons (+ (car c1) (car c2)) (+ (cdr c1) (cdr c2)))))
(define diff-cells
(lambda (c1 c2)
(cons (- (car c1) (car c2)) (- (cdr c1) (cdr c2)))))
(define sum-all-cells
(lambda (lat)
(cond ((null? (cdr lat)) (car lat))
(else (let ((c1 (car lat)) (c2 (sum-all-cells (cdr lat))))
(sum-cells c1 c2)
)))))
(define is-hash-neighbor?
(lambda (c1 c2)
(let ((d (diff-cells c1 c2)))
(and (<= (car d) 1) (>= (car d) -1) (<= (cdr d) 1) (>= (cdr d) -1)))))
(define count-elements
(lambda (lat s)
(cond ((null? lat) s)
(else (count-elements (cdr lat) (+ s 1))))))
(define list-neighbors
(lambda (c)
(map (lambda (n)
(sum-cells c n)
)
neighbors)
))
(define sum-live-cells
(lambda (lat n)
(cond ((null? lat) n)
(else (cond ((current-cells (car lat)) (sum-live-cells (cdr lat) (+ n 1)))
(else (sum-live-cells (cdr lat) n)))))))
(define list-all-neighbors
(lambda (lat cells)
(cond ((null? lat) cells)
(else
(map (lambda (new-neighbor)
(set! (cells new-neighbor) #t))
(cons (car lat) (list-neighbors (car lat))))
(list-all-neighbors (cdr lat) cells)))))
(define (hash-table-keys ht)
(map (lambda (kv)
(kv 0)
)
ht)
)
(define run-step
(lambda ()
(let ((temp-hash (make-hash-table)) (next-cells (make-hash-table)))
(map (lambda (temp-cell)
(let ((n (sum-live-cells (list-neighbors temp-cell) 0)))
(cond ((current-cells temp-cell)
(cond ((and (>= n 2) (<= n 3)) (set! (next-cells temp-cell) #t))))
(else (cond ((eq? n 3) (set! (next-cells temp-cell) #t))))))
)
(hash-table-keys (list-all-neighbors (hash-table-keys current-cells) temp-hash)))
(set! current-cells next-cells)
)
)
)
(define (clear-cells)
(set! current-cells (make-hash-table))
)
(define (toggle-cell c)
(if (current-cells c)
(set! (current-cells c) #f)
(set! (current-cells c) #t)
)
)
(define (set-cells-array arr)
(map (lambda (c)
(set! (current-cells c) #t)
)
arr
)
)
(define (get-cells-list)
(hash-table-keys current-cells)
)
|
