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 diff
     1.1 --- a/src/net/kryshen/indyvon/layers.clj	Thu Mar 03 03:20:23 2011 +0300
     1.2 +++ b/src/net/kryshen/indyvon/layers.clj	Thu Mar 03 03:29:08 2011 +0300
     1.3 @@ -1,5 +1,5 @@
     1.4  ;;
     1.5 -;; Copyright 2010 Mikhail Kryshen <mikhail@kryshen.net>
     1.6 +;; Copyright 2010, 2011 Mikhail Kryshen <mikhail@kryshen.net>
     1.7  ;;
     1.8  ;; This file is part of Indyvon.
     1.9  ;;
    1.10 @@ -289,22 +289,39 @@
    1.11    "Creates miniature view of the viewport's contents."
    1.12    [viewport width height]
    1.13    (let [miniature (miniature (:content viewport) width height)]
    1.14 -    (decorate-layer miniature [_]
    1.15 -      ;;(repaint-on-update viewport)
    1.16 +    (decorate-layer miniature [l]
    1.17        (let [size (layer-size (:content viewport))
    1.18              s (scaling (:width size) (:height size) width height)
    1.19              [x y w h] (viewport-visible-bounds viewport)
    1.20 -            x (* (+ x (align-x (:width size) (/ width s) :center)) s)
    1.21 -            y (* (+ y (align-y (:height size) (/ height s) :center)) s)
    1.22 -            w (* w s)
    1.23 -            h (* h s)]
    1.24 +            ox (align-x (:width size) (/ width s) :center)
    1.25 +            oy (align-y (:height size) (/ height s) :center)
    1.26 +            sx (* (+ x ox) s)
    1.27 +            sy (* (+ y oy) s)
    1.28 +            sw (* w s)
    1.29 +            sh (* h s)
    1.30 +            move-vp (fn [x y]
    1.31 +                      (dosync
    1.32 +                       (ref-set (:x viewport)
    1.33 +                                (- (/ x s)
    1.34 +                                   (/ w 2)
    1.35 +                                   ox
    1.36 +                                   (- @(:vp-x viewport) @(:x viewport))))
    1.37 +                       (ref-set (:y viewport)
    1.38 +                                (- (/ y s)
    1.39 +                                   (/ h 2)
    1.40 +                                   oy
    1.41 +                                   (- @(:vp-y viewport) @(:y viewport)))))
    1.42 +                      (update viewport))]
    1.43          (with-color :alt-back-color
    1.44            (.fillRect *graphics* 0 0 *width* *height*))
    1.45          (with-color :back-color
    1.46 -          (.fillRect *graphics* x y w h))
    1.47 -        (draw! miniature)
    1.48 +          (.fillRect *graphics* sx sy sw sh))
    1.49 +        (with-handlers l
    1.50 +          (draw! miniature)
    1.51 +          (:mouse-pressed e (move-vp (:x e) (:y e)))
    1.52 +          (:mouse-dragged e (move-vp (:x e) (:y e))))
    1.53          (with-color :border-color
    1.54 -          (.drawRect *graphics* x y w h))))))
    1.55 +          (.drawRect *graphics* sx sy sw sh))))))
    1.56  
    1.57  ;;
    1.58  ;; Layer context decorators.