changeset 23:bbe95838fe77

Scrollable viewport.
author Mikhail Kryshen <mikhail@kryshen.net>
date Sun, 20 Jun 2010 04:23:28 +0400
parents dc81033d4122
children c17e3588ede9
files src/indyvon/component.clj src/indyvon/core.clj
diffstat 2 files changed, 54 insertions(+), 9 deletions(-) [+]
line wrap: on
line diff
--- a/src/indyvon/component.clj	Sat Jun 19 06:50:24 2010 +0400
+++ b/src/indyvon/component.clj	Sun Jun 20 04:23:28 2010 +0400
@@ -19,6 +19,7 @@
         width (.width size)
         height (.height size)
         context (assoc context
+                  :target component
                   :font-context (.getFontRenderContext graphics)
                   :update-fn #(.repaint component))]
     (.clearRect graphics 0 0 width height)
@@ -27,6 +28,7 @@
 
 (defn preferred-size [component layer context]
   (let [context (assoc context
+                  :target component
                   :font-context (font-context component))
         s (size layer context)]
     (Dimension. (s 0) (s 1))))
@@ -120,7 +122,7 @@
       (.addWindowListener
        (proxy [java.awt.event.WindowAdapter] []
          (windowClosing [event] (.dispose frame))))
-      (.. (getContentPane) (add (make-jpanel layer)))
+      (.. (getContentPane) (add (make-jpanel (viewport layer))))
       (.pack)
       (.setVisible true))
     )
--- a/src/indyvon/core.clj	Sat Jun 19 06:50:24 2010 +0400
+++ b/src/indyvon/core.clj	Sun Jun 20 04:23:28 2010 +0400
@@ -5,8 +5,9 @@
 ;;
 
 (ns indyvon.core
-  (:import (java.awt Color Font)
-           (java.awt.font FontRenderContext TextLayout)))
+  (:import (java.awt Color Font Cursor)
+           (java.awt.font FontRenderContext TextLayout)
+           (java.awt.event MouseEvent)))
 
 (defprotocol Layer
   "Basic UI element."
@@ -29,11 +30,11 @@
 (defn default-theme []
   (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
   
-(defrecord LayerContext
-  [layer parent x y width height update-fn dispatcher font-context theme])
+(defrecord LayerContext [layer parent x y width height update-fn
+  dispatcher font-context theme target])
 
 (defn default-context []
-  (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme)))
+  (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme) nil))
 
 (defn update [context]
   ((:update-fn context)))
@@ -164,6 +165,48 @@
 
 (defn viewport
   "Creates scrollable viewport layer."
-  [content]
-  ;; TODO
-  )
+  ([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 c g]
+        (let [anchor (anchor content c)
+              width (:width c)
+              height (:height c)]
+          (dosync
+           (case h-align
+                 :left nil
+                 :center (alter x + (/ (- @last-width width) 2))
+                 :right (alter x + (- @last-width width)))
+           (case v-align
+                 :top nil
+                 :center (alter y + (/ (- @last-height height) 2))
+                 :bottom (alter y + (- @last-height height)))
+           (ref-set last-width width)
+           (ref-set last-height height))
+          (draw! c content g
+                 (- 0 @x (anchor 0))
+                 (- 0 @y (anchor 1)))))
+     (size [layer c] (size content c))
+     MouseHandler
+     (handle-mouse [layer c e]
+        (when (= (.getID e) MouseEvent/MOUSE_PRESSED)
+          (dosync
+           (ref-set fix-x (.getXOnScreen e))
+           (ref-set fix-y (.getYOnScreen e)))
+          (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c))))
+        (when (= (.getID e) MouseEvent/MOUSE_RELEASED)
+          (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c))))
+        (when (= (.getID e) MouseEvent/MOUSE_DRAGGED)
+          (dosync
+           (alter x + (- @fix-x (.getXOnScreen e)))
+           (alter y + (- @fix-y (.getYOnScreen e)))
+           (ref-set fix-x (.getXOnScreen e))
+           (ref-set fix-y (.getYOnScreen e)))
+          (update c)))))))