Image Dither

canvasanimation

Experimenting with some basic image dithering, in the style of 10 PRINT (see also http://programming-enchiladas.destructuring-bind.org/rm-hull/4bf4ce47c4f615e9cfe6), the idea was inspired by _bitcraft's_ OpenProcessing version: http://openprocessing.org/sketch/82451.

8 Nov 2014 by rm-hull
rm-hull/ca9c75284f121c8e8301
INSTRUCTIONS.md
  • Move the mouse horizontally to change threshold point
  • Click the mouse to alter the resolution
  • Press the ‘C’ key to cycle between [10-Print, Greyscale, Inverse, Solarize]
  • Refresh the page for a different image (chosen at random)
image-dither.cljs
(ns enchilada.image-dither
  (:require-macros [cljs.core.async.macros :refer [go]])
  (:require
    [enchilada :refer [canvas ctx value-of canvas-size proxy-request]]
    [cljs.core.async :as async :refer [<!]]
    [dataview.loader :refer [fetch-image]]
    [jayq.core :refer [show]]
    [big-bang.core :refer [big-bang]]
    [big-bang.events.browser :refer [client-coords]]
    [monet.canvas :refer [draw-image]]))

(def images
  ["http://www.wired.com/wiredenterprise/wp-content/uploads/2011/10/john-mccarthy.png"
   "http://1.bp.blogspot.com/_jy8BQBbYn3I/TOLsd9SqqrI/AAAAAAAAABw/V3f2QgJuogY/s1600/JohnvonNeumann-LosAlamos.jpg"
   "http://leiron.be/exttopics/GraceHopper.jpg"
   "http://media-cache-ec0.pinimg.com/736x/a0/bf/2a/a0bf2a9c52fed6010068acbf4993351a.jpg"
   "http://www.computerhistory.org/timeline/images/1960_hoare2.jpg"
   "http://phillipkay.files.wordpress.com/2013/06/1-steve-jobs.jpg"
   "http://www.paleisjevoorvolksvlijt.nl/wp-content/uploads/2012/09/alan-turing.gif"
   "http://media-cache-ec0.pinimg.com/736x/b5/ca/ec/b5caec6a88a01145776c89027f9a1514.jpg"
   "http://upload.wikimedia.org/wikipedia/commons/thumb/0/0e/Jerry_Sussman.jpg/200px-Jerry_Sussman.jpg"])

; TODO: move into big-bang.events.browser
(defn touch-coords [event]
  (when-let [touch-object (.-changedTouches event)]
    (client-coords (aget touch-object 0))))

(defn resize [dest src {:keys [w h]}]
  (let [ctx         (.getContext dest "2d")
        temp-canvas (.createElement js/document "canvas")
        temp-ctx    (.getContext temp-canvas "2d")]
    (set! (.-width temp-canvas) (.-width src))
    (set! (.-height temp-canvas) (.-height src))
    (draw-image temp-ctx src {:x 0 :y 0})

    (draw-image ctx temp-canvas
      {:sx 0 :sy 0 :sw (.-width temp-canvas) :sh (.-height temp-canvas)
       :dx 0 :dy 0 :dw  w :dh h })
    ; TODO remove temp-canvas?
    dest))

(defn sample [src new-width]
  (let [ratio (/ (.-height src) (.-width src))
        new-height (* ratio new-width)
        dest (.createElement js/document "canvas")]
    (set! (.-width dest) new-width)
    (set! (.-height dest) new-height)
    (resize dest src {:w new-width :h new-height})))

(defn rotate [coll]
  (conj
    (vec (next coll))
    (first coll)))

(defn constrain [amt low high]
  (cond
    (< amt low)  low
    (> amt high) high
    :else        amt))

(defn handle-mousemove [event {:keys [width] :as world-state}]
  (let [mouse-x (first (or (touch-coords event) (client-coords event)))]
    (assoc world-state :m (constrain (/ (* 130 (- mouse-x 200)) (* 2 width)) 1 129))))

(defn next-resolution [event {:keys [resolutions width image] :as world-state}]
  (let [n (first resolutions)]
    (->
      world-state
      (assoc
        :n n
        :d (/ width n)
        :sample (sample image n)
        :resolutions (rotate resolutions)))))

(defn next-effect [event {:keys [effects] :as world-state}]
  (if (= (.-keyCode event) 67) ; 'C' key
    (assoc world-state :effects (rotate effects))
    world-state))

(defn brightness [pixels x y w]
  (let [offset (* 4 (+ (* y w) x))
        r (aget pixels offset)
        g (aget pixels (inc offset))
        b (aget pixels (+ offset 2))]
    (/ (+ r g b) 3)))

(defn brightness! [pixels x y w value]
  (let [offset (* 4 (+ (* y w) x))]
    (aset pixels offset value)
    (aset pixels (inc offset) value)
    (aset pixels (+ offset 2) value)
    (aset pixels (+ offset 3) 0xff)))

(defn diagonal [value dx dy d m]
  (let [value (- 0xff value)
        z (if (< (mod value (* 2 m)) m)
            (/ (* (+ dx dy 1) 0xff) d)
            (/ (* (- (+ dx d) dy) 0xff) d))]
    (if (> value (+ (* 2 (Math/abs (- z 0xff) 2)))) 0x00 0xff)))

(defn inverse [value dx dy d m]
  (- 0xff value))

(defn threshold [value dx dy d m]
  (if (> value (* 2 m)) 0x00 0xff))

(defn solarize [value dx dy d m]
  (let [a 1
        b -4
        c 4
        x (/ value 0xff)]
    (* 0xff (+ a (* b x) (* c x x)))))

(defn render [{:keys [m d n sample image ratio width effects] :as world-state}]
  (let [sample-ctx   (.getContext sample "2d")
        sample-data  (.-data (.getImageData sample-ctx 0 0 n (inc (Math/floor (* n ratio)))))
        pixels       (.getImageData ctx 0 0 width (* width ratio))
        pixel-data   (.-data pixels)
        effect       (first effects)]

    (dotimes [y (inc (Math/floor (* n ratio)))]
      (dotimes [x n]

        (let [value (brightness sample-data x y n)
              x     (* x d)
              y     (* y d)]

          (dotimes [dy d]
            (dotimes [dx d]

              (brightness!
                pixel-data
                (+ x dx)
                (+ y dy)
                width
                (effect value dx dy d m)))))))

    (.putImageData ctx pixels 0 0)))

(go
  (let [width 400
        img (<! (fetch-image (proxy-request (rand-nth images))))
        sample (sample img width)
        initial-state (next-resolution nil
                         {:m 6
                          :width width
                          :ratio (/ (.-height img) (.-width img))
                          :image img
                          :resolutions [50 100 50 25 20 25]
                          :effects [diagonal identity inverse solarize]})]

    (set! (.-height (.get canvas 0)) (.-height sample))
    (show canvas)
    (draw-image ctx sample {:x width :y 0})

    (render initial-state)
    (big-bang
      ;:event-target canvas
      :initial-state initial-state
      :on-keydown next-effect
      :on-mousedown next-resolution
      :on-mousemove handle-mousemove
      :to-draw render)))