Mandlebrot & Julia fractal generator, based on clojure code originally described in http://webrot.destructuring-bind.org/mandlebrot. Click the left mouse button to zoom in, and the right button to zoom out. _Recently updated to progressively render the image for better initial performance._ TODO - make use of web-workers to improve render perfor…

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))))) }))