block by dribnet 6564287

experimental async boids with controls

Full Screen

A messy experiment. There will be bugs.

index.html

<!DOCTYPE html>
<meta charset="utf-8">
<title>boids</title>
<body>
  <script type="text/javascript" src="//d3js.org/d3.v3.min.js"></script>
  <script type="text/javascript" src="//cdnjs.cloudflare.com/ajax/libs/dat-gui/0.5/dat.gui.min.js"></script>
  <script type="text/javascript" src="boids.js"></script>
</body>

boids.cljs

(ns boids
  (:require-macros 
    [mrhyde.jso :refer [jso]]
    [cljs.core.async.macros :refer [go alt!]]
    [mrhyde.reader])
  (:require 
    [mrhyde.extend-js]
    [cljs.core.async :as async
              :refer [<!! close! alts! <! >! chan put! timeout]]
    [strokes :refer [d3 timer]]))

(strokes/bootstrap)

(def width 960)
(def height 500)

(declare boids)
(declare add-boids)
(declare settings)

(def settings #jsr { 
  :randomness    4.0
  :neighborhood 80.0
  :momentum      1.0
  :avoidance     8.0
  :cohesion      1.0
  :consistency   0.4
  :jump          3.0
  :timeout       100
  :num-boids      20
  :dead-prop     0.25
  :renew        #(do (reset! boids {}) (add-boids (int (:num-boids settings))))})

(let [gui (dat.GUI.)]
  (.close gui)
  (.add gui settings "randomness" 0 10)
  (.add gui settings "momentum" 0 10)
  (.add gui settings "avoidance" 0 10)
  (.add gui settings "cohesion" 0 10)
  (.add gui settings "consistency" 0 10)
  (.add gui settings "jump" 1 30)
  (.add gui settings "timeout" 1 3000)
  (.add gui settings "num-boids" 0 100)
  (.add gui settings "dead-prop" 0 1)
  (.add gui settings "neighborhood" 1 200)
  (.add gui settings "renew"))

(defn rand-range [low high]
  (+ low (rand (- high low))))

(defn newboid []
  {:id (str (gensym "boid-"))
   :loc [(rand-int width) (rand-int height)] 
   :lastd (mapv #(rand-range -1 1) (range 2))
   :dead (< (rand) (:dead-prop settings))})

(defn gen-boids [n]
  (into {} (map #(vector (:id %) %)
    (vec (take n (repeatedly newboid))))))

(def boids (atom {}))

(def colorfn (strokes/category20c))

(def svg (-> d3 (.select "body") (.append "svg")
      (.attr {:width width :height height})))

(defn orientation [b]
  (let [[dx dy] (:lastd b)]
    (if (and (zero? dx) (zero? dy))
      0
      (Math/atan2 dy dx))))

(defn angle-to-svg [a]
  (/ (* 180 a) Math/PI))

(defn boid-transform [b]
  (let [[x y] (:loc b)]
    (str "translate(" x "," y ") "
         "rotate (" (-> b orientation angle-to-svg) ")")))

(defn draw-boids []
  (let [shapes (-> svg (.selectAll "polygon") (.data (vec (vals @boids)) :id))]
    ; ENTER - create new elments as needed
    (-> shapes (.enter)
      (.append "polygon")
        (.attr "points" "20,0 0,10 -10,0 0,-10")
        (.style {
          ; :what #(.log js/console (:id %))
          :fill #(if (:dead %1) "black" (colorfn %2))
          :fill-opacity 1e-6})
      (.transition)
        (.duration 750)
        (.style {:fill-opacity 1}))
    ; Update new and old
    (-> shapes
        (.attr {:transform boid-transform}))
    ; EXIT - remove old elements as needed.
    (-> shapes (.exit) (.remove))))
    ; exit transition not working
    ; (-> shapes (.exit)
    ;   (.transition)
    ;     (.duration 750)
    ;     (.style {:fill-opacity 1e-6})
    ;     (.remove))
    ; ; return true if there was an exit
    ; (> (-> shapes (.exit) .-length) 1)))

(defn momentum [b]
  (:lastd b))

(defn randomness [b]
  (let [s 0.05
        x (rand-range -1.0 1.0)
        y (rand-range -1.0 1.0)
        l (Math/sqrt (+ (* x x) (* y y)))]
    [(/ (* s x) l) (/ (* s y) l)]))

(defn avoidance [b nbrs]
  (let [pos (:loc b)
        dxys (mapv #(mapv - pos (:loc %)) nbrs)
        lensquared (mapv (fn [[x y]] (+ (* x x) (* y y))) dxys)
        xys (mapv (fn [[dx dy] l]
                    (let [denom (+ (* l l) 1)] [(/ dx denom) (/ dy denom)]))
                  dxys lensquared)
        v (reduce #(mapv + % %2) [0 0] xys)
        ct (if (empty? nbrs) 1 (count nbrs))]
    (mapv #(/ (* 9000 %) ct) v)))

(defn cohesion [b nbrs]
  (let [pos (:loc b)
        dxys (mapv #(mapv - pos (:loc %)) nbrs)
        v (reduce #(mapv + % %2) [0 0] dxys)
        ct (if (empty? nbrs) 1 (count nbrs))]
    (mapv #(/ (/ % -100) ct) v)))

(defn consistency [b nbrs]
  (let [pos (:loc b)
        dxys (mapv momentum nbrs)
        v (reduce #(mapv + % %2) [0 0] dxys)
        ct (if (empty? nbrs) 1 (count nbrs))]
    (mapv #(/ % ct) v)))

(defn wrap [[x y]]
  [(mod x width) (mod y height)])

(defn is-near? [pos r b]
  (let [dv  (mapv - pos (:loc b))
        md  (reduce + (mapv Math/abs dv))]
    ; are we already outside the bounding box (or coincident)
    (if (or (> md r) (zero? md))
      false
      (let [[x y] dv
            l (Math/sqrt (+ (* x x) (* y y)))]
        (< l r)))))

(defn neighbors-of [b]
  (filter (partial is-near? (:loc b) (:neighborhood settings)) 
    (vals (dissoc @boids (:id b)))))

(defn update-one-boid [b]
  (if (:dead b)
    b
    (let [loc (:loc b)
          neighbors (neighbors-of b)
          live-neighbors (remove :dead neighbors)
          ran (mapv #(* % (:randomness  settings)) (randomness b))
          mom (mapv #(* % (:momentum    settings)) (momentum b))
          avd (mapv #(* % (:avoidance   settings)) (avoidance b neighbors))
          coh (mapv #(* % (:cohesion    settings)) (cohesion b live-neighbors))
          con (mapv #(* % (:consistency settings)) (consistency b live-neighbors))
          [dx dy] (mapv + ran mom avd coh con)
          dis (Math/sqrt (+ (* dx dx) (* dy dy)))
          jump (:jump settings)
          nowd (if (> dis 0)
                  (map #(* (/ % dis) jump) [dx dy])
                  [0 0])
          lastd (mapv #(+ (* 0.7 %) (* 0.3 %2)) (momentum b) nowd)
          loc (mapv + loc lastd)]
      (merge b {:loc (wrap loc) :lastd lastd}))))

(defn run-one-boid [id]
  (let [tout (rand-range 1 (:timeout settings))]
    (go (while (get @boids id)
      (<! (timeout tout))
      (swap! boids #(update-in % [id] update-one-boid))))))

(defn update-all-boids [m]
  (into {} (for [[k v] m] [k (update-one-boid v)])))

(defn add-boids [n]
  (let [m (gen-boids n)]
    (swap! boids #(merge % m))
    (doseq [k (keys m)]
      (run-one-boid k))))

(add-boids (int (:num-boids settings)))

(go (while true
  (<! (timeout 1))
  (let [ct (count @boids)
        target (int (:num-boids settings))]
    (cond
      (> ct target)
        (swap! boids #(into {} (take target %)))
      (< ct target)
        (add-boids (- target ct))))))

(doseq [k (keys @boids)]
  (run-one-boid k))

(timer (fn []
  ; (update-boids)
  (draw-boids)
  ; (if (draw-boids)
    ; (-> d3 .-timer .flush))
    ; ((:flush timer)))
  false))