1.1 --- a/src/net/kryshen/indyvon/core.clj	Sun Aug 29 17:18:16 2010 +0400
     1.2 +++ b/src/net/kryshen/indyvon/core.clj	Sun Aug 29 18:33:41 2010 +0400
     1.3 @@ -259,13 +259,17 @@
     1.4       ~@body))
     1.5  
     1.6  (defmacro with-color
     1.7 -  [color & body]
     1.8 -  `(let [color# (.getColor *graphics*)]
     1.9 -     (try
    1.10 -       (.setColor *graphics* ~color)
    1.11 -       ~@body
    1.12 -       (finally
    1.13 -        (.setColor *graphics* color#)))))
    1.14 +  [color-or-keyword & body]
    1.15 +  (let [color-form (if (keyword? color-or-keyword)
    1.16 +                     `(~color-or-keyword *theme*)
    1.17 +                     color-or-keyword)]
    1.18 +    `(let [color# ~color-form
    1.19 +           old-color# (.getColor *graphics*)]
    1.20 +       (try
    1.21 +         (.setColor *graphics* color#)
    1.22 +         ~@body
    1.23 +         (finally
    1.24 +          (.setColor *graphics* old-color#))))))
    1.25  
    1.26  ;; TODO: constructor for AffineTransform.
    1.27  ;; (transform :scale 0.3 0.5

     2.1 --- a/src/net/kryshen/indyvon/demo.clj	Sun Aug 29 17:18:16 2010 +0400
     2.2 +++ b/src/net/kryshen/indyvon/demo.clj	Sun Aug 29 18:33:41 2010 +0400
     2.3 @@ -95,4 +95,4 @@
     2.4  
     2.5  (defn -main []
     2.6    (show-frame root)
     2.7 -  (show-frame (miniature root 80 60)))
     2.8 +  (show-frame (viewport-miniature root 80 60)))

     3.1 --- a/src/net/kryshen/indyvon/layers.clj	Sun Aug 29 17:18:16 2010 +0400
     3.2 +++ b/src/net/kryshen/indyvon/layers.clj	Sun Aug 29 18:33:41 2010 +0400
     3.3 @@ -67,7 +67,7 @@
     3.4    ([content width gap]
     3.5       (let [layer (padding content (+ width gap))]
     3.6         (decorate-layer layer [_]
     3.7 -          (with-color (:border-color *theme*)
     3.8 +          (with-color :border-color
     3.9              (doseq [i (range 0 width)]
    3.10                (.drawRect *graphics* i i
    3.11                           (- *width* 1 i i)
    3.12 @@ -81,7 +81,7 @@
    3.13    ([content gap]
    3.14       (let [layer (padding content gap)]
    3.15         (decorate-layer layer [_]
    3.16 -         (with-color (:alt-back-color *theme*)
    3.17 +         (with-color :alt-back-color
    3.18             (.fillRect *graphics* 0 0 *width* *height*))
    3.19           (render! layer)))))
    3.20  
    3.21 @@ -189,46 +189,70 @@
    3.22         (Size. width height)))
    3.23     width height))
    3.24  
    3.25 +(defrecord Viewport [content h-align v-align
    3.26 +                     ;; state (refs)
    3.27 +                     x y fix-x fix-y last-width last-height]
    3.28 +  Layer
    3.29 +  (render! [layer]
    3.30 +     (repaint-on-update layer)
    3.31 +     (with-handlers layer
    3.32 +       (let [anchor (anchor content h-align v-align)]
    3.33 +         (dosync
    3.34 +          (alter x + (align-x *width* @last-width h-align))
    3.35 +          (alter y + (align-y *height* @last-height v-align))
    3.36 +          (ref-set last-width *width*)
    3.37 +          (ref-set last-height *height*))
    3.38 +         ;; TODO: notify observers when size changes.
    3.39 +         (draw! content (- 0 @x (:x anchor)) (- 0 @y (:y anchor))))
    3.40 +       (:mouse-pressed e
    3.41 +        (dosync
    3.42 +         (ref-set fix-x (:x-on-screen e))
    3.43 +         (ref-set fix-y (:y-on-screen e)))
    3.44 +        (when *target*
    3.45 +          (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*))))
    3.46 +       (:mouse-released e
    3.47 +        (when *target*
    3.48 +          (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*))))
    3.49 +       (:mouse-dragged e
    3.50 +        (dosync
    3.51 +         (alter x + (- @fix-x (:x-on-screen e)))
    3.52 +         (alter y + (- @fix-y (:y-on-screen e)))
    3.53 +         (ref-set fix-x (:x-on-screen e))
    3.54 +         (ref-set fix-y (:y-on-screen e)))
    3.55 +        (update layer))))
    3.56 +  (layer-size [layer]
    3.57 +     (layer-size content)))
    3.58 +
    3.59  (defn viewport
    3.60    "Creates scrollable viewport layer."
    3.61    ([content] (viewport content :left :top))
    3.62    ([content h-align v-align]
    3.63 -  (let [x (ref 0)
    3.64 -        y (ref 0)
    3.65 -        fix-x (ref 0)
    3.66 -        fix-y (ref 0)
    3.67 -        last-width (ref 0)
    3.68 -        last-height (ref 0)]
    3.69 -    (reify
    3.70 -     Layer
    3.71 -     (render! [layer]
    3.72 -        (repaint-on-update layer)
    3.73 -        (with-handlers layer
    3.74 -          (let [anchor (anchor content h-align v-align)]
    3.75 -            (dosync
    3.76 -             (alter x + (align-x *width* @last-width h-align))
    3.77 -             (alter y + (align-y *height* @last-height v-align))
    3.78 -             (ref-set last-width *width*)
    3.79 -             (ref-set last-height *height*))
    3.80 -            (draw! content (- 0 @x (:x anchor)) (- 0 @y (:y anchor))))
    3.81 -          (:mouse-pressed e
    3.82 -           (dosync
    3.83 -            (ref-set fix-x (:x-on-screen e))
    3.84 -            (ref-set fix-y (:y-on-screen e)))
    3.85 -           (when *target*
    3.86 -             (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*))))
    3.87 -          (:mouse-released e
    3.88 -           (when *target*
    3.89 -             (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*))))
    3.90 -          (:mouse-dragged e
    3.91 -           (dosync
    3.92 -            (alter x + (- @fix-x (:x-on-screen e)))
    3.93 -            (alter y + (- @fix-y (:y-on-screen e)))
    3.94 -            (ref-set fix-x (:x-on-screen e))
    3.95 -            (ref-set fix-y (:y-on-screen e)))
    3.96 -           (update layer))))
    3.97 -     (layer-size [layer]
    3.98 -        (layer-size content))))))
    3.99 +     (Viewport. content h-align v-align
   3.100 +                (ref 0) (ref 0)    ; x y
   3.101 +                (ref 0) (ref 0)    ; fix-x fix-y
   3.102 +                (ref 0) (ref 0)))) ; last-width last-height
   3.103 +
   3.104 +(defn- viewport-visible-bounds
   3.105 +  [viewport]
   3.106 +  (dosync
   3.107 +   [@(:x viewport) @(:y viewport)
   3.108 +    @(:last-width viewport) @(:last-height viewport)]))
   3.109 +
   3.110 +(defn viewport-miniature
   3.111 +  "Creates miniature view of the viewport's contents."
   3.112 +  [viewport width height]
   3.113 +  (miniature
   3.114 +   (decorate-layer (:content viewport) [_]
   3.115 +      (repaint-on-update viewport)
   3.116 +      (let [[x y w h] (viewport-visible-bounds viewport)]
   3.117 +        (with-color :alt-back-color
   3.118 +          (.fillRect *graphics* 0 0 *width* *height*))
   3.119 +        (with-color :back-color
   3.120 +          (.fillRect *graphics* x y w h))
   3.121 +        (draw! (:content viewport))
   3.122 +        (with-color :border-color
   3.123 +          (.drawRect *graphics* x y w h))))
   3.124 +   width height))
   3.125  
   3.126  ;;
   3.127  ;; Layer context decorators.