circle-packing.clj

(ns geometer.circle-packing
  (:require [quil.core :as q]
            [quil.middleware :as m]
            [geometer.solarized :as s]))

(def width 500)
(def height 500)
(def focus {:x (* (rand) width)
            :y (* (rand) height)})
(def max-r (* 0.2 (min width height)))
(def min-r (* 0.5 max-r))

(defn far-away? [circle other-circle]
  (>= (Math/sqrt (+ (Math/pow (- (:x circle) (:x other-circle)) 2)
                    (Math/pow (- (:y circle) (:y other-circle)) 2)))
      (+ (:r circle) (:r other-circle))))

(defn is-valid? [circle circles]
  (and (< (+ (:x circle) (:r circle)) width)
       (< (+ (:y circle) (:r circle)) height)
       (> (- (:x circle) (:r circle)) 0)
       (> (- (:y circle) (:r circle)) 0)
       (< (:r circle) max-r)
       (every? (partial far-away? circle) circles)))
  
(defn setup []
  (q/frame-rate 15)
  (q/color-mode :hsb 360 100 100 1.0)
  (let [[b-h b-s b-b] (:hsb (s/named :base03)) ; :base03 is a color from the Solarized palette
        [s-h s-s s-b] (:hsb (s/named :base3))] ; as is :base3 
    (q/background b-h b-s b-b)
    (q/stroke s-h s-s s-b))
                                        ; Give an initial circle, randomly chosen, with a radius of min-r
  {:circle {:x (+ (rand-int (- width min-r)) min-r)
            :y (+ (rand-int (- height min-r)) min-r)
            :r min-r}
   :circles (vector)})

(defn update [state]
  (loop [circle {:x (* (rand) width) :y (* (rand) height) :r 1}
         circles (:circles state)]
    (if (not (is-valid? circle circles))
      (do
        {:circle circle
         :circles (conj circles circle)}) ; Hand back our circle to be drawn
      (recur {:x (:x circle) :y (:y circle) :r (inc (:r circle))} circles))))

(defn draw [state]
  (let [circle (:circle state)]
    (q/fill (:hsb (s/named :base03)))
    (q/ellipse (:x circle) (:y circle) (* 2 (:r circle)) (* 2 (:r circle)))))

(q/defsketch circle-packing
  :title "Packing circles"
  :size [width height]
  :setup setup
  :settings #(q/smooth 4)
  :update update
  :draw draw
  :features [:keep-on-top]
  :middleware [m/fun-mode])