Skip to content

Instantly share code, notes, and snippets.

Created January 7, 2017 09:25
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save domgetter/1a4050e24cbc4e31f66865662383d5d5 to your computer and use it in GitHub Desktop.
(ns mandelclj.core
(sun.java2d SunGraphics2D)
(javax.swing JFrame JLabel)
(java.awt.image BufferedImage)
(java.awt Dimension Color Rectangle)
(java.awt.event ActionEvent
(set! *unchecked-math* :warn-on-boxed)
(deftype complex [^double real ^double imag])
(defn plus
"(a + bi) + (c + di) == (a + b) + (c + d)i"
[^complex z1 ^complex z2]
(complex. (+ (.real z1) (.real z2)) (+ (.imag z1) (.imag z2))))
(defn magnitude-squared
"|z|^2 == a^2 + b^2"
^double [^complex z]
(+ (* (.real z) (.real z)) (* (.imag z) (.imag z))))
(defn times
"(a + bi)*(c + di) == (ac - bd) + (ad + bc)i"
[^complex z1 ^complex z2]
(- (* (.real z1) (.real z2)) (* (.imag z1) (.imag z2)))
(+ (* (.real z1) (.imag z2)) (* (.imag z1) (.real z2)))))
(defn mandelbrot
"Calculates the number of iterations taken to escape, up to a bailout
(mandelbrot (complex. 0 0) 100) => 100 since [0,0] is in the set"
([^complex c ^long dwell]
(mandelbrot (complex. 0.0 0.0) c 0 dwell))
(^long [z c ^long its ^long dwell]
(if (or (> (magnitude-squared z) 4.0) (= its dwell))
(recur (plus (times z z) c) c (inc its) dwell))))
(defn top-left [viewport]
(let [x (double ((viewport :center) 0))
y (double ((viewport :center) 1))
dx (double (viewport :dx))
dy (double (viewport :dy))]
[(- x dx) (+ y dy)]))
(defn array-index->coord [^long index ^long rows ^long columns viewport]
(let [column (mod index columns)
row (quot index columns)
[x y] (top-left viewport)
x (double x)
y (double y)
viewport-dx (double (viewport :dx))
viewport-dy (double (viewport :dy))
dx (* (/ 1.0 (dec columns)) 2.0 viewport-dx)
dy (* (/ 1.0 (dec rows)) 2.0 viewport-dy)]
[(+ x (* dx (double column))) (- y (* dy (double row)))]))
(defn array-index->x-coord [index columns viewport-x viewport-dx]
(let [index (long index)
columns (long columns)
viewport-x (double viewport-x)
viewport-dx (double viewport-dx)]
(let [dx (* (/ 1.0 (dec columns)) 2.0 viewport-dx (double (mod index columns)))]
(+ (- viewport-x viewport-dx) dx))))
(defn array-index->y-coord [index rows columns viewport-y viewport-dy]
(let [index (long index)
rows (long rows)
columns (long columns)
viewport-y (double viewport-y)
viewport-dy (double viewport-dy)]
(let [dy (* (/ 1.0 (dec rows)) 2.0 viewport-dy (quot index columns))]
(- (+ viewport-y viewport-dy) dy))))
(def columns 128)
(def rows 128)
(defn make-int-array [rows columns]
{:rows rows
:columns columns
:array (make-array Integer/TYPE (* ^long rows ^long columns))})
(def viewport
{:center [-0.5 0.0]
:dx 2.0
:dy 2.0})
(def viewports (atom (list viewport)))
(def output (make-int-array rows columns))
(defn palette [^long i]
(let [i (mod i 8)]
([0xFF0000 0x00FF00 0x0000FF 0xFFFF00 0xFF00FF 0x00FFFF 0x0F0F0F 0xD2E729] i)))
(defn calc-mandelbrot-for-array [array dwell]
(let [raw-array (array :array)
array-size (long (count raw-array))
viewport (first @viewports)
rows (long (array :rows))
columns (long (array :columns))
center-x (double ((viewport :center) 0))
center-y (double ((viewport :center) 1))
dx (double (viewport :dx))
dy (double (viewport :dy))]
(loop [array-index 0]
(if (= array-index array-size)
(let [x-coord (array-index->x-coord array-index columns center-x dx)
y-coord (array-index->y-coord array-index rows columns center-y dy)
i (mandelbrot (complex. x-coord y-coord) dwell)
color (int (palette i))]
(aset ^"[I" raw-array array-index color))
(recur (inc array-index)))))))
(defn new-center [point old-center]
(let [amount 0.28
p0 (double (point 0))
p1 (double (point 1))
oc0 (double (old-center 0))
oc1 (double (old-center 1))
x (+ (* amount p0) (* (- 1 amount) oc0))
y (+ (* amount p1) (* (- 1 amount) oc1))]
[x y]))
(defn zoom-in [point viewports output image columns rows canvas]
(let [center (new-center point ((first @viewports) :center))
viewport-dx (double ((first @viewports) :dx))
viewport-dy (double ((first @viewports) :dy))]
(swap! viewports conj {:center center :dx (/ viewport-dx 1.4) :dy (/ viewport-dy 1.4)}))
(time (calc-mandelbrot-for-array output 170))
(.setRGB ^BufferedImage image 0 0 columns rows ^"[I" (output :array) 0 columns)
(.repaint ^JLabel canvas))
(defn child-rectangles [parent res]
(let [width (:width parent)
half-width (quot width 2)
height (:height parent)
half-height (quot height 2)
x (:x parent)
y (:y parent)]
(and (> width res) (> height res))
[{:width half-width :height half-height :x x :y y}
{:width (- width half-width) :height half-height :x (+ half-width x) :y y}
{:width half-width :height (- height half-height) :x x :y (+ half-height y)}
{:width (- width half-width) :height (- height half-height) :x (+ half-width x) :y (+ half-height y)}]
(> width res)
[{:width half-width :height res :x x :y y}
{:width (- width half-width) :height res :x (+ half-width x) :y y}]
(> height res)
[{:width res :height half-height :x x :y y}
{:width res :height (- height half-height) :x x :y (+ half-height y)}]
:else [])))
(defn rectangle-center [rect]
[(+ (quot (:width rect) 2) (:x rect)) (+ (quot (:height rect) 2) (:y rect))])
(defn pixel-coord->real-coord [[x y] viewport]
(let [column-width (/ (:dx viewport) columns)
row-height (/ (:dy viewport) rows)
x-offset (- (first (:center viewport)) (/ (:dx viewport) 2))
y-offset (- (second (:center viewport)) (/ (:dy viewport) 2))]
{:x (+ (* x column-width) x-offset) :y (+ (* y row-height) y-offset)}))
(defn recursively-calc-mandelbrot-blocks [viewports x-res y-res image canvas dwell]
(let [my-queue (java.util.ArrayDeque.)]
(.addFirst my-queue {:width x-res :height y-res :x 0 :y 0})
(while (> (.size my-queue) 0)
;(dotimes [_ 5]
;(Thread/sleep 20)
;(println "--- Queue ---")
;(println @my-queue)
(comment "take the next item off the my-queue, process it, and blit result to screen")
(let [parent (.removeFirst my-queue)
parent-center (pixel-coord->real-coord (rectangle-center parent) (first @viewports))
parent-its (mandelbrot (complex. (:x parent-center) (:y parent-center)) dwell)
context (.createGraphics image)]
;(Thread/sleep 10)
;(println "--- Parent ---")
;(println parent)
;(println parent-center)
(.setColor context (Color. (palette parent-its)))
(.fill context (Rectangle. (:x parent) (:y parent) (:width parent) (:height parent)))
(.dispose context)
(.update canvas (.getGraphics canvas)))
;(reset! my-queue (rest @my-queue))
;(println (count @my-queue))
(doseq [child (child-rectangles parent 1)]
;(println "--- Child ---")
;(println child)
;(.repaint ^JLabel canvas)
(let [child-center (pixel-coord->real-coord (rectangle-center child) (first @viewports))
child-its (mandelbrot (complex. (:x child-center) (:y child-center)) dwell)]
;(println "--- Child Iterations ---")
;(println child-its)
;(println "--- Parent Iterations ---")
;(println parent-its)
(if (= parent-its child-its)
;(swap! my-queue concat (list child))
;(swap! my-queue conj child)
(.addLast my-queue child)
(.addFirst my-queue child)
(defn zoom-in2 [point viewports output image columns rows canvas]
(let [center (new-center point ((first @viewports) :center))
viewport-dx (double ((first @viewports) :dx))
viewport-dy (double ((first @viewports) :dy))]
(swap! viewports conj {:center center :dx (/ viewport-dx 1.4) :dy (/ viewport-dy 1.4)}))
;(let [queue ])
(time (recursively-calc-mandelbrot-blocks viewports columns rows image canvas 50)))
(defn zoom-out [viewports output image columns rows canvas]
(if (= 1 (count @viewports))
(swap! viewports pop)
(calc-mandelbrot-for-array output 170)
(.setRGB ^BufferedImage image 0 0 columns rows ^"[I" (output :array) 0 columns)
(.repaint ^JLabel canvas))))
(def image (BufferedImage. columns rows BufferedImage/TYPE_INT_RGB))
(def canvas (proxy [JLabel] []
(paint [g]
(let [^JLabel this this]
(proxy-super paint ^SunGraphics2D g))
(.drawImage ^SunGraphics2D g ^BufferedImage image 0 0 ^JLabel this))))
(def graphics (.createGraphics ^BufferedImage image))
(def frame (JFrame. "MandelCLJ"))
(defn -main
[& args]
(calc-mandelbrot-for-array output 170)
(.setDefaultCloseOperation ^JFrame frame JFrame/EXIT_ON_CLOSE)
(let [columns (long columns)
rows (long rows)]
(.setSize ^JFrame frame (Dimension. (+ (+ 8 8) columns) (+ (+ 8 30) rows))))
(.setSize ^JLabel canvas columns rows)
(.add ^JFrame frame ^JLabel canvas)
(.show ^JFrame frame)
(.setRGB ^BufferedImage image 0 0 columns rows ^"[I" (output :array) 0 columns)
(.repaint ^JLabel canvas)
(.addMouseListener ^JLabel canvas (proxy [MouseAdapter] []
(mouseReleased [e]
(if (= 1 (.getButton ^MouseEvent e))
(let [columns (long columns)] (zoom-in2 (array-index->coord (+ (.getX ^MouseEvent e) (* (.getY ^MouseEvent e) columns)) rows columns (first @viewports))
viewports output image columns rows canvas))
(zoom-out viewports output image columns rows canvas))))))
(defproject mandelclj "0.1.0-SNAPSHOT"
:description "FIXME: write description"
:url ""
:license {:name "Eclipse Public License"
:url ""}
:dependencies [[org.clojure/clojure "1.8.0"]]
:main ^:skip-aot mandelclj.core
:target-path "target/%s"
:profiles {:uberjar {:aot :all}})
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment