Mercurial > hg > indyvon

changeset 14:0a2fafca72d8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Border layer decorator. Font render context. Manual identation for reify and proxy.
author Mikhail Kryshen <mikhail@kryshen.net>
date Tue, 15 Jun 2010 04:35:57 +0400
parents c6009a144727
children 87bd822aa815
files src/indyvon/component.clj src/indyvon/core.clj src/indyvon/event.clj
diffstat 3 files changed, 100 insertions(+), 46 deletions(-) [+]
line wrap: on
line diff
--- a/src/indyvon/component.clj	Mon Jun 14 06:26:07 2010 +0400
+++ b/src/indyvon/component.clj	Tue Jun 15 04:35:57 2010 +0400
@@ -13,27 +13,34 @@
 (defn- make-update-fn [component]
   (fn [] (.repaint component)))
 
+(defn- font-context [component]
+  (.getFontRenderContext (.getFontMetrics component (.getFont component))))
+
 (defn make-component
   ([layer]
      (make-component layer (make-event-dispatcher)))
   ([layer event-dispatcher]
-     (let [component
+     (let [context (default-context)
+           component
            (proxy [Component] []
              (update [g] (.paint this g))
              (paint [g]
-                    (let [size (.getSize this)
-                          width (.width size)
-                          height (.height size)
-                          context (assoc (default-context)
-                                    :dispatcher event-dispatcher
-                                    :update-fn (make-update-fn this))]
-                      (draw! context layer g 0 0 width height false))
-                    (commit event-dispatcher))
+                (let [size (.getSize this)
+                      width (.width size)
+                      height (.height size)
+                      context (assoc context
+                                :font-context (.getFontRenderContext g)
+                                :dispatcher event-dispatcher
+                                :update-fn (make-update-fn this))]
+                  (draw! context layer g 0 0 width height false))
+                (commit event-dispatcher))
              (getPreferredSize []
-                               ;; TODO: supply context
-                               (let [s (size layer nil)]
-                                 (Dimension. (s 0) (s 1)))))]
+                (let [context (assoc context
+                                :font-context (font-context this))
+                      s (size layer context)]
+                  (Dimension. (s 0) (s 1)))))]
        (listen! event-dispatcher component)
+       (.setBackground component (-> context :theme :back-color))
        component)))
 
 (comment
@@ -42,25 +49,25 @@
     (def layer1
          (reify-layer
           (render! [this context g]
-                   (register-context context)
-                   (.setColor g Color/WHITE)
-                   (.fillRect g 0 0 (:width context) (:height context)))
+             (register-context context)
+             (.setColor g Color/RED)
+             (.fillRect g 0 0 (:width context) (:height context)))
           (size [this context] [30 20])))
+    (def layer1b (border-layer layer1 2 3))
     (def layer2
          (reify-layer
           (render! [this context g]
-                   (register-context context)
-                   (.setColor g Color/BLUE)
-                   (.fillRect g 0 0 (:width context) (:height context))
-                   (draw! context layer1 g 10 5)
-                   (draw! context layer1 g 50 5))
+             (register-context context)
+             (.setColor g Color/YELLOW)
+             (.fillRect g 0 0 (:width context) (:height context))
+             (draw! context layer1b g 10 5)
+             (draw! context layer1 g 55 5))
           (size [this context] [70 65])))
     (def layer
          (reify-layer
           (render! [this context g]
-                   ;;(register-context context)
-                   (.drawLine g 0 0 (:width context) (:height context))
-                   (draw! context layer2 g 15 20))
+             (.drawLine g 0 0 (:width context) (:height context))
+             (draw! context layer2 g 15 20))
           (size [this context] [100 100])))
     (doto frame
       (.addWindowListener
--- a/src/indyvon/core.clj	Mon Jun 14 06:26:07 2010 +0400
+++ b/src/indyvon/core.clj	Tue Jun 15 04:35:57 2010 +0400
@@ -4,17 +4,24 @@
 ;; This file is part of Indyvon.
 ;;
 
-(ns indyvon.core)
+(ns indyvon.core
+  (:import (java.awt Color Font)))
 
 (defprotocol Layer
   (render! [this context graphics])
   (size [this context])
   (anchor [this context]))
 
-(defrecord LayerContext [layer parent x y width height update-fn dispatcher])
+(defrecord Theme [fore-color back-color border-color font])
+
+(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])
 
 (defn default-context []
-  (LayerContext. nil nil 0 0 0 0 nil nil))
+  (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme)))
 
 (defn- spec-map
   ([specs]
@@ -35,12 +42,17 @@
                      (anchor [_ _] [0 0]))
                    specs)))
 
-(defn- make-graphics [g x y w h clip]
+(defn- make-graphics [graphics x y w h clip]
   (if clip
-    (.create g x y w h)
-    (doto (.create g)
+    (.create graphics x y w h)
+    (doto (.create graphics)
       (.translate x y))))
 
+(defn- apply-theme [graphics theme]
+  (doto graphics
+    (.setColor (:fore-color theme))
+    (.setFont (:font theme))))
+
 (defn draw!
   "Render layer in a new graphics context."
   ([context layer graphics]
@@ -77,3 +89,40 @@
                        (~'size [l# c#] (size layer# c#))
                        (~'anchor [l# c#] (anchor layer# c#)))
                      specs))))
+
+;;
+;; Layer implementations.
+;;
+
+(defn border-layer
+  "Decorate layer with a border."
+  ([content]
+     (border-layer content 1))
+  ([content width]
+     (border-layer content width 0))
+  ([content width gap]
+     (let [offset (+ width gap)]
+       (reify-layer
+        (render! [l c g]
+           (let [w (:width c)
+                 h (:height c)]
+             (.setColor g (-> c :theme :border-color))
+             (doseq [i (range 0 width)]
+               (.drawRect g i i (- w 1 i i) (- h 1 i i)))
+             (draw! c content g offset offset (- w offset offset)
+                    (- h offset offset))))
+        (size [l c]
+           (let [s (size content c)]
+             [(+ (s 0) offset offset)
+              (+ (s 1) offset offset)]))
+        (anchor [l c]
+           (let [a (anchor content c)]
+             [(+ (a 0) offset)
+              (+ (a 1) offset)]))))))
+
+;; (defn text-layer
+;;   ([text]
+;;      (text :left :top))
+;;   ([text h-align v-align]
+;;      (let [newline #"\\r\\n|\\n|\\r|\\u0085|\\u2028|\\u2029"]
+;;        (reify-layer))))
\ No newline at end of file
--- a/src/indyvon/event.clj	Mon Jun 14 06:26:07 2010 +0400
+++ b/src/indyvon/event.clj	Tue Jun 15 04:35:57 2010 +0400
@@ -71,10 +71,8 @@
                        (- (.getY event) y)
                        (.getClickCount event)
                        (.isPopupTrigger event)]
-    (getXOnScreen []
-                  (.getXOnScreen event))
-    (getYOnScreen []
-                  (.getYOnScreen event))))
+    (getXOnScreen [] (.getXOnScreen event))
+    (getYOnScreen [] (.getYOnScreen event))))
 
 (defn- translate-and-dispatch
   ([contexts event]
@@ -130,30 +128,30 @@
     (reify
      EventDispatcher
      (listen! [this component]
-             (doto component
-               (.addMouseListener this)
-               (.addMouseMotionListener this)))
+        (doto component
+          (.addMouseListener this)
+          (.addMouseMotionListener this)))
      (register [this context]
-               (dosync (alter context-tree-r add-context context)))
+        (dosync (alter context-tree-r add-context context)))
      (commit [this]
-             (dosync (ref-set context-tree @context-tree-r)
-                     (ref-set context-tree-r {})))
+        (dosync (ref-set context-tree @context-tree-r)
+                (ref-set context-tree-r {})))
      (picked? [this layer] false)
      (hovered? [this layer] false)
      MouseListener
      (mouseEntered [this event]
-                   (dispatch-mouse-motion hovered context-tree event))
+        (dispatch-mouse-motion hovered context-tree event))
      (mouseExited [this event]
-                  (dispatch-mouse-motion hovered context-tree event))
+        (dispatch-mouse-motion hovered context-tree event))
      (mouseClicked [this event]
-                   (dispatch-mouse-button picked hovered context-tree event))
+        (dispatch-mouse-button picked hovered context-tree event))
      (mousePressed [this event]
-                   (dispatch-mouse-button picked hovered context-tree event))
+        (dispatch-mouse-button picked hovered context-tree event))
      (mouseReleased [this event]
-                    (dispatch-mouse-button picked hovered context-tree event))
+        (dispatch-mouse-button picked hovered context-tree event))
      MouseMotionListener
      (mouseDragged [this event]
-                   (translate-and-dispatch @picked event))
+        (translate-and-dispatch @picked event))
      (mouseMoved [this event]
-                 (dispatch-mouse-motion hovered context-tree event)))))
+        (dispatch-mouse-motion hovered context-tree event)))))