Mercurial > hg > indyvon
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)))))))