Добавлены проекты на racket

1 files changed, 111 insertions, 0 deletions

diff --git a/racket/gol.rkt b/racket/gol.rkt
new file mode 100644
index 0000000..ad5bbf6
--- /dev/null
+++ b/racket/gol.rkt
@@ -0,0 +1,111 @@
+#lang racket
+(require graphics/graphics)
+(require racket/bool)
+
+(define screen-width 600)
+(define screen-height screen-width)
+
+(define board-width 15)
+(define board-height 15)
+
+(define cell-vertical-size (/ screen-width board-width))
+(define cell-horizontal-size (/ screen-height board-height))
+
+(define line-color (make-rgb 0.8 0.8 0.8))
+(define cell-color (make-rgb 0.95 0.95 0))
+
+(define starting-board (set '(1 0)
+                      '(2 1)
+                      '(0 2)
+                      '(1 2)
+                      '(2 2)))
+
+(open-graphics)
+
+(define w (open-viewport "Game of Life"
+                         screen-width
+                         screen-height))
+
+(define (draw-vertical-lines coord step)
+  (cond 
+    [(< coord screen-width) (begin
+                              ((draw-line w) (make-posn coord 0)
+                                             (make-posn coord screen-height)
+                                             line-color)
+                              (draw-vertical-lines (+ coord step) step))]))
+
+(define (draw-horizontal-lines coord step)
+  (cond 
+    [(< coord screen-width) (begin
+                              ((draw-line w) (make-posn 0 coord)
+                                             (make-posn screen-height coord)
+                                             line-color)
+                              (draw-horizontal-lines (+ coord step) step))]))
+
+(define (draw-lines width height)
+  (draw-vertical-lines cell-vertical-size cell-vertical-size)
+  (draw-horizontal-lines cell-horizontal-size cell-horizontal-size))
+
+(define (draw-cell cell)
+  ((draw-solid-ellipse w) (make-posn (* cell-horizontal-size (car cell))
+                                     (* cell-horizontal-size (car (cdr cell))))
+                          cell-vertical-size
+                          cell-horizontal-size
+                          cell-color))
+
+(define (draw-board board)
+  (for ([cell board])
+    (draw-cell cell)))
+
+(define (count-alive-neighbors orig-cell board)
+  (let* ([orig-x (car orig-cell)]
+         [orig-y (car (cdr orig-cell))])
+    (define (iterate y sum)
+      (define (iterate-row x row-sum)
+        (let ([cell (list x y)])
+          (if (<= x (+ orig-x 1))
+              (iterate-row (+ x 1) (if (set-member? board cell)
+                                       (+ row-sum 1)
+                                       row-sum))
+              row-sum)))
+      (if (<= y (+ orig-y 1)) (iterate (+ y 1)
+                                       (+ sum
+                                          (iterate-row (- orig-x 1) 0)))
+          sum))
+
+    (let ([neighbors (iterate (- orig-y 1) 0)])
+      (if (set-member? board orig-cell)
+          (- neighbors 1)
+          neighbors))))
+
+(define (will-be-alive cell board)
+  (let* ([alive-neighbors (count-alive-neighbors cell board)]
+         [is-alive (set-member? board cell)])
+    (or
+      (and is-alive (or (eq? alive-neighbors 2) (eq? alive-neighbors 3)))
+      (and (not is-alive) (eq? alive-neighbors 3)))))
+
+(define (next-generation current-board)
+  (define new-board (mutable-set))
+
+  (define (iterate y)
+    (define (iterate-row x)
+      (let ([cell (list x y)])
+        (cond [(will-be-alive cell current-board) (set-add! new-board cell)])
+        (cond [(< x board-width) (iterate-row (+ x 1))])))
+    (iterate-row 0)
+    (cond [(< y board-height) (iterate (+ y 1))]))
+
+  (iterate 0)
+  new-board)
+
+(define (play board)
+  ((clear-viewport w))
+  (draw-lines board-width board-height)
+  (draw-board board)
+  (sleep 0.5)
+  (play (next-generation board)))
+
+(play starting-board)
+
+(close-graphics)
\ No newline at end of file