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)))))
|
