Mercurial > hg > indyvon

view src/indyvon/viewport.clj @ 186:bf1f63968d85

find changesets by author, revision, files, or words in the commit message
Updated dependencies.
author Mikhail Kryshen <mikhail@kryshen.net>
date Wed, 25 Apr 2018 10:26:01 +0300
parents e73174356504
children
line source
1 ;;
2 ;; Copyright 2010-2015 Mikhail Kryshen <mikhail@kryshen.net>
3 ;;
4 ;; This file is part of Indyvon.
5 ;;
6 ;; Indyvon is free software: you can redistribute it and/or modify it
7 ;; under the terms of the GNU Lesser General Public License version 3
8 ;; only, as published by the Free Software Foundation.
9 ;;
10 ;; Indyvon is distributed in the hope that it will be useful, but
11 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;; Lesser General Public License for more details.
14 ;;
15 ;; You should have received a copy of the GNU Lesser General Public
16 ;; License along with Indyvon. If not, see
17 ;; <http://www.gnu.org/licenses/>.
18 ;;
19
20 (ns indyvon.viewport
21 "Scrollable viewport and miniature."
22 (:use
23 (indyvon core async views))
24 (:import
25 java.awt.Cursor
26 java.awt.geom.AffineTransform))
27
28 ;;(defn- translate [^AffineTransform transform ^double x ^double y]
29 ;; (doto ^AffineTransform (.clone transform)
30 ;; (.translate x y)))
31
32 (defn- scale [^AffineTransform transform ^double sx ^double sy]
33 (doto ^AffineTransform (.clone transform)
34 (.scale sx sy)))
35
36 (defn- pre-translate [^AffineTransform transform ^double x ^double y]
37 (if (== 0.0 x y)
38 transform
39 (doto (AffineTransform/getTranslateInstance x y)
40 (.concatenate transform))))
41
42 (def ^:dynamic *viewport-scaling-step* (Math/sqrt (/ 1.0 2.0)))
43 (def ^:dynamic *viewport-min-scale* 1E-6)
44 (def ^:dynamic *viewport-max-scale* 1E6)
45
46 (def ^:dynamic *viewport* nil)
47 (def ^:dynamic ^AffineTransform *viewport-transform*)
48
49 (declare scale-viewport!)
50
51 (defrecord ViewportState [transform
52 fix-x fix-y
53 last-width last-height
54 last-anchor-x last-anchor-y])
55
56 (defn- update-viewport [state content-geom h-align v-align]
57 (let [w *width*
58 h *height*
59 cw (width content-geom)
60 ch (height content-geom)
61 ax (anchor-x content-geom h-align cw)
62 ay (anchor-y content-geom v-align ch)
63 ax1 (align-x h-align (:last-width state) w)
64 ay1 (align-y v-align (:last-height state) h)
65 ax2 (- (:last-anchor-x state) ax)
66 ay2 (- (:last-anchor-y state) ay)
67 transform (:transform state)
68 transform (if (and (zero? ax1) (zero? ay1)
69 (zero? ax2) (zero? ay2))
70 transform
71 (doto
72 (AffineTransform/getTranslateInstance ax1 ay1)
73 (.concatenate transform)
74 (.translate ax2 ay2)))]
75 (assoc state
76 :last-width w
77 :last-height h
78 :last-anchor-x ax
79 :last-anchor-y ay
80 :transform transform)))
81
82 (defrecord Viewport [content h-align v-align state]
83 View
84 (render! [view]
85 (repaint-on-update! view)
86 (with-handlers view
87 (let [geom (geometry content)
88 new-state (swap! state update-viewport geom h-align v-align)
89 transform (:transform new-state)]
90 ;; TODO: notify observers when size changes.
91 (binding [*viewport* view
92 *viewport-transform* transform]
93 (with-transform transform
94 (draw! content 0 0 (width geom) (height geom) false))))
95 [:mouse-pressed e
96 (swap! state assoc
97 :fix-x (:x-on-screen e)
98 :fix-y (:y-on-screen e))
99 (set-cursor! (Cursor. Cursor/MOVE_CURSOR))]
100 [:mouse-released e
101 (set-cursor! (Cursor. Cursor/DEFAULT_CURSOR))]
102 [:mouse-dragged e
103 (swap! state
104 (fn [s]
105 (assoc s
106 :transform (pre-translate
107 (:transform s)
108 (- (:x-on-screen e) (:fix-x s))
109 (- (:y-on-screen e) (:fix-y s)))
110 :fix-x (:x-on-screen e)
111 :fix-y (:y-on-screen e))))
112 (notify! view)]
113 [:mouse-wheel e
114 (scale-viewport!
115 view
116 (Math/pow *viewport-scaling-step* (:wheel-rotation e))
117 true (:x e) (:y e))]))
118 (geometry [_]
119 (geometry content)))
120
121 (def ^:private viewport-initial-state
122 (->ViewportState
123 (AffineTransform.) ; transform
124 0 0 ; fix-x fix-y
125 0 0 ; last-width last-height
126 0 0))
127
128 (defn viewport
129 "Creates scrollable viewport view."
130 ([content]
131 (viewport :left :top content))
132 ([h-align v-align content]
133 (->Viewport content h-align v-align (atom viewport-initial-state))))
134
135 (defn- scale-viewport [state vp s relative? x y]
136 (let [^AffineTransform tr (:transform state)
137 sx (if relative? s (/ s (.getScaleX tr)))
138 sy (if relative? s (/ s (.getScaleY tr)))
139 x (or x (align-x (:h-align vp) (:last-width state)))
140 y (or y (align-y (:v-align vp) (:last-height state)))
141 x (- x (* x sx))
142 y (- y (* y sy))
143 scaled (doto (AffineTransform/getTranslateInstance x y)
144 (.scale sx sy)
145 (.concatenate tr))
146 sx (.getScaleX scaled)
147 sy (.getScaleY scaled)]
148 (if (<= *viewport-min-scale*
149 (min sx sy)
150 (max sx sy)
151 *viewport-max-scale*)
152 (assoc state
153 :transform scaled)
154 state)))
155
156 (defn scale-viewport!
157 ([viewport s]
158 (scale-viewport! viewport s true))
159 ([viewport s relative?]
160 (scale-viewport! viewport s relative? nil nil))
161 ([viewport s relative? x y]
162 (swap! (:state viewport) scale-viewport viewport s relative? x y)
163 (notify! viewport)))
164
165 (defn reset-viewport! [viewport]
166 (reset! (:state viewport) viewport-initial-state)
167 (notify! viewport))
168
169 (defn ^AffineTransform viewport-transform [viewport]
170 (:transform @(:state viewport)))
171
172 (defn- scaling
173 [width height max-width max-height]
174 (min (/ max-width width)
175 (/ max-height height)))
176
177 (def ^:dynamic *miniature-thread-priority* 2)
178
179 (defn miniature
180 "Creates a view that asynchronously renders the content view scaled to
181 the specified size."
182 [mw mh content]
183 (->> content
184 (decorator (fn [_ content]
185 (let [geom (geometry content)
186 cw (width geom)
187 ch (height geom)
188 s (scaling cw ch mw mh)]
189 (.scale *graphics* s s)
190 (draw! content
191 (align-x :center cw (/ mw s))
192 (align-y :center ch (/ mh s))
193 cw ch)))
194 (fn [_ _]
195 (->Size mw mh)))
196 (async-view mw mh *miniature-thread-priority*)))
197
198 (defn viewport-miniature
199 "Creates miniature view of the viewport's contents."
200 [m-width m-height viewport]
201 (->> (:content viewport)
202 (miniature m-width m-height)
203 (decorator
204 (fn [v m]
205 (repaint-on-update! viewport)
206 (let [geom (geometry (:content viewport))
207 s (scaling (width geom) (height geom) m-width m-height)
208 vp-state @(:state viewport)
209 {:keys [transform last-width last-height]} @(:state viewport)
210 ox (align-x :center (width geom) (/ m-width s))
211 oy (align-y :center (height geom) (/ m-height s))
212 inverse (.createInverse ^AffineTransform transform)
213 transform (doto (AffineTransform.)
214 (.scale s s)
215 (.translate ox oy)
216 (.concatenate inverse))
217 move-vp (fn [state x y]
218 (let [x (- (/ x s) ox)
219 y (- (/ y s) oy)
220 tr (:transform state)
221 [x y] (transform-point tr x y)
222 x (- x (/ (:last-width state) 2))
223 y (- y (/ (:last-height state) 2))]
224 (assoc state
225 :transform (pre-translate tr (- x) (- y)))))
226 move-vp! (fn [x y]
227 (swap! (:state viewport) move-vp x y)
228 (notify! viewport))]
229 (with-color :alt-back-color
230 (.fillRect *graphics* 0 0 *width* *height*))
231 (with-transform transform
232 (with-color :back-color
233 (.fillRect *graphics* 0 0 last-width last-height)))
234 (with-handlers v
235 (draw! m)
236 [:mouse-pressed e (move-vp! (:x e) (:y e))]
237 [:mouse-dragged e (move-vp! (:x e) (:y e))])
238 (with-transform transform
239 (with-color :border-color
240 (.drawRect *graphics* 0 0 last-width last-height))))))))