90 lines
3.1 KiB
Plaintext
90 lines
3.1 KiB
Plaintext
|
(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)))))
|