Tarbell's Happy Place made with Clojure2D

happy-place.clj

(ns happy-place
  (:require [clojure2d.core :refer :all]
            [clojure2d.color :as c]
            [fastmath.random :as r]
            [fastmath.core :as m]
            [fastmath.vector :as v]))


(def dim 900)
(def agents 128)


(def pairs (filter (fn [[a b]] (not= a b )) (repeatedly 1000 (fn [] [(r/irand agents) (r/irand agents)]))))

(defn c-of [n]
  (->> pairs
       (filter (fn [[a b]] (or (= a n) (= b n) )))
       (map (fn [[a b]] (if (= a n) b a)))

       (take 8)
       (distinct)
       (vec)
       ))

(def pal (rand-nth c/colourlovers-palettes))

(defrecord SandPainter [p c g])
(defrecord Friend [id p v c snds cns lencon])

(defn sand [cvs {:keys [c g p] :as s} x y ox oy]
  (set-color cvs c 28)
  (point cvs (+ ox (* (m/sin p) (- x ox))) (+ oy (* (m/sin p) (- y oy))))

  (let [g' (m/constrain (+ g (r/drand -0.05 0.05) )  -0.22 0.22)
        w (* 0.1 g')]
    (dotimes [i 11]
      (let [a (- 0.1 (/ i 110.0))]
        (set-color cvs c (* a 256))
        (point cvs (+ ox (* (m/sin (+ p (m/sin (* i w)))) (- x ox))) (+ oy (* (m/sin (+ p (m/sin (* i w)))) (- y oy))) )
        (point cvs (+ ox (* (m/sin (- p (m/sin (* i w)))) (- x ox))) (+ oy (* (m/sin (- p (m/sin (* i w)))) (- y oy))) )))
    (assoc s :g g')))
        

(defn move [frs]
  (mapv (fn [{:keys [p v] :as f }]  (assoc f :p (v/add p v) :v (v/mult v 0.9)))  frs))




(defn happy-place [frs]
  (mapv (fn [{:keys [p v lencon id cns] :as f }]
          (loop [n 0
                 ac (v/vec2 0 0)]
            (if (>= n agents)
              (assoc f :v (v/add v (v/mult ac 0.0236854571293226)))   
              (let [o (frs n)
                    d (v/dist p (:p o))
                    t (v/heading (v/sub  (:p o) p))
                    fr? (some #(= n %1)  cns)   ]
                (cond
                  (= id n)(recur (inc n) ac)

                  (and fr? (> d lencon)) (recur (inc n) (v/add ac (v/from-polar (v/vec2 3.0 t))))
                  (and (not fr?) (< d lencon)) (recur (inc n) (v/add ac (v/from-polar (v/vec2 (- lencon d)   (+ t m/PI)))))
                  :else (recur (inc n) ac)))))




          )  frs))





(defn expose-m [cvs frs]
  (mapv (fn [{[x y] :p snds :snds :as f}]
          (doseq [dx (range -2 3)]
            (let [a (- 0.5 (/ (m/abs dx) 5.0))]

              (set-color cvs :black (* a 256.0))
              (point cvs (+ x dx) y)
              (set-color cvs :white (* a 256.0))
              (point cvs (+ x dx -1) (- y 1))))
          (doseq [dy (range -2 3)]
            (let [a (- 0.5 (/ (m/abs dy) 5.0))]

              (set-color cvs :black (* a 256.0))
              (point cvs x (+ y dy))
              (set-color cvs :white (* a 256.0))
              (point cvs (+ x -1) (+ y dy -1))))

          
          (assoc f :snds (reduce (fn [acc of]
                                   (let [op (:p (frs of))]

                                     (mapv #(sand cvs %1 x y (.x op) (.y op)) acc))) snds (:cns f))) ) frs))




(defn mk-sand []
  (SandPainter. (r/drand) (rand-nth pal) (r/drand 0.01 0.1)))
  
(defn draw [cvs wnd time friends]
  (->> friends
      (move)
      (expose-m cvs)
     ; (expose-connections cvs)
      ((fn [frs]
         (if (even? time)
           (happy-place frs)
           frs)))))
      


(defn mk-friends []
  (mapv #(Friend. %1 (v/vec2 (+ (* 0.5 dim) (* 0.4 dim (m/cos (* m/TWO_PI (/ %1 agents) )))) (+ (* 0.5 dim) (* 0.4 dim (m/sin (* m/TWO_PI (/ %1 agents) ))))) (v/vec2 0.0 0.0) (rand-nth pal) [(mk-sand) (mk-sand) (mk-sand)] (c-of %1) (r/irand 10 60)  ) (range agents))) 


(with-canvas [c (canvas dim dim)]
  (set-background c :white )
  (show-window {:canvas c :window-name  "Happy Place" :draw-fn draw :draw-state (mk-friends)})
  (defmethod key-pressed ["Happy Place" \space] [_ _]
    (save c (next-filename "results/happy-place/" ".jpg"))))