Heart

heart.cljs

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

(set! *print-length* 10)

(defn rotate-x [theta x y]
  (- (* x (Math/cos theta))
     (* y (Math/sin theta))))

(defn rotate-y [theta x y]
  (+ (* x (Math/sin theta))
     (* y (Math/cos theta))))

(defn cardioid [s t]
  (let [x (* s (- (* 2 (Math/cos t)) (Math/cos (* 2 t))))
        y (* s (- (* 2 (Math/sin t)) (Math/sin (* 2 t))))
        theta (- (/ (.-PI js/Math) 2))
        j (rotate-x theta x y)
        k (rotate-y theta x y)]
    [j k]))

(defn heart [s t]
  (let [x (* s (* 16 (Math/pow (Math/sin t) 3)))
        y (* s (- (* 13 (Math/cos t))
                  (* 5 (Math/cos (* 2 t)))
                  (* 2 (Math/cos (* 3 t)))
                  (Math/cos (* 4 t))))
        theta  (.-PI js/Math)
        j (rotate-x theta x y)
        k (rotate-y theta x y)]
    [j k]))

(declare contraction)

(defn setup []
  (q/frame-rate 30)
  {:points (mapv (partial heart (/ (q/height) 40)) (range 0 10 0.1))
   :scaling-function contraction
   :counter 7})

(defn draw [state]
  (q/background 0)
  (q/fill 255 0 0)
  (q/with-translation [(/ (q/width) 2) (/ (q/height) 2)]
    (q/begin-shape)
    (doseq [p (:points state)]
      (apply q/curve-vertex p))
    (q/end-shape))
  #_(q/text (str "Points" (first (:points state))
               "\nCounter:" (:counter state)
               "\nScaling Function" (:scaling-function state)) 20 20))

(defn contraction [[x y]]
  [(* x 0.99)
   (* y 0.99)])

(defn distention [[x y]]
  [(/ x 0.99)
   (/ y 0.99)])

(defn select [f]
  (condp = f
    contraction distention
    distention contraction))

(defn beat [state]
  (if (zero? (:counter state))
    (-> state
        (update :counter (fn [] 7))
        (update :scaling-function #(select %)))
    (-> state
        (update :counter #(dec %))
        (update :points #(mapv (:scaling-function state) %)))))

(defn init []
  (let [canvas (. js/document (getElementById "heart"))
        _ (set! (.-width canvas) (.-innerWidth js/window))
        width (.-width canvas)
        _ (set! (.-height canvas) (.-innerHeight js/window))
        height (.-height canvas)]
   (q/sketch
    :setup setup
    :draw draw
    :update beat
    :host "heart"
    :size [width height]
    :middleware [m/fun-mode])))