mandelbrot.cljs
(ns webrot.fractal
(:require-macros
[cljs.core.async.macros :refer [go]]
[dommy.macros :refer [sel1 node]])
(:require
[clojure.string :as str]
[cljs.core.async :refer [chan <! >!]]
[dommy.core :refer [insert-after!]]
[jayq.core :refer [$ hide show]]
[big-bang.core :refer [big-bang]]
[big-bang.components :refer [dropdown]]
[big-bang.events.browser :refer [offset-coords button prevent-default]]
[enchilada :refer [ctx canvas canvas-size]]
[monet.canvas :refer [fill-rect clear-rect fill-style]]
[inkspot.color-chart :as cc]
[webrot.zoom :as z]))
(def width (first (canvas-size)))
(def height (second (canvas-size)))
(def screen (z/to-bounds [0 width height 0]))
(defn julia-set
([c] (julia-set [1 1.5 -1 -1.5] c))
([bounds c]
{ :bounds (z/to-bounds bounds)
:start-fn (fn [x y] [x y])
:c-fn (fn [x y] c) }))
(defn mandlebrot-set
([] (mandlebrot-set [1 0.5 -1 -2]))
([bounds]
{ :bounds (z/to-bounds bounds)
:start-fn (fn [x y] [0 0])
:c-fn (fn [x y] [x y]) }))
(defn- compute [[z-re z-im] [c-re c-im] cut-off]
(loop [counter 0
z-re z-re
z-im z-im]
(let [pow2-re (* z-re z-re)
pow2-im (* z-im z-im)]
(cond
(>= counter cut-off) nil ; Mandlebrot lake
(> (+ pow2-re pow2-im) 4) counter ; |z| > 2, bail out
:else (recur
(inc counter)
(+ (- pow2-re pow2-im) c-re)
(+ (* 2 z-re z-im) c-im))))))
(defn- gen-offsets [img-n offset step bounds-n bounds-start]
(let [rng (range offset img-n step)
delta (double (/ bounds-n img-n))]
(map #(list % (+ bounds-start (* delta %))) rng)))
(defn get-color [lut]
(let [n (count lut)]
(fn [idx]
(if (nil? idx)
:black
(nth lut (mod idx n))))))
(defn fractal [ctx [w h] [offset-x offset-y fill-w fill-h] fractal-set cut-off color-map]
(let [bounds (:bounds fractal-set)
c-fn (:c-fn fractal-set)
start-fn (:start-fn fractal-set)
lut (get-color color-map)
xs (gen-offsets w offset-x 4 (z/width bounds) (:left bounds))
ys (gen-offsets h offset-y 4 (z/height bounds) (:bottom bounds))]
(doseq [[ay by] ys
[ax bx] xs
:let [z (start-fn bx by)
c (c-fn bx by)
result (compute z c cut-off)]]
(->
ctx
(fill-style (lut result))
(fill-rect {:x ax :y ay :w fill-w :h fill-h})))
ctx))
(def available-luts
{"cube-helix" (vec (cc/cube-helix 48))
"rainbow" (vec (cc/rainbow 48))
"spectrum" (vec (cc/spectrum 48))
"heatmap" (vec (cc/heatmap 48))})
(defn to-keyword> [key dest-chan]
(let [src-chan (chan 1)]
(go
(loop []
(when-let [msg (<! src-chan)]
(>! dest-chan (update-in msg [key] str))
(recur))))
src-chan))
(def steps [
[0 0 4 4]
[0 2 2 2]
[2 0 2 2]
[2 2 2 2]
[0 1 1 1]
[1 0 1 1]
[1 1 1 1]
[0 3 1 1]
[1 2 1 1]
[1 3 1 1]
[3 0 1 1]
[2 1 1 1]
[3 1 1 1]
[2 3 1 1]
[3 2 1 1]
[3 3 1 1]])
(def initial-state {
:fractal-set (mandlebrot-set)
:color-map "spectrum"
:cut-off 50
:canvas-size (canvas-size)
:steps steps
})
(defn next-step [event world-state]
(update-in world-state [:steps] rest))
(defn render [{:keys [color-map fractal-set cut-off canvas-size steps] :as world-state}]
(when-let [current-step (first steps)]
(->
ctx
(fractal canvas-size current-step fractal-set cut-off (get available-luts color-map)))))
(defn handle-incoming-msg [event world-state]
(merge world-state event {:steps steps}))
(defn handle-zoom [event world-state]
(prevent-default event)
(let [[x y] (offset-coords event)
zoom-dir (if (zero? (button event))
z/zoom-in
z/zoom-out)]
(->
world-state
(update-in [:fractal-set :bounds] zoom-dir screen x y)
(merge {:steps steps}))))
(defn style [& styles ]
[:style (str/join \newline styles)])
(defn start []
(let [updates-chan (chan 1)]
(go
(->>
(sel1 :#canvas-area)
(insert-after! (node
[:div
(style
"#canvas-area {cursor: pointer}")
(dropdown
:id :color-map
:label-text " Colors:"
:initial-value (:color-map initial-state)
:options (zipmap (keys available-luts) (keys available-luts))
:send-channel (to-keyword> :color-map updates-chan))
(dropdown
:id :cut-off
:label-text " Cut-off:"
:initial-value (:cut-off initial-state)
:options (zipmap (range 10 101 10) (range 10 101 10))
:send-channel (to-keyword> :cut-off updates-chan))]))))
(big-bang
:event-target canvas
:initial-state initial-state
:on-tick next-step
:to-draw render
:receive-channel updates-chan
:on-receive handle-incoming-msg
:on-mousedown handle-zoom)))
(show canvas)
(start)zoom.cljs
(ns webrot.zoom)
(defrecord Bounds [top right bottom left])
(defn to-bounds [[top rgt bot lft]]
(Bounds.
(max top bot)
(max lft rgt)
(min top bot)
(min lft rgt)))
(defn- abs [n]
(if (neg? n) (- n) n))
(defn width [bounds]
(abs (- (:left bounds) (:right bounds))))
(defn height [bounds]
(abs (- (:top bounds) (:bottom bounds))))
(defn zoom-in [bounds screen x y]
"Recalculate bounds (zoom in by 50%)"
(let [bot (+ (:bottom bounds) (* y (/ (height bounds) (height screen))) (/ (height bounds) -4))
lft (+ (:left bounds) (* x (/ (width bounds) (width screen))) (/ (width bounds) -4))]
(Bounds.
(double (+ bot (/ (height bounds) 2))) ; top
(double (+ lft (/ (width bounds) 2))) ; right
(double bot)
(double lft))))
(defn zoom-out [bounds screen x y]
"Recalculate bounds (zoom out by 50%)"
(let [bot (+ (:bottom bounds) (* y (/ (height bounds) (height screen))) (- (height bounds)))
lft (+ (:left bounds) (* x (/ (width bounds) (width screen))) (- (width bounds)))]
(Bounds.
(double (+ bot (* (height bounds) 2))) ; top
(double (+ lft (* (width bounds) 2))) ; right
(double bot)
(double lft))))
(defn real-coords [bounds screen x y]
(let [bounds (to-bounds bounds)
screen (to-bounds screen)]
{ :x (double (+ (:left bounds) (* (width bounds) (/ x (width screen)))))
:y (double (+ (:bottom bounds) (* (height bounds) (/ y (height screen))))) }))