1.1 --- a/src/indyvon/component.clj	Sat Jun 19 06:50:24 2010 +0400
     1.2 +++ b/src/indyvon/component.clj	Sun Jun 20 04:23:28 2010 +0400
     1.3 @@ -19,6 +19,7 @@
     1.4          width (.width size)
     1.5          height (.height size)
     1.6          context (assoc context
     1.7 +                  :target component
     1.8                    :font-context (.getFontRenderContext graphics)
     1.9                    :update-fn #(.repaint component))]
    1.10      (.clearRect graphics 0 0 width height)
    1.11 @@ -27,6 +28,7 @@
    1.12  
    1.13  (defn preferred-size [component layer context]
    1.14    (let [context (assoc context
    1.15 +                  :target component
    1.16                    :font-context (font-context component))
    1.17          s (size layer context)]
    1.18      (Dimension. (s 0) (s 1))))
    1.19 @@ -120,7 +122,7 @@
    1.20        (.addWindowListener
    1.21         (proxy [java.awt.event.WindowAdapter] []
    1.22           (windowClosing [event] (.dispose frame))))
    1.23 -      (.. (getContentPane) (add (make-jpanel layer)))
    1.24 +      (.. (getContentPane) (add (make-jpanel (viewport layer))))
    1.25        (.pack)
    1.26        (.setVisible true))
    1.27      )

     2.1 --- a/src/indyvon/core.clj	Sat Jun 19 06:50:24 2010 +0400
     2.2 +++ b/src/indyvon/core.clj	Sun Jun 20 04:23:28 2010 +0400
     2.3 @@ -5,8 +5,9 @@
     2.4  ;;
     2.5  
     2.6  (ns indyvon.core
     2.7 -  (:import (java.awt Color Font)
     2.8 -           (java.awt.font FontRenderContext TextLayout)))
     2.9 +  (:import (java.awt Color Font Cursor)
    2.10 +           (java.awt.font FontRenderContext TextLayout)
    2.11 +           (java.awt.event MouseEvent)))
    2.12  
    2.13  (defprotocol Layer
    2.14    "Basic UI element."
    2.15 @@ -29,11 +30,11 @@
    2.16  (defn default-theme []
    2.17    (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
    2.18    
    2.19 -(defrecord LayerContext
    2.20 -  [layer parent x y width height update-fn dispatcher font-context theme])
    2.21 +(defrecord LayerContext [layer parent x y width height update-fn
    2.22 +  dispatcher font-context theme target])
    2.23  
    2.24  (defn default-context []
    2.25 -  (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme)))
    2.26 +  (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme) nil))
    2.27  
    2.28  (defn update [context]
    2.29    ((:update-fn context)))
    2.30 @@ -164,6 +165,48 @@
    2.31  
    2.32  (defn viewport
    2.33    "Creates scrollable viewport layer."
    2.34 -  [content]
    2.35 -  ;; TODO
    2.36 -  )
    2.37 +  ([content] (viewport content :left :top))
    2.38 +  ([content h-align v-align]
    2.39 +  (let [x (ref 0)
    2.40 +        y (ref 0)
    2.41 +        fix-x (ref 0)
    2.42 +        fix-y (ref 0)
    2.43 +        last-width (ref 0)
    2.44 +        last-height (ref 0)]
    2.45 +    (reify
    2.46 +     Layer
    2.47 +     (render! [layer c g]
    2.48 +        (let [anchor (anchor content c)
    2.49 +              width (:width c)
    2.50 +              height (:height c)]
    2.51 +          (dosync
    2.52 +           (case h-align
    2.53 +                 :left nil
    2.54 +                 :center (alter x + (/ (- @last-width width) 2))
    2.55 +                 :right (alter x + (- @last-width width)))
    2.56 +           (case v-align
    2.57 +                 :top nil
    2.58 +                 :center (alter y + (/ (- @last-height height) 2))
    2.59 +                 :bottom (alter y + (- @last-height height)))
    2.60 +           (ref-set last-width width)
    2.61 +           (ref-set last-height height))
    2.62 +          (draw! c content g
    2.63 +                 (- 0 @x (anchor 0))
    2.64 +                 (- 0 @y (anchor 1)))))
    2.65 +     (size [layer c] (size content c))
    2.66 +     MouseHandler
    2.67 +     (handle-mouse [layer c e]
    2.68 +        (when (= (.getID e) MouseEvent/MOUSE_PRESSED)
    2.69 +          (dosync
    2.70 +           (ref-set fix-x (.getXOnScreen e))
    2.71 +           (ref-set fix-y (.getYOnScreen e)))
    2.72 +          (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c))))
    2.73 +        (when (= (.getID e) MouseEvent/MOUSE_RELEASED)
    2.74 +          (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c))))
    2.75 +        (when (= (.getID e) MouseEvent/MOUSE_DRAGGED)
    2.76 +          (dosync
    2.77 +           (alter x + (- @fix-x (.getXOnScreen e)))
    2.78 +           (alter y + (- @fix-y (.getYOnScreen e)))
    2.79 +           (ref-set fix-x (.getXOnScreen e))
    2.80 +           (ref-set fix-y (.getYOnScreen e)))
    2.81 +          (update c)))))))