gistfile1.clj

;; mutable boids
;; a Clojure+Processing example
;; 
;; written around July/August 2009 
;; 
;; The code is in the Public Domain.
;; 
;; based on Flocking example by by Daniel Shiffman
;; (distributed with processing)
;; 
;; this version is a more performant version of
;; http://gist.github.com/87880

(ns rosado.processing.examples.mutable-boids
  (:use rosado.processing)
  (:use rosado.genstruct)
  (:import (javax.swing JFrame))
  (:import (processing.core PApplet PVector)
           (rosado.processing.examples boid)))

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

(gen-struct
 :name rosado.processing.examples.boid
 :mutable-fields [[processing.core.PVector v]
                  [processing.core.PVector pos]]
 :final-fields [[static float R :is 5.0]])

(defmacro set-v! [bd v]
  `(set! (.v #^boid ~bd) ~v))

(defmacro set-pos! [bd pos]
  `(set! (.pos #^boid ~bd) ~pos))

(defn vnorm [#^PVector v]
  (let [z (PVector. (float 0) (float 0))]
    (.dist v z)))

(defn vnormalize [#^PVector v]
  (.normalize v)
  v)

(defn vsub
  "Returns the difference of two 2d vectors"
  [#^PVector v #^PVector u]
  (PVector/sub v u))

(defn vadd
  "Returns the sum of two 2d vectors"
  [#^PVector v #^PVector u]
  (PVector/add v u))

(defn vmul
  [#^PVector v s]
  (PVector/mult v (float s)))

(defn vdiv [#^PVector v s]
  (PVector/div v (float s)))

(defn vdot
  [#^PVector v #^PVector u]
  (.dot v u))

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

(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

(defn make-boid []
  (let [bd (rosado.processing.examples.boid.)]
    (set-v! bd (PVector. (random -1 1) (random -1 1)))
    (set-pos! bd (PVector. (/ *width* 2) (/ *height* 2)))
    bd))

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

(defn limit [#^PVector 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 [#^PVector v]
  (.set v (bound-coord (.x v) (float *width*))
        (bound-coord (.y v) *height*)
        (float 0.0))
  v)

(defn steer
  [#^boid bd #^PVector v]
  (let [#^PVector desired-dir (vsub v (.pos bd))
        d (float (vnorm desired-dir))]
    (if (< 0 d)
      (let [desired-dir (vnormalize desired-dir)]
        (limit (vsub (vmul desired-dir max-vel)
                     (.v bd))
               max-force))
      (PVector. (float 0.0) (float 0.0)))))

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

(defmacro make-force
  [name actions]
  `(def ~name
    (fn [bd# others#]
      (let [pos# (.pos bd#)
            num-boids# (int (count others#))
            actions# ~actions]
        ;; (println "====" (str ~name) "====")
        (cond
         (= 0 num-boids#) (PVector. (float 0.0) (float 0.0))
         :else (actions# pos# others# num-boids# bd#))))))

(make-force separate
      (fn [#^PVector pos fboids num-fboids #^boid cboid]
        (let [diffs (map (fn [#^boid bd] (vsub pos (.pos bd))) 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 [#^PVector pos fboids num-fboids #^boid 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
  [#^boid b acc]
  (let [#^PVector vel (limit (vadd (.v b) acc) max-vel)
        #^PVector pos (bound (vadd (.pos b) vel))]
    (set-v! b vel)
    (set-pos! b pos)
    b))

(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 [#^boid 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*)
        boid-r (float (rosado.processing.examples.boid/R))]
    (doseq [#^boid b updated-boids]
      (let [#^PVector pos (.pos b) v (.v b)]
        (push-matrix)
        (translate (.x pos) (.y pos))
        (rotate (+ HALF_PI (- (atan2 (- (.y v)) (.x v)))))
        (triangle 0 (* 2 (- boid-r)) (- boid-r) boid-r boid-r boid-r)
        (pop-matrix)))))

;; ------------------------------------------------------------- ;;

(def p5-applet (proxy [PApplet] []
                    (setup []
                           (binding [*applet* this]
                             (size *width* *height*)
                             (smooth)
                             (no-stroke)
                             (fill 226)
                             (framerate 10)))
                    (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))