Quil/ClojureScript sketch showing the intersection of wandering circles

circles.cljs

(ns quil-js.circles
  (:require [quil.core :as q :include-macros true]
            [quil.middleware :as m]))


(deftype Circle [x y radius x-move y-move line-color fill-color alpha])


(defn draw-circle [circle]
  ; (.log js/console (str "Drawing " x "," y " with " overlap))
  (q/no-stroke)
  (q/fill (.-fill-color circle) (.-alpha circle))
  (q/ellipse (.-x circle) (.-y circle) (* (.-radius circle) 2) (* (.-radius circle) 2))
  (q/stroke (.line-color circle) 150)
  (q/ellipse (.-x circle) (.-y circle) 10 10))


(defn random-circle
  "Return a random circle"
  ([]
   (random-circle (q/random (q/width)) (q/random (q/height))))
  ([x y]
   (->Circle
    x y (+ (q/random 100) 10)
    (- (q/random 4) 2) (- (q/random 4) 2)
    (q/color (q/random 255) (q/random 255) (q/random 255))
    (q/color (q/random 255) (q/random 255) (q/random 255))
    (q/random 255))))


(defn circle-overlap-distance
  "Calculates the overlap distance between two circles. If negative, they overlap"
  [circle1 circle2]
  (let [x1 (.-x circle1)
        y1 (.-y circle1)
        radius1 (.-radius circle1)
        x2 (.-x circle2)
        y2 (.-y circle2)
        radius2 (.-radius circle2)
        distance (q/dist x1 y1 x2 y2)
        radii (+ radius1 radius2)]
    (if (and ; Are they the same circle?
         (== x1 x2)
         (== y1 y2)
         (== radius1 radius2))
      0
      (- distance radii))))

(defn circles-overlap? [circle1 circle2]
  (< (circle-overlap-distance circle1 circle2) 0))


(defn mid-point
  "Calculates the mid point between two coordinates"
  [circle1 circle2]
  (let [x1 (.-x circle1)
        y1 (.-y circle1)
        x2 (.-x circle2)
        y2 (.-y circle2)]
  {:x (/ (+ x1 x2) 2)
   :y (/ (+ y1 y2) 2)}))


(defn calculate-circle-overlaps
  "Returns a list of maps with the overlap amount for each circle, only for those where they overlap"
  [circle circle-list]
  (->>
   (map (defn f [c] {:overlap-amount (circle-overlap-distance circle c) :mid-point (mid-point circle c)}) circle-list)
   (filter #(< (:overlap-amount %) 0))))


(defn calculate-overlaps [circle-list]
  (loop [circle (first circle-list)
         others (rest circle-list)
         acc []]
    (if (or (nil? circle) (empty? circle-list))
      acc
      (recur (first others)
             (rest others)
             (conj acc (calculate-circle-overlaps circle (rest others)))))))


(defn overlaps-any? [circle circle-list]
  (some #(circles-overlap? circle %) circle-list))

(defn set-overlap [circle circle-list]
  (let [overlap (overlaps-any? circle circle-list)]
    (assoc circle :overlap overlap)))


(defn update-circle-position
  "Updates a circle's position"
  [circle]
  (let [x-move (.-x-move circle)
        y-move (.-y-move circle)
        x (.-x circle)
        y (.-y circle)
        radius (.-radius circle)
        new-x (+ x x-move)
        new-y (+ y y-move)]
    (cond
     (> new-x (+ radius (q/width))) (->Circle (- radius) new-y radius x-move y-move (.-line-color circle) (.-fill-color circle) (.-alpha circle))
     (< new-x (- radius)) (->Circle (+ (q/width) radius) new-y radius x-move y-move (.-line-color circle) (.-fill-color circle) (.-alpha circle))
     (> new-y (+ radius (q/height))) (->Circle new-x (- radius) radius x-move y-move (.-line-color circle) (.-fill-color circle) (.-alpha circle))
     (< new-y (- radius)) (->Circle new-x (+ (q/height) radius) radius x-move y-move (.-line-color circle) (.-fill-color circle) (.-alpha circle))
     :else (->Circle new-x new-y radius x-move y-move (.-line-color circle) (.-fill-color circle) (.-alpha circle)))))


(defn draw-circles
  ([]
   (dotimes [n 5]
     (draw-circle (random-circle))))
  ([circles]
   (doseq [circle circles] (draw-circle circle))))

(defn draw-midpoint [{overlap :overlap-amount {x :x y :y} :mid-point}]
  (q/stroke 0 10)
  (q/no-fill)
  (q/ellipse x y (- overlap) (- overlap)))


(defn draw-midpoints [midpoints]
  (doseq [midpoint midpoints] (draw-midpoint midpoint)))


(defn mouse-clicked [state event]
  (assoc state :circles (conj (random-circle (:x event) (:y event)) (:circles state))))


(defn setup []
  (q/background 240)
  (q/frame-rate 30)
  (q/smooth)
  (q/stroke-weight 1)
  (q/fill 150 50)
  {:circles (take 100 (repeatedly random-circle))})


(defn update-with-midpoints [state]
  (let [circles (:circles state)]
    (assoc state :circles (map update-circle-position circles)
                 :midpoints (->> (calculate-overlaps circles)
                                 (flatten)))))


(defn draw-wandering-midpoints [{midpoints :midpoints}]
  (q/no-stroke)
  (q/fill 240 2)
  (q/rect 0 0 (q/width) (q/height))
  (draw-midpoints midpoints))


(q/defsketch hello-quil
  :title "Concentric"
  :size [512 384]
  :host "random_circles"     ;; the id of the <canvas> element
  ; setup function called only once, during sketch initialization.
  :setup setup
  :update update-with-midpoints
  :draw draw-wandering-midpoints
  :mouse-clicked mouse-clicked
  ; This sketch uses functional-mode middleware.
  ; Check quil wiki for more info about middlewares and particularly
  ; fun-mode.
  :middleware [m/fun-mode])