Skip to content

Instantly share code, notes, and snippets.

@adicirstei
Last active February 24, 2019 19:56
Show Gist options
  • Save adicirstei/c57a8385ea1c8d432f8ce997638c1dd1 to your computer and use it in GitHub Desktop.
Save adicirstei/c57a8385ea1c8d432f8ce997638c1dd1 to your computer and use it in GitHub Desktop.
Paper.js [boids example](http://paperjs.org/examples/tadpoles/)
(ns gen-art.boids
(:require [clojure2d.core :refer :all]
[fastmath.core :as m]
[fastmath.random :as r]
[fastmath.fields :as f]
[fastmath.vector :as v]
[clojure2d.color :as c]
[clojure2d.pixels :as p])
(:import [fastmath.vector Vec2]))
(set! *warn-on-reflection* true)
(set! *unchecked-math* :warn-on-boxed)
(m/use-primitive-operators)
(def ^:const ^double w 1000)
(def ^:const ^double h 600)
(defn mk-boid [^Vec2 position ^double max-speed ^double max-force]
(let [strength (r/drand 0 0.5)
amount (+ (* strength 10) 10)]
{:acceleration (v/vec2 0 0)
:vector (v/vec2 (r/drand -1 1) (r/drand -1 1))
:position position
:radius 30
:max-speed (+ max-speed strength)
:max-force (+ max-force strength)
:amount amount
:count 0
:head {:size [13 8]}
:path (mapv (fn [_] (v/vec2 0 0)) (range amount) )
:short-path (mapv (fn [_] (v/vec2 0 0)) (range (m/min 3 amount)))
}))
(defn steer [this ^Vec2 target slowdown]
(let [desired (v/sub target (:position this))
^double distance (v/mag desired)
dl (if (and slowdown (< distance 100))
(* ^double (:max-speed this) (/ distance 100))
(:max-speed this))
steer-v (v/sub (v/set-mag desired dl) (:vector this))]
(v/set-mag steer-v (m/min ^double (:max-force this) ^double (v/mag steer-v)))))
(defn seek [{ acc :acceleration :as this} ^Vec2 target]
(update this :acceleration (partial v/add (steer this target false))))
(defn arrive [{ acc :acceleration :as this} ^Vec2 target]
(update this :acceleration (partial v/add (steer this target true))))
(defn align [this boids]
(let [nd 25
[s ^double c] (reduce (fn [[^Vec2 ste ^double cnt] b]
(let [^double dst (v/dist (:position this) (:position b))]
(if (and (> dst 0) (< dst nd) )
[(v/add ste (:vector b)) (inc cnt)]
[ste cnt]))) [(v/vec2 0 0) 0] boids)
s' (if (> c 0) (v/div s c) s)]
(if (not= 0 (v/mag s'))
(let [sl (v/set-mag s' (:max-speed this))
sv (v/sub sl (:vector this))]
(v/set-mag sv (m/min ^double (v/mag sv) ^double (:max-force this))))
s')))
(defn cohesion [this boids]
(let [nd 100
[^Vec2 s ^double c] (reduce (fn [[ste ^double cnt] b]
(let [^double dst (v/dist (:position this) (:position b))]
(if (and (> dst 0) (< dst nd) )
[(v/add ste (:position b)) (inc cnt)]
[ste cnt]))) [(v/vec2 0 0) 0] boids)]
(if (> c 0)
(steer this (v/div s c) false)
s)))
(defn separate [this boids]
(let [des-sep 60
[s ^double c] (reduce (fn [[^Vec2 ste ^double cnt] b]
(let [vect (v/sub (:position this) (:position b))
^double dst (v/mag vect)]
(if (and (> dst 0) (< dst des-sep))
[(v/add ste (v/mult (v/normalize vect) (/ 1.0 dst))) (inc cnt)]
[ste cnt]))) [(v/vec2 0 0) 0] boids)
s' (if (> c 0) (v/div s c) s)]
(if (not= 0 (v/mag s'))
(let [sl (v/set-mag s' (:max-speed this))
sv (v/sub sl (:vector this))]
(v/limit sv ^double (:max-force this)))
s')))
(defn flock [this boids]
(let [s (v/mult (separate this boids) 0.6)
a (align this boids)
c (cohesion this boids)]
; (println s)
(assoc this :acceleration (v/add (:acceleration this) (v/add s (v/add a c))))) )
(defn update-boid [{:keys [vector position acceleration max-speed] :as b}]
(let [speed (v/add vector acceleration)
vec (v/limit speed max-speed)]
(assoc b :vector vec :position (v/add position vec) :acceleration (v/vec2 0 0))))
(defn draw-head [cvs {:keys [head] :as b}]
(let [ang (v/heading (:vector b))
[x y] (:position b)
[ew eh] (:size head)]
(with-canvas-> cvs
(push-matrix)
(translate x y)
(rotate ang)
(ellipse 0 0 ew eh)
(pop-matrix)))
b)
(defn initial-state []
(let [boids (for [i (range 30)]
(let [p (v/vec2 (r/drand w) (r/drand h))]
(mk-boid p 10 0.05)))]
{:boids (vec boids)
:group false}))
(defn borders [{:keys [position ^double radius] :as boid}]
(let [[^double px ^double py] position
vv
(->> [0 0]
((fn [[x y]] [(if (< (+ px radius) 0) (+ w radius) x) y]))
((fn [[x y]] [x (if (< (+ py radius) 0) (+ h radius) y)]))
((fn [[x y]] [(if (> px (+ w radius)) (+ (- w) (- radius)) x) y])) ((fn [[x y]] [x (if (> py (+ h radius)) (+ (- h) (- radius)) y)]))
(apply v/vec2 ))]
(if (not= (v/mag vv) 0)
(assoc boid :position (v/add position vv)) ;; should also update the tail
boid)))
(defn calc-tail [cvs this]
(let [speed (v/mag (:vector this))
pl (+ 5 (/ speed 3.0))
[seg ss c] (loop [point (:position this)
last-vec (v/mult (:vector this) -1)
seg (assoc (:path this) 0 point)
s-seg (assoc (:short-path this) 0 point)
cnt (:count this)
i 1]
(if (< i (:amount this))
(let [vect (v/sub (nth seg i) point)
c (+ cnt (* speed 10))
wave (m/sin (/ (+ c (* i 3)) 3000))
sway (v/mult (v/normalize (v/rotate last-vec m/HALF_PI)) wave)
p (v/add point (v/add (v/mult (v/normalize last-vec) pl) sway))]
(recur p vect (assoc seg i p) (if (< i 3) (assoc s-seg i p) s-seg) c (inc i)))
[seg s-seg cnt]))]
(set-stroke cvs 4)
(path cvs ss)
(set-stroke cvs 2)
(path cvs seg)
(assoc this :path seg :short-path ss :count c)
) )
(defn run-boids [canvas boid {:keys [group boids] :as state}]
(let [b (assoc boid :last-loc (:position boid))]
(->> b
((fn [b] (if group
(align b boids)
(flock b boids))))
(borders)
(update-boid)
(calc-tail canvas)
(draw-head canvas ))))
(re-seq #"([MLCZz])\s*(((([0-9\.\-]+)\,?){2}\s*){0,3})" "M514.69629,624.70313c-7.10205,-27.02441 -17.2373,-52.39453 -30.40576,-76.10059c-13.17383,-23.70703 -38.65137,-60.52246 -76.44434,-110.45801c-27.71631,-36.64355 -44.78174,-59.89355 -51.19189,-69.74414c-10.5376,-16.02979 -18.15527,-30.74951 -22.84717,-44.14893c-4.69727,-13.39893 -7.04297,-26.97021 -7.04297,-40.71289c0,-25.42432 8.47119,-46.72559 25.42383,-63.90381c16.94775,-17.17871 37.90527,-25.76758 62.87354,-25.76758c25.19287,0 47.06885,8.93262 65.62158,26.79834c13.96826,13.28662 25.30615,33.10059 34.01318,59.4375c7.55859,-25.88037 18.20898,-45.57666 31.95215,-59.09424c19.00879,-18.32178 40.99707,-27.48535 65.96484,-27.48535c24.7373,0 45.69531,8.53564 62.87305,25.5957c17.17871,17.06592 25.76855,37.39551 25.76855,60.98389c0,20.61377 -5.04102,42.08691 -15.11719,64.41895c-10.08203,22.33203 -29.54687,51.59521 -58.40723,87.78271c-37.56738,47.41211 -64.93457,86.35352 -82.11328,116.8125c-13.51758,24.0498 -23.82422,49.24902 -30.9209,75.58594z")
(initial-state)
(let [canvas (canvas w h :high)
draw (fn [cvs wnd _ {:keys [boids] :as state}]
(set-background cvs 0 0 0)
(set-awt-color cvs java.awt.Color/WHITE)
(assoc state :boids (mapv #(run-boids cvs % state) boids)))
wnd (show-window {:canvas canvas
:draw-fn draw
:draw-state (initial-state)})]
canvas)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment