changeset 96:fbedad9bd6de

Set viewport position by clicking or dragging viewport miniature.
author Mikhail Kryshen <mikhail@kryshen.net>
date Thu, 03 Mar 2011 03:29:08 +0300
parents df9dedc80485
children 72821bd32e2e
files src/net/kryshen/indyvon/layers.clj
diffstat 1 files changed, 27 insertions(+), 10 deletions(-) [+]
line wrap: on
line diff
--- a/src/net/kryshen/indyvon/layers.clj	Thu Mar 03 03:20:23 2011 +0300
+++ b/src/net/kryshen/indyvon/layers.clj	Thu Mar 03 03:29:08 2011 +0300
@@ -1,5 +1,5 @@
 ;;
-;; Copyright 2010 Mikhail Kryshen <mikhail@kryshen.net>
+;; Copyright 2010, 2011 Mikhail Kryshen <mikhail@kryshen.net>
 ;;
 ;; This file is part of Indyvon.
 ;;
@@ -289,22 +289,39 @@
   "Creates miniature view of the viewport's contents."
   [viewport width height]
   (let [miniature (miniature (:content viewport) width height)]
-    (decorate-layer miniature [_]
-      ;;(repaint-on-update viewport)
+    (decorate-layer miniature [l]
       (let [size (layer-size (:content viewport))
             s (scaling (:width size) (:height size) width height)
             [x y w h] (viewport-visible-bounds viewport)
-            x (* (+ x (align-x (:width size) (/ width s) :center)) s)
-            y (* (+ y (align-y (:height size) (/ height s) :center)) s)
-            w (* w s)
-            h (* h s)]
+            ox (align-x (:width size) (/ width s) :center)
+            oy (align-y (:height size) (/ height s) :center)
+            sx (* (+ x ox) s)
+            sy (* (+ y oy) s)
+            sw (* w s)
+            sh (* h s)
+            move-vp (fn [x y]
+                      (dosync
+                       (ref-set (:x viewport)
+                                (- (/ x s)
+                                   (/ w 2)
+                                   ox
+                                   (- @(:vp-x viewport) @(:x viewport))))
+                       (ref-set (:y viewport)
+                                (- (/ y s)
+                                   (/ h 2)
+                                   oy
+                                   (- @(:vp-y viewport) @(:y viewport)))))
+                      (update viewport))]
         (with-color :alt-back-color
           (.fillRect *graphics* 0 0 *width* *height*))
         (with-color :back-color
-          (.fillRect *graphics* x y w h))
-        (draw! miniature)
+          (.fillRect *graphics* sx sy sw sh))
+        (with-handlers l
+          (draw! miniature)
+          (:mouse-pressed e (move-vp (:x e) (:y e)))
+          (:mouse-dragged e (move-vp (:x e) (:y e))))
         (with-color :border-color
-          (.drawRect *graphics* x y w h))))))
+          (.drawRect *graphics* sx sy sw sh))))))
 
 ;;
 ;; Layer context decorators.