Cellular Automata

(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 [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 (/ (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 {
  "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))
  :probability 0.5
  :reset? true
  :cells #{}})

(defn draw-cells [ctx cells]
  (doseq [[x y] cells
          :let [x (* x cell-size)
                y (* y cell-size)]]
    (-> 
      ctx
      (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] :as world-state}]
  (-> 
    ctx
    (fill-style "white")
    (alpha 0.5)
    (fill-rect blank)
    (fill-style color)
    (alpha 1.0)
    (begin-path)
    (draw-cells cells)
    (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)] 
    (->
      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)]
    (go
      (loop []
        (when-let [msg (<! src-chan)]
          (>! dest-chan (update-in msg [key] str))
          (recur))))
    src-chan))

(defn reset-world> [dest-chan]
  (let [src-chan (chan 1)]
    (go
      (loop []
        (when-let [msg (<! src-chan)]
          (>! dest-chan (assoc msg :reset? true))
          (recur))))
    src-chan))

(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 (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 (reset-world> updates-chan))]))))
    
    (big-bang
      :initial-state initial-state
      :on-tick update-state
      :on-receive handle-incoming-msg
      :receive-channel updates-chan
      :to-draw render)))
 
(show canvas)
(start)

(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}))