rm-hull · August 29, 2015 14:04 · Aug 3, 2014 · Aug 3, 2014 · Aug 3, 2014 · Aug 3, 2014
diff --git a/cellular-automata.cljs b/cellular-automata.cljs
@@ -50,8 +50,9 @@
 (def initial-state {
   :color (rand-nth colors)
   :player (rand-nth (keys players))
-  :probability 0.4
-  :cells (random-world 0.4)})
+  :probability 0.5
+  :reset? true
+  :cells #{}})
 
 (defn draw-cells [ctx cells]
   (doseq [[x y] cells
@@ -78,9 +79,26 @@
     (fill)
     (close-path)))
 
+(defn reset-world [world-state]
+  (if (:reset? world-state)
+    (->
+      world-state
+      (assoc :cells (random-world (:probability world-state)))
+      (dissoc :reset?))
+    world-state))
+
 (defn update-state [event world-state]
   (let [player (partial (players (:player world-state)) trim)] 
-    (update-in world-state [:cells] player)))
+    (->
+      world-state
+      (update-in [:cells] player)
+      (reset-world))))
+
+(defn handle-incoming-msg [event world-state]
+  (->
+    world-state
+    (merge event)
+    (reset-world)))
 
 (defn to-keyword> [key dest-chan]
   (let [src-chan (chan 1)]
@@ -96,13 +114,10 @@
     (go
       (loop []
         (when-let [msg (<! src-chan)]
-          (>! dest-chan (assoc msg :cells (random-world 0.4)))
+          (>! dest-chan (assoc msg :reset? true))
           (recur))))
     src-chan))
 
-(defn handle-incoming-msg [event world-state]
-  (merge world-state event))
-
 (defn start []
   (let [updates-chan (chan 1)]
     (go

diff --git a/cellular-automata.cljs b/cellular-automata.cljs
@@ -96,7 +96,7 @@
     (go
       (loop []
         (when-let [msg (<! src-chan)]
-          (>! dest-chan (assoc msg :cells (random-world 0.4))
+          (>! dest-chan (assoc msg :cells (random-world 0.4)))
           (recur))))
     src-chan))
 

diff --git a/cellular-automata.cljs b/cellular-automata.cljs
@@ -1,5 +1,5 @@
 (ns cellular-automata.core
-    (:require-macros
+  (:require-macros
     [cljs.core.async.macros :refer [go]]
     [dommy.macros :refer [sel1 node]])
   (:require
@@ -91,6 +91,15 @@
           (recur))))
     src-chan))
 
+(defn reset-world> [dest-chan]
+  (let [src-chan (chan 1)]
+    (go
+      (loop []
+        (when-let [msg (<! src-chan)]
+          (>! dest-chan (assoc msg :cells (random-world 0.4))
+          (recur))))
+    src-chan))
+
 (defn handle-incoming-msg [event world-state]
   (merge world-state event))
 
@@ -112,15 +121,15 @@
                              :label-text " Type: "
                              :initial-value (:player initial-state)
                              :options (zipmap (keys players) (keys players))
-                             :send-channel (to-keyword> :player updates-chan))
+                             :send-channel (reset-world> (to-keyword> :player updates-chan)))
                            (slider
                              :id :probability
                              :label-text " Population probability: "
                              :initial-value (:probability initial-state)
                              :min-value 0.0
                              :max-value 1.0
                              :step 0.01
-                             :send-channel updates-chan)]))))
+                             :send-channel (reset-world> updates-chan))]))))
 
     (big-bang
       :initial-state initial-state

diff --git a/cellular-automata.cljs b/cellular-automata.cljs
@@ -66,10 +66,9 @@
   ctx)
 
 (defn render [{:keys [color cells] :as world-state}]
-  (println world-state)
   (-> 
     ctx
-    (fill-style "#000000")
+    (fill-style "white")
     (alpha 0.5)
     (fill-rect blank)
     (fill-style color)
@@ -81,8 +80,6 @@
 
 (defn update-state [event world-state]
   (let [player (partial (players (:player world-state)) trim)] 
-    (println (:player world-state))
-    (println player)
     (update-in world-state [:cells] player)))
 
 (defn to-keyword> [key dest-chan]

diff --git a/cellular-automata.cljs b/cellular-automata.cljs
@@ -80,7 +80,7 @@
     (close-path)))
 
 (defn update-state [event world-state]
-  (let [player (partial (player (:player world-state)) trim)] 
+  (let [player (partial (players (:player world-state)) trim)] 
     (println (:player world-state))
     (println player)
     (update-in world-state [:cells] player)))

diff --git a/cellular-automata.cljs b/cellular-automata.cljs
@@ -18,8 +18,8 @@
 (def cell-size 10)
 (def block-size (dec cell-size))
 
-(def width (/ cell-size (first (canvas-size))))
-(def height (/ cell-size (second (canvas-size))))
+(def width (/ (first (canvas-size)) cell-size))
+(def height (/ (second (canvas-size)) cell-size))
 (def blank {:x 0 :y 0 :w (* width cell-size) :h (* height cell-size)})
 
 (def players {
@@ -127,9 +127,10 @@
 
     (big-bang
       :initial-state initial-state
-      :to-draw render
+      :on-tick update-state
+      :on-receive handle-incoming-msg
       :receive-channel updates-chan
-      :on-receive handle-incoming-msg)))
+      :to-draw render)))
 
 (show canvas)
 (start)
diff --git a/cellular-automata.cljs b/cellular-automata.cljs
@@ -65,8 +65,8 @@
       (line-to (+ x block-size) y)))
   ctx)
 
-(defn render [{:keys [color cells]}]
-  (println cells)
+(defn render [{:keys [color cells] :as world-state}]
+  (println world-state)
   (-> 
     ctx
     (fill-style "#000000")
@@ -81,6 +81,8 @@
 
 (defn update-state [event world-state]
   (let [player (partial (player (:player world-state)) trim)] 
+    (println (:player world-state))
+    (println player)
     (update-in world-state [:cells] player)))
 
 (defn to-keyword> [key dest-chan]
@@ -116,7 +118,7 @@
                              :send-channel (to-keyword> :player updates-chan))
                            (slider
                              :id :probability
-                             :label-text " Population probability:"
+                             :label-text " Population probability: "
                              :initial-value (:probability initial-state)
                              :min-value 0.0
                              :max-value 1.0

diff --git a/cellular-automata.cljs b/cellular-automata.cljs
@@ -50,7 +50,8 @@
 (def initial-state {
   :color (rand-nth colors)
   :player (rand-nth (keys players))
-  :cells (random-world 0.5)})
+  :probability 0.4
+  :cells (random-world 0.4)})
 
 (defn draw-cells [ctx cells]
   (doseq [[x y] cells
@@ -97,22 +98,30 @@
 (defn start []
   (let [updates-chan (chan 1)]
     (go
-        (->>
-          (sel1 :#canvas-area)
-          (insert-after! (node
-                           [:div
-                             (dropdown
-                               :id :color
-                               :label-text " Color: "
-                               :initial-value (:color initial-state)
-                               :options (zipmap colors colors)
-                               :send-channel (to-keyword> :color updates-chan))
-                              (dropdown
-                               :id :player
-                               :label-text " Type: "
-                               :initial-value (:player initial-state)
-                               :options (zipmap (keys players) (keys players))
-                               :send-channel (to-keyword> :player updates-chan))]))))
+      (->>
+        (sel1 :#canvas-area)
+        (insert-after! (node
+                         [:div
+                           (dropdown
+                             :id :color
+                             :label-text " Color: "
+                             :initial-value (:color initial-state)
+                             :options (zipmap colors colors)
+                             :send-channel (to-keyword> :color updates-chan))
+                           (dropdown
+                             :id :player
+                             :label-text " Type: "
+                             :initial-value (:player initial-state)
+                             :options (zipmap (keys players) (keys players))
+                             :send-channel (to-keyword> :player updates-chan))
+                           (slider
+                             :id :probability
+                             :label-text " Population probability:"
+                             :initial-value (:probability initial-state)
+                             :min-value 0.0
+                             :max-value 1.0
+                             :step 0.01
+                             :send-channel updates-chan)]))))
 
     (big-bang
       :initial-state initial-state

diff --git a/cellular-automata.cljs b/cellular-automata.cljs
@@ -65,6 +65,7 @@
   ctx)
 
 (defn render [{:keys [color cells]}]
+  (println cells)
   (-> 
     ctx
     (fill-style "#000000")
@@ -78,7 +79,7 @@
     (close-path)))
 
 (defn update-state [event world-state]
-  (let [player (partial (:player world-state) trim)] 
+  (let [player (partial (player (:player world-state)) trim)] 
     (update-in world-state [:cells] player)))
 
 (defn to-keyword> [key dest-chan]

diff --git a/cellular-automata.cljs b/cellular-automata.cljs
@@ -10,7 +10,7 @@
     [big-bang.components :refer [dropdown slider]]
     [enchilada :refer [ctx canvas canvas-size]]
     [cellular-automata.engine :as ca]
-    [monet.canvas :refer [get-context fill-style fill-rect alpha 
+    [monet.canvas :refer [fill-style fill-rect alpha 
                           begin-path line-to move-to close-path fill]]))
 
 (def colors ["red" "green" "blue" "yellow" "purple" "orange"])
@@ -58,10 +58,10 @@
                 y (* y cell-size)]]
     (-> 
       ctx
-      (move-to a b)
-      (line-to a (+ b block-size))
-      (line-to (+ a block-size) (+ b block-size))
-      (line-to (+ a block-size) b)))
+      (move-to x y)
+      (line-to x (+ y block-size))
+      (line-to (+ x block-size) (+ y block-size))
+      (line-to (+ x block-size) y)))
   ctx)
 
 (defn render [{:keys [color cells]}]
@@ -78,7 +78,7 @@
     (close-path)))
 
 (defn update-state [event world-state]
-  (let [player (partial (:player world-state) trim) 
+  (let [player (partial (:player world-state) trim)] 
     (update-in world-state [:cells] player)))
 
 (defn to-keyword> [key dest-chan]

diff --git a/cellular-automata.cljs b/cellular-automata.cljs
@@ -0,0 +1,123 @@
+(ns cellular-automata.core
+    (:require-macros
+    [cljs.core.async.macros :refer [go]]
+    [dommy.macros :refer [sel1 node]])
+  (:require
+    [cljs.core.async :refer [chan <! >!]]
+    [dommy.core :refer [insert-after!]]
+    [jayq.core :refer [$ hide show]]
+    [big-bang.core :refer [big-bang]]
+    [big-bang.components :refer [dropdown slider]]
+    [enchilada :refer [ctx canvas canvas-size]]
+    [cellular-automata.engine :as ca]
+    [monet.canvas :refer [get-context fill-style fill-rect alpha 
+                          begin-path line-to move-to close-path fill]]))
+
+(def colors ["red" "green" "blue" "yellow" "purple" "orange"])
+
+(def cell-size 10)
+(def block-size (dec cell-size))
+
+(def width (/ cell-size (first (canvas-size))))
+(def height (/ cell-size (second (canvas-size))))
+(def blank {:x 0 :y 0 :w (* width cell-size) :h (* height cell-size)})
+
+(def players {
+  "Conway's game-of-life"    ca/conways-game-of-life 
+  "Semi-vote"                ca/semi-vote 
+  "Fredkin"                  ca/fredkin 
+;  "Circle"                   ca/circle 
+  "Vichniac Vote"            ca/vichniac-vote 
+  "Vichniac Vote (unstable)" ca/unstable-vichniac-vote})
+
+(defn trim [[x y]] 
+  (and 
+    (>= x 0) 
+    (>= y 0) 
+    (< x width) 
+    (< y height)))
+
+(defn random-world [probability]
+  (set 
+    (for [x (range width)
+          y (range height)
+          :when (< (rand) probability)]
+      [x y])))
+
+(def seven-bar
+   (set (map #(vector % 0) (range 7))))
+
+(def initial-state {
+  :color (rand-nth colors)
+  :player (rand-nth (keys players))
+  :cells (random-world 0.5)})
+
+(defn draw-cells [ctx cells]
+  (doseq [[x y] cells
+          :let [x (* x cell-size)
+                y (* y cell-size)]]
+    (-> 
+      ctx
+      (move-to a b)
+      (line-to a (+ b block-size))
+      (line-to (+ a block-size) (+ b block-size))
+      (line-to (+ a block-size) b)))
+  ctx)
+
+(defn render [{:keys [color cells]}]
+  (-> 
+    ctx
+    (fill-style "#000000")
+    (alpha 0.5)
+    (fill-rect blank)
+    (fill-style color)
+    (alpha 1.0)
+    (begin-path)
+    (draw-cells cells)
+    (fill)
+    (close-path)))
+
+(defn update-state [event world-state]
+  (let [player (partial (:player world-state) trim) 
+    (update-in world-state [:cells] player)))
+
+(defn to-keyword> [key dest-chan]
+  (let [src-chan (chan 1)]
+    (go
+      (loop []
+        (when-let [msg (<! src-chan)]
+          (>! dest-chan (update-in msg [key] str))
+          (recur))))
+    src-chan))
+
+(defn handle-incoming-msg [event world-state]
+  (merge world-state event))
+
+(defn start []
+  (let [updates-chan (chan 1)]
+    (go
+        (->>
+          (sel1 :#canvas-area)
+          (insert-after! (node
+                           [:div
+                             (dropdown
+                               :id :color
+                               :label-text " Color: "
+                               :initial-value (:color initial-state)
+                               :options (zipmap colors colors)
+                               :send-channel (to-keyword> :color updates-chan))
+                              (dropdown
+                               :id :player
+                               :label-text " Type: "
+                               :initial-value (:player initial-state)
+                               :options (zipmap (keys players) (keys players))
+                               :send-channel (to-keyword> :player updates-chan))]))))
+
+    (big-bang
+      :initial-state initial-state
+      :to-draw render
+      :receive-channel updates-chan
+      :on-receive handle-incoming-msg)))
+
+(show canvas)
+(start)
diff --git a/engine.cljs b/engine.cljs
@@ -0,0 +1,46 @@
+(ns cellular-automata.engine)
+
+(def neighbours
+  (for [i [-1 0 1]
+        j [-1 0 1]
+        :when (not= 0 i j)]
+    [i j]))
+
+(def nine-block
+  (for [i [-1 0 1]
+        j [-1 0 1]]
+    [i j]))
+
+(defn transform 
+  "Transforms a point [x y] by a given offset [dx dy]"
+  [[x y] [dx dy]]
+  [(+ x dx) (+ y dy)])
+
+(defn place [artefact position]
+  (mapv (partial transform position) artefact))
+
+(defn stepper [neighbours birth? survive?]
+  (fn [trim-fn cells]
+    (set (for [[loc n] (frequencies (mapcat neighbours cells))
+               :when (and 
+                       (if (cells loc) (survive? n) (birth? n))
+                       (trim-fn loc))]
+           loc))))
+
+(def conways-game-of-life
+  (stepper #(place neighbours %) #{3} #{2 3}))
+
+(def semi-vote
+  (stepper #(place neighbours %) #{3 5 6 7 8} #{4 6 7 8}))
+
+(def vichniac-vote
+  (stepper #(place nine-block %) #{5 6 7 8 9} #{5 6 7 8 9}))
+
+(def unstable-vichniac-vote
+  (stepper #(place nine-block %) #{4 6 7 8 9} #{4 6 7 8 9}))
+
+(def fredkin
+  (stepper #(place nine-block %) #{1 3 5 7 9} #{1 3 5 7 9}))
+
+(def circle
+  (stepper #(place neighbours %) #{3} #{1 2 4}))
No results found