A messy experiment. There will be bugs.
<!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>
(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))