Mercurial > hg > indyvon

changeset 70:b2f6c78413d3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Viewport miniature. With-color macro accepts keyword identifying color in theme.
author Mikhail Kryshen <mikhail@kryshen.net>
date Sun, 29 Aug 2010 18:33:41 +0400
parents 01b4187c19e4
children 59e1810c0278
files src/net/kryshen/indyvon/core.clj src/net/kryshen/indyvon/demo.clj src/net/kryshen/indyvon/layers.clj
diffstat 3 files changed, 74 insertions(+), 46 deletions(-) [+]
line wrap: on
line diff
--- a/src/net/kryshen/indyvon/core.clj	Sun Aug 29 17:18:16 2010 +0400
+++ b/src/net/kryshen/indyvon/core.clj	Sun Aug 29 18:33:41 2010 +0400
@@ -259,13 +259,17 @@
      ~@body))
 
 (defmacro with-color
-  [color & body]
-  `(let [color# (.getColor *graphics*)]
-     (try
-       (.setColor *graphics* ~color)
-       ~@body
-       (finally
-        (.setColor *graphics* color#)))))
+  [color-or-keyword & body]
+  (let [color-form (if (keyword? color-or-keyword)
+                     `(~color-or-keyword *theme*)
+                     color-or-keyword)]
+    `(let [color# ~color-form
+           old-color# (.getColor *graphics*)]
+       (try
+         (.setColor *graphics* color#)
+         ~@body
+         (finally
+          (.setColor *graphics* old-color#))))))
 
 ;; TODO: constructor for AffineTransform.
 ;; (transform :scale 0.3 0.5
--- a/src/net/kryshen/indyvon/demo.clj	Sun Aug 29 17:18:16 2010 +0400
+++ b/src/net/kryshen/indyvon/demo.clj	Sun Aug 29 18:33:41 2010 +0400
@@ -95,4 +95,4 @@
 
 (defn -main []
   (show-frame root)
-  (show-frame (miniature root 80 60)))
+  (show-frame (viewport-miniature root 80 60)))
--- a/src/net/kryshen/indyvon/layers.clj	Sun Aug 29 17:18:16 2010 +0400
+++ b/src/net/kryshen/indyvon/layers.clj	Sun Aug 29 18:33:41 2010 +0400
@@ -67,7 +67,7 @@
   ([content width gap]
      (let [layer (padding content (+ width gap))]
        (decorate-layer layer [_]
-          (with-color (:border-color *theme*)
+          (with-color :border-color
             (doseq [i (range 0 width)]
               (.drawRect *graphics* i i
                          (- *width* 1 i i)
@@ -81,7 +81,7 @@
   ([content gap]
      (let [layer (padding content gap)]
        (decorate-layer layer [_]
-         (with-color (:alt-back-color *theme*)
+         (with-color :alt-back-color
            (.fillRect *graphics* 0 0 *width* *height*))
          (render! layer)))))
 
@@ -189,46 +189,70 @@
        (Size. width height)))
    width height))
 
+(defrecord Viewport [content h-align v-align
+                     ;; state (refs)
+                     x y fix-x fix-y last-width last-height]
+  Layer
+  (render! [layer]
+     (repaint-on-update layer)
+     (with-handlers layer
+       (let [anchor (anchor content h-align v-align)]
+         (dosync
+          (alter x + (align-x *width* @last-width h-align))
+          (alter y + (align-y *height* @last-height v-align))
+          (ref-set last-width *width*)
+          (ref-set last-height *height*))
+         ;; TODO: notify observers when size changes.
+         (draw! content (- 0 @x (:x anchor)) (- 0 @y (:y anchor))))
+       (:mouse-pressed e
+        (dosync
+         (ref-set fix-x (:x-on-screen e))
+         (ref-set fix-y (:y-on-screen e)))
+        (when *target*
+          (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*))))
+       (:mouse-released e
+        (when *target*
+          (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*))))
+       (:mouse-dragged e
+        (dosync
+         (alter x + (- @fix-x (:x-on-screen e)))
+         (alter y + (- @fix-y (:y-on-screen e)))
+         (ref-set fix-x (:x-on-screen e))
+         (ref-set fix-y (:y-on-screen e)))
+        (update layer))))
+  (layer-size [layer]
+     (layer-size content)))
+
 (defn viewport
   "Creates scrollable viewport layer."
   ([content] (viewport content :left :top))
   ([content h-align v-align]
-  (let [x (ref 0)
-        y (ref 0)
-        fix-x (ref 0)
-        fix-y (ref 0)
-        last-width (ref 0)
-        last-height (ref 0)]
-    (reify
-     Layer
-     (render! [layer]
-        (repaint-on-update layer)
-        (with-handlers layer
-          (let [anchor (anchor content h-align v-align)]
-            (dosync
-             (alter x + (align-x *width* @last-width h-align))
-             (alter y + (align-y *height* @last-height v-align))
-             (ref-set last-width *width*)
-             (ref-set last-height *height*))
-            (draw! content (- 0 @x (:x anchor)) (- 0 @y (:y anchor))))
-          (:mouse-pressed e
-           (dosync
-            (ref-set fix-x (:x-on-screen e))
-            (ref-set fix-y (:y-on-screen e)))
-           (when *target*
-             (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*))))
-          (:mouse-released e
-           (when *target*
-             (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*))))
-          (:mouse-dragged e
-           (dosync
-            (alter x + (- @fix-x (:x-on-screen e)))
-            (alter y + (- @fix-y (:y-on-screen e)))
-            (ref-set fix-x (:x-on-screen e))
-            (ref-set fix-y (:y-on-screen e)))
-           (update layer))))
-     (layer-size [layer]
-        (layer-size content))))))
+     (Viewport. content h-align v-align
+                (ref 0) (ref 0)    ; x y
+                (ref 0) (ref 0)    ; fix-x fix-y
+                (ref 0) (ref 0)))) ; last-width last-height
+
+(defn- viewport-visible-bounds
+  [viewport]
+  (dosync
+   [@(:x viewport) @(:y viewport)
+    @(:last-width viewport) @(:last-height viewport)]))
+
+(defn viewport-miniature
+  "Creates miniature view of the viewport's contents."
+  [viewport width height]
+  (miniature
+   (decorate-layer (:content viewport) [_]
+      (repaint-on-update viewport)
+      (let [[x y w h] (viewport-visible-bounds viewport)]
+        (with-color :alt-back-color
+          (.fillRect *graphics* 0 0 *width* *height*))
+        (with-color :back-color
+          (.fillRect *graphics* x y w h))
+        (draw! (:content viewport))
+        (with-color :border-color
+          (.drawRect *graphics* x y w h))))
+   width height))
 
 ;;
 ;; Layer context decorators.