boids.cljs
(ns boids
(:use [enchilada :only [canvas ctx value-of canvas-size]]
[jayq.core :only [show]]
[monet.core :only [animation-frame]]
[monet.canvas :only [save restore
begin-path move-to line-to close-path
stroke stroke-style fill fill-rect fill-style
rotate translate]]
[boids.rules :only [step make-boid]])
(:require [boids.vector :refer [heading]]))
(def r (js/parseFloat (value-of :r 3.0)))
(def width (first (canvas-size)))
(def height (second (canvas-size)))
(def stepper (step width height r))
(def rng (range (js/parseInt (value-of :boids 75))))
(def pi-over-2 (/ Math/PI 2))
(def boids
(mapv
#(make-boid (/ width 2) (/ height 2))
rng))
(defn render! [ctx boids size]
(->
ctx
(fill-style :white)
(fill-rect {:x 0 :y 0 :w width :h height})
(stroke-style :darkcyan)
(fill-style :lightcyan))
(doseq [boid boids
:let [[x y] (:location boid)
theta (+ (heading (:velocity boid)) pi-over-2)]]
(->
ctx
(save)
(translate x y)
(rotate theta)
(begin-path)
(move-to 0 (* size -2))
(line-to (- size) (* size 2))
(line-to size (* size 2))
(close-path)
(fill)
(stroke)
(restore))))
(defn update [boids idx]
(assoc boids idx (stepper (boids idx) boids)))
(defn animate [ctx boids size]
(letfn [(loop [state]
(fn []
(animation-frame (loop (reduce update state rng)))
(render! ctx state size)))]
((loop boids))))
(show canvas)
(animate ctx boids r)rules.cljs
(ns boids.rules
(:require [boids.vector :refer [make-vector rand-vector add sub mult div normalize dist mag limit add-all]]))
(def max-speed 2.0)
(def max-force 0.03)
(def zero-vec (make-vector 0 0))
(defn make-boid [x y]
{:location (make-vector x y)
:velocity (rand-vector 1)
:acceleration (make-vector 0 0)})
(defn- apply-forces [boid forces]
(assoc boid
:acceleration (add
(:acceleration boid)
(add-all forces))))
(defn- diff [location1 location2 dist]
(->
(sub location1 location2)
normalize
(div dist)))
(def separate
"Checks for nearby boids and steers away"
{:init [0 zero-vec]
:too-close? (fn [d] (and (> d 0.0) (< d 25.0)))
:accumulator
(fn [boid other d [count steer]]
[(inc count) (add steer (diff (:location boid) (:location other) d))])
:final
(fn [boid [count steer]]
(cond
(pos? count) (recur boid [0 (div steer count)])
(pos? (mag steer)) (->
steer
normalize
(mult max-speed)
(sub (:velocity boid))
(limit max-force)
(mult 1.5))
:else (mult steer 1.5)))})
(def align
{:init [0 zero-vec]
:too-close? (fn [d] (and (> d 0.0) (< d 50.0)))
:accumulator
(fn [boid other d [count sum]]
[(inc count) (add sum (:velocity other))])
:final
(fn [boid [count sum]]
(if (pos? count)
(->
sum
(div count)
normalize
(mult max-speed)
(sub (:velocity boid))
(limit max-force))
zero-vec))})
(def cohesion
{:init [0 zero-vec]
:too-close? (fn [d] (and (> d 0.0) (< d 50.0)))
:accumulator
(fn [boid other d [count sum]]
[(inc count) (add sum (:location other))])
:final
(fn [boid [count sum]]
(if (pos? count)
(->
sum
(div count)
(sub (:location boid))
normalize
(mult max-speed)
(sub (:velocity boid))
(limit max-force))
zero-vec))})
(defn- calc-forces
[boid peers & forces]
(loop [ps peers
data (map :init forces)]
;(println data)
(if (empty? ps)
(map (fn [f d] ((:final f) boid d)) forces data)
(let [other (first ps)
distance (dist (:location boid) (:location other))]
(recur
(next ps)
(map
(fn [f d]
(if ((:too-close? f) distance)
((:accumulator f) boid other distance d)
d))
forces data))))))
(defn- flock [boid peers]
(apply-forces boid
(calc-forces boid peers
separate
align
cohesion)))
(defn- update-location [boid]
(let [new-velocity (->
(:velocity boid)
(add (:acceleration boid))
(limit max-speed))
new-location (->
(:location boid)
(add new-velocity))]
(assoc boid
:location new-location
:velocity new-velocity
:acceleration zero-vec)))
(defn- bounds [value lower-limit upper-limit]
(cond
(< value lower-limit) upper-limit
(> value upper-limit) lower-limit
:else value))
(defn- wrap-around [boid w h r]
(let [[x y] (:location boid)
new-x (bounds x (- r) (+ w r))
new-y (bounds y (- r) (+ h r))]
(if (and (= x new-x) (= y new-y))
boid
(assoc boid :location (make-vector new-x new-y)))))
(defn step [w h r]
(fn [boid peers]
(->
boid
(flock peers)
(update-location)
(wrap-around w h r))))vector.cljs
(ns boids.vector)
(defn add [[x1 y1] [x2 y2]]
[(+ x1 x2) (+ y1 y2)])
(defn sub [[x1 y1] [x2 y2]]
[(- x1 x2) (- y1 y2)])
(defn mult [[x y] n]
[(* x n) (* y n)])
(defn div [[x y] n]
[(/ x n) (/ y n)])
(defn dot [[x1 y1] [x2 y2]]
(+
(* x1 x2)
(* y1 y2)))
(defn mag-sq [xy]
(dot xy xy))
(defn mag [xy]
(Math/sqrt (mag-sq xy)))
(defn normalize [xy]
(let [m (mag xy)]
(if (and (not= m 0) (not= m 1))
(div xy m)
xy)))
(defn dist [[x1 y1] [x2 y2]]
(let [dx (- x1 x2)
dy (- y1 y2)]
(Math/sqrt
(+
(* dx dx)
(* dy dy)))))
(defn limit [xy max]
(if (> (mag-sq xy) (* max max))
(-> xy normalize (mult max))
xy))
(defn rotate [[x y] theta]
[
(- (* x (Math/cos theta))
(* y (Math/sin theta)))
(+ (* x (Math/sin theta))
(* y (Math/cos theta)))])
(defn heading [[x y]]
(- (Math/atan2 (- y) x)))
(defn rand-vector [n]
(let [theta (* 2 Math/PI (rand))]
[(* n (Math/sin theta)) (* n (Math/cos theta))]))
(defn make-vector [x y]
[x y])
(defn add-all [vectors]
(loop [vs vectors
accum-x 0
accum-y 0]
(if (empty? vs)
[accum-x accum-y]
(let [[x y] (first vs)]
(recur
(rest vs)
(+ accum-x x)
(+ accum-y y))))))