1 files changed, 89 insertions, 0 deletions
diff --git a/src/assets/viz/2/quil/middlewares/navigation_2d.cljc b/src/assets/viz/2/quil/middlewares/navigation_2d.cljc
new file mode 100644
index 0000000..cd03710
--- /dev/null
+++ b/src/assets/viz/2/quil/middlewares/navigation_2d.cljc
@@ -0,0 +1,89 @@
+(ns quil.middlewares.navigation-2d
+  (:require [quil.core :as q :include-macros true]))
+
+(def ^:private missing-navigation-key-error
+  (str "state map is missing :navigation-2d key. "
+       "Did you accidentally removed it from the state in "
+       ":update or any other handler?"))
+
+(defn- assert-state-has-navigation
+  "Asserts that state map contains :navigation-2d object."
+  [state]
+  (when-not (:navigation-2d state)
+    (throw #?(:clj (RuntimeException. missing-navigation-key-error)
+              :cljs (js/Error. missing-navigation-key-error)))))
+
+(defn- default-position
+  "Default position configuration: zoom is neutral and central point is
+  width/2, height/2."
+  []
+  {:position [(/ (q/width) 2.0)
+              (/ (q/height) 2.0)]
+   :zoom 1})
+
+(defn- setup-2d-nav
+  "Custom 'setup' function which creates initial position
+  configuration and puts it to the state map."
+  [user-setup user-settings]
+  (let [initial-state (-> user-settings
+                          (select-keys [:position :zoom])
+                          (->> (merge (default-position))))]
+    (update-in (user-setup) [:navigation-2d]
+               #(merge initial-state %))))
+
+(defn- mouse-dragged
+  "Changes center of the sketch depending on the last mouse move. Takes
+  zoom into account as well."
+  [state event]
+  (assert-state-has-navigation state)
+  (let [dx (- (:p-x event) (:x event))
+        dy (- (:p-y event) (:y event))
+        zoom (-> state :navigation-2d :zoom)]
+   (-> state
+       (update-in [:navigation-2d :position 0] + (/ dx zoom))
+       (update-in [:navigation-2d :position 1] + (/ dy zoom)))))
+
+(defn- mouse-wheel
+  "Changes zoom settings based on scroll."
+  [state event]
+  (assert-state-has-navigation state)
+  (update-in state [:navigation-2d :zoom] * (+ 1 (* -0.1 event))))
+
+(defn- draw
+  "Calls user draw function with necessary all transformations (position
+  and zoom) applied."
+  [user-draw state]
+  (assert-state-has-navigation state)
+  (q/push-matrix)
+  (let [nav-2d (:navigation-2d state)
+        zoom (:zoom nav-2d)
+        pos (:position nav-2d)]
+    (q/scale zoom)
+    (q/with-translation [(- (/ (q/width) 2 zoom) (first pos))
+                         (- (/ (q/height) 2 zoom) (second pos))]
+      (user-draw state)))
+  (q/pop-matrix))
+
+(defn navigation-2d
+  "Enables navigation over 2D sketch. Dragging mouse will move center of the
+  skecth and mouse wheel controls zoom."
+  [options]
+  (let [; 2d-navigation related user settings
+        user-settings (:navigation-2d options)
+
+        ; user-provided handlers which will be overridden
+        ; by 3d-navigation
+        user-draw (:draw options (fn [state]))
+        user-mouse-dragged (:mouse-dragged options (fn [state _] state))
+        user-mouse-wheel (:mouse-wheel options (fn [state _] state))
+        setup (:setup options (fn [] {}))]
+    (assoc options
+
+      :setup (partial setup-2d-nav setup user-settings)
+
+      :draw (partial draw user-draw)
+
+      :mouse-dragged (fn [state event]
+                       (user-mouse-dragged (mouse-dragged state event) event))
+      :mouse-wheel (fn [state event]
+                     (user-mouse-wheel (mouse-wheel state event) event)))))