summaryrefslogtreecommitdiff
path: root/src/assets/viz/2/quil/middlewares/navigation_2d.cljc
blob: cd0371067f16a1aab810e9e036ef8fd17d0c34e8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
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)))))