boids-simple.clj

;; boids
;; a Clojure+Processing example
;; 
;; written around Dec 2008/Jan 2009 
;; 
;; The code is in the Public Domain.
;; 
;; based on Flocking example by by Daniel Shiffman
;; (distributed with processing)
;; 
;; Notes on performance: This implementation is based purely on
;; Clojure's data structures and does enough number crunching to make
;; it very slow in comparison to the Java version. I haven't profiled
;; the code, but probably the boxing/unboxing of numbers kill the
;; performance.

(ns p5-boids
  (:use rosado.processing)
  (:import (javax.swing JFrame))
  (:import (processing.core PApplet)))

;(set! *warn-on-reflection* true)

(defn vnorm [[x y]]
  (let [x (float x) y (float y)]
    (Math/sqrt (+ (* x x) (* y y)))))

(defn vnormalize [[x y]]
  (let [x (float x) y (float y) nm (float (vnorm [x y]))]
    [(/ x nm) (/ y nm)]))

(defn vsub
  "Returns the difference of two 2d vectors"
  [[x1 y1] [x2 y2]]
  (let [x1 (float x1) x2 (float x2) y1 (float y1) y2 (float y2)]
    [(- x1 x2) (- y1 y2)]))

(defn vadd
  "Returns the sum of two 2d vectors"
  [[x1 y1] [x2 y2]]
  (let [x1 (float x1) x2 (float x2) y1 (float y1) y2 (float y2)]
    [(+ x1 x2) (+ y1 y2)]))

(defn vmul
  [[x y] s]
  (let [x (float x) y (float y) s (float s)]
    [(* x s) (* y s)]))

(defn vdiv [[x y] s]
  (let [s (float s)]
    (vmul [x y] (/ 1 s))))

(defn vdot
  [[x y] [u v]]
  (let [x (float x) y (float y) u (float u) v (float v)]
    (+ (* x u) (* y v))))

;; world's parameters
(def *width*  500)
(def *height* 500)
(def *num-boids* 50)

(def max-sep   10.0)
(def max-vel  5.0)
(def max-force 0.024)
(def neighbour-dist 30.0)

(def #^{:doc "3 element seq: separation, alignment, coherence."}
     *weights* (list 4.5 2.0 5.0))

;; size of a boid
(def boid-r 3)                          

;; boids hava a [x y] position and [dx dy] velocity
(defstruct boid :pos :v)

(defn make-boid []
  (struct boid
          [(/ *width* 2) (/ *height* 2)]
          [(random -1 1) (random -1 1)]))

(def *boids* (ref (for [i (range *num-boids*)] (make-boid))))

(defn limit [v lim]
  (let [d   (float (vnorm v))
        lim (float lim)]
    (if (< lim d)
      (vmul (vdiv v d) lim)
      v)))

(defn bound-coord [p dim]
  (cond
   (< p 0) dim
   (>= p dim) 0
   :else p))

(defn bound [[x y]]
  [(bound-coord x *width*) (bound-coord y *height*)])

(defn steer
  [bd v]
  (let [desired-dir (vsub v (bd :pos))
        d (float (vnorm desired-dir))]
    (if (< 0 d)
      (let [desired-dir (vnormalize desired-dir)]
        (limit (vsub (vmul desired-dir max-vel)
                     (bd :v)) max-force))
      [0 0])))

(defn- boid-filter [pos d]
  #(< 0 (vnorm (vsub pos (% :pos))) d))

(defmacro make-force
  [name actions]
  `(def ~name
    (fn [bd# others#]
      (let [pos# (bd# :pos)
            num-boids# (int (count others#))
            actions# ~actions]
        (cond
         (= 0 num-boids#) [0 0]
         :else (actions# pos# others# num-boids# bd#))))))

(make-force separate
      (fn [pos fboids num-fboids cboid]
        (let [diffs (map #(vsub pos (% :pos)) fboids)
              ndiffs (for [diff diffs]
                       (let [d (float (vnorm diff))]
                         (vdiv diff (sq d))))
              sum (reduce vadd ndiffs)]
          (vdiv sum num-fboids))))

(make-force align (fn [pos fboids num-fboids cboid]
                    (let [sum (reduce vadd (map #(% :v) fboids))]
                      (limit (vdiv sum num-fboids) max-force))))

(make-force cohere (fn [pos fboids num-fboids cboid]
                     (let [sum (reduce vadd (map #(% :pos) fboids))]
                       (steer cboid (vdiv sum num-fboids)))))

(defn move-boid
  [b acc]
  (let [vel (limit (vadd (b :v) acc) max-vel)
        pos (bound (vadd (b :pos) vel))]
    (-> b (assoc :pos pos) (assoc :v vel))))

(defn weight-forces [a b c]
  (map vmul (list a b c) *weights*))

(defn acceleration
  [sep ali coh]
  (reduce vadd (weight-forces sep ali coh)))

(defn flock [boids-coll]
  (let [num-boids (count boids-coll) boids-coll (cycle boids-coll)]
    (loop [current (first boids-coll)
           boids (next boids-coll)
           others (take (dec num-boids) boids)
           counter (range num-boids)
           updated []
           bfilter (boid-filter (:pos current) max-sep)]
      (if counter
        (let [sep (separate current (filter bfilter others))]
          (let [neighbours (filter (boid-filter (:pos current) neighbour-dist) others)
                ali (align current neighbours)
                coh (cohere current neighbours)]
            (recur (first boids)
                   (next boids)
                   (take (dec num-boids) boids)
                   (next counter)
                   (conj updated (move-boid current (acceleration sep ali coh)))
                   (boid-filter (:pos (first boids)) max-sep))))
        ;else
        updated))))

(defn draw-boids
  "Draw the boids"
  [dst]
  (fill 0)
  (smooth)
  (framerate 25)
  (background-int 124)
  (stroke-float 225 150 0)
  (let [updated-boids (flock @*boids*)]
    (doseq [b updated-boids]
      (let [[x y] (b :pos) [dir-x dir-y] (b :v)]
        (push-matrix)
        (translate x y)
        (rotate (+ HALF_PI (- (atan2 (- dir-y) dir-x))))
        (triangle 0 (* 2 (- boid-r)) (- boid-r) boid-r boid-r boid-r)
        (pop-matrix)))
    (dosync (ref-set *boids* updated-boids))))

;; ------------------------------------------------------------- ;;
(def p5-applet
   (proxy [PApplet] []
     (setup []
        (binding [*applet* this]
        (size *width* *height*)
        (smooth)
        (no-stroke)
        (fill 226)))
     (draw []
       (binding [*applet* this]
         (draw-boids this)))))

(.init p5-applet)

(def swing-frame (JFrame. "Boids in Clojure+Prcessing"))
(doto swing-frame
  (.setDefaultCloseOperation JFrame/EXIT_ON_CLOSE)
  (.setSize *width* *height*)
  (.add p5-applet)
  (.pack)
  (.show))