|
(ns big-bang.examples.sutcliffe-pentagon |
|
(:require |
|
[jayq.core :refer [show]] |
|
[cljs.core.async :as async] |
|
[dommy.core :refer [insert-after!]] |
|
[big-bang.core :refer [big-bang]] |
|
[big-bang.components :refer [slider]] |
|
[enchilada :refer [ctx canvas value-of]] |
|
[monet.canvas :refer [begin-path move-to line-to close-path |
|
clear-rect fill fill-style circle |
|
stroke-join stroke-width stroke-style stroke |
|
translate rotate save restore]]) |
|
(:require-macros |
|
[dommy.macros :refer [sel1 node]])) |
|
|
|
(defn box [content] |
|
[:span {:style "width: 250px; |
|
display: inline-block; |
|
border: 1px solid lightgrey; |
|
margin-right: 5px; |
|
margin-bottom: 5px; |
|
padding-left: 5px; |
|
border-radius: 3px; |
|
background: whitesmoke;"} content]) |
|
|
|
(defn radians [degrees] |
|
(/ (* (double degrees) Math/PI) 180.0)) |
|
|
|
(defn average [m n] |
|
(/ (+ m n) 2)) |
|
|
|
(defn calc-mid-points [ops] |
|
(let [n (count ops) |
|
midpoint (fn [[ax ay] [bx by]] [(average ax bx) (average ay by)])] |
|
(vec |
|
(for [i (range n)] |
|
(midpoint |
|
(nth ops i) |
|
(nth ops (mod (inc i) n))))))) |
|
|
|
(defn calc-proj-point [strut-factor] |
|
(fn [[mpx mpy] [opx opy]] |
|
[ (+ mpx (* (- opx mpx) strut-factor)) |
|
(+ mpy (* (- opy mpy) strut-factor))])) |
|
|
|
(defn calc-strut-points [projection-fn sides mps ops] |
|
(let [n (count mps)] |
|
(vec |
|
(for [i (range n)] |
|
(projection-fn |
|
(nth mps i) |
|
(nth ops (mod (+ i sides -2) n))))))) |
|
|
|
(defn branch [projection-fn level sides ops] |
|
(let [mps (calc-mid-points ops) |
|
pps (calc-strut-points projection-fn sides mps ops) |
|
ret {:outer-points ops :level level} |
|
n (count ops)] |
|
(if (zero? level) |
|
ret |
|
(assoc |
|
ret |
|
:branches |
|
(cons |
|
(branch projection-fn (dec level) sides pps) |
|
(for [k (range n) |
|
:let [next-k (mod (+ k (dec sides)) n) |
|
new-points [(nth ops k) (nth mps k) (nth pps k) (nth pps next-k) (nth mps next-k)]]] |
|
(branch projection-fn (dec level) sides new-points))))))) |
|
|
|
(defn root [size strut-factor max-level sides angle] |
|
(let [pt (fn [f i] (* size (f (radians i)))) |
|
step (/ (double angle) (double sides)) |
|
ops (mapv #(vector (pt Math/cos %) (pt Math/sin %)) (range 0 360 step)) |
|
pfn (calc-proj-point strut-factor)] |
|
(branch pfn max-level sides ops))) |
|
|
|
(defn draw [ctx {:keys [level outer-points branches]}] |
|
(-> |
|
ctx |
|
(begin-path) |
|
(stroke-width level) |
|
(move-to (ffirst outer-points) (fnext outer-points))) |
|
|
|
(doseq [[x y] outer-points] |
|
(line-to ctx x y)) |
|
|
|
(-> |
|
ctx |
|
(close-path) |
|
(stroke) |
|
(fill)) |
|
|
|
(doseq [b branches] |
|
(draw ctx b)) |
|
|
|
ctx) |
|
|
|
|
|
(defn initial-state [angle sides strut max-level radius] |
|
{ :strut strut |
|
:sides sides |
|
:angle angle |
|
:max-level max-level |
|
:radius radius}) |
|
|
|
(defn handle-incoming [event world-state] |
|
(merge world-state event)) |
|
|
|
(defn render [{:keys [angle sides strut max-level radius] :as world-state}] |
|
(let [sutcliffe-pentagon (root radius strut max-level sides angle)] |
|
(-> |
|
ctx |
|
(clear-rect {:x 0 :y 0 :w 800 :h 600}) |
|
(save) |
|
(translate 400 300) |
|
(fill-style "rgba(229,125,141,0.2)") |
|
(stroke-style :black) |
|
(stroke-join :miter) |
|
(draw sutcliffe-pentagon) |
|
(restore)))) |
|
|
|
(let [chan (async/chan) |
|
initial-state (initial-state |
|
(js/parseInt (value-of :angle 360.0)) |
|
(js/parseInt (value-of :sides 5)) |
|
(js/parseFloat (value-of :strut 0.271)) |
|
(js/parseInt (value-of :levels 4)) |
|
(js/parseInt (value-of :radius 280)))] |
|
(show canvas) |
|
(->> |
|
(sel1 :#canvas-area) |
|
(insert-after! |
|
(node |
|
[:div |
|
(box (slider |
|
:id :sides |
|
:label-text "Sides:" |
|
:min-value 3 |
|
:max-value 16 |
|
:initial-value (initial-state :sides) |
|
:send-channel chan)) |
|
(box (slider |
|
:id :angle |
|
:label-text "Angle:" |
|
:min-value 1 |
|
:max-value 1024 |
|
:initial-value (initial-state :angle) |
|
:send-channel chan)) |
|
(box (slider |
|
:id :strut |
|
:label-text "Strut:" |
|
:min-value -2.0 |
|
:max-value 1.0 |
|
:step 0.01 |
|
:initial-value (initial-state :strut) |
|
:send-channel chan))]))) |
|
|
|
(big-bang |
|
:initial-state initial-state |
|
:on-receive handle-incoming |
|
:receive-channel chan |
|
:to-draw render)) |