summaryrefslogtreecommitdiff
path: root/src/assets/viz/2/quil/middlewares/navigation_2d.cljc
diff options
context:
space:
mode:
Diffstat (limited to 'src/assets/viz/2/quil/middlewares/navigation_2d.cljc')
-rw-r--r--src/assets/viz/2/quil/middlewares/navigation_2d.cljc89
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)))))