changeset 14:0a2fafca72d8

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 diff
     1.1 --- a/src/indyvon/component.clj	Mon Jun 14 06:26:07 2010 +0400
     1.2 +++ b/src/indyvon/component.clj	Tue Jun 15 04:35:57 2010 +0400
     1.3 @@ -13,27 +13,34 @@
     1.4  (defn- make-update-fn [component]
     1.5    (fn [] (.repaint component)))
     1.6  
     1.7 +(defn- font-context [component]
     1.8 +  (.getFontRenderContext (.getFontMetrics component (.getFont component))))
     1.9 +
    1.10  (defn make-component
    1.11    ([layer]
    1.12       (make-component layer (make-event-dispatcher)))
    1.13    ([layer event-dispatcher]
    1.14 -     (let [component
    1.15 +     (let [context (default-context)
    1.16 +           component
    1.17             (proxy [Component] []
    1.18               (update [g] (.paint this g))
    1.19               (paint [g]
    1.20 -                    (let [size (.getSize this)
    1.21 -                          width (.width size)
    1.22 -                          height (.height size)
    1.23 -                          context (assoc (default-context)
    1.24 -                                    :dispatcher event-dispatcher
    1.25 -                                    :update-fn (make-update-fn this))]
    1.26 -                      (draw! context layer g 0 0 width height false))
    1.27 -                    (commit event-dispatcher))
    1.28 +                (let [size (.getSize this)
    1.29 +                      width (.width size)
    1.30 +                      height (.height size)
    1.31 +                      context (assoc context
    1.32 +                                :font-context (.getFontRenderContext g)
    1.33 +                                :dispatcher event-dispatcher
    1.34 +                                :update-fn (make-update-fn this))]
    1.35 +                  (draw! context layer g 0 0 width height false))
    1.36 +                (commit event-dispatcher))
    1.37               (getPreferredSize []
    1.38 -                               ;; TODO: supply context
    1.39 -                               (let [s (size layer nil)]
    1.40 -                                 (Dimension. (s 0) (s 1)))))]
    1.41 +                (let [context (assoc context
    1.42 +                                :font-context (font-context this))
    1.43 +                      s (size layer context)]
    1.44 +                  (Dimension. (s 0) (s 1)))))]
    1.45         (listen! event-dispatcher component)
    1.46 +       (.setBackground component (-> context :theme :back-color))
    1.47         component)))
    1.48  
    1.49  (comment
    1.50 @@ -42,25 +49,25 @@
    1.51      (def layer1
    1.52           (reify-layer
    1.53            (render! [this context g]
    1.54 -                   (register-context context)
    1.55 -                   (.setColor g Color/WHITE)
    1.56 -                   (.fillRect g 0 0 (:width context) (:height context)))
    1.57 +             (register-context context)
    1.58 +             (.setColor g Color/RED)
    1.59 +             (.fillRect g 0 0 (:width context) (:height context)))
    1.60            (size [this context] [30 20])))
    1.61 +    (def layer1b (border-layer layer1 2 3))
    1.62      (def layer2
    1.63           (reify-layer
    1.64            (render! [this context g]
    1.65 -                   (register-context context)
    1.66 -                   (.setColor g Color/BLUE)
    1.67 -                   (.fillRect g 0 0 (:width context) (:height context))
    1.68 -                   (draw! context layer1 g 10 5)
    1.69 -                   (draw! context layer1 g 50 5))
    1.70 +             (register-context context)
    1.71 +             (.setColor g Color/YELLOW)
    1.72 +             (.fillRect g 0 0 (:width context) (:height context))
    1.73 +             (draw! context layer1b g 10 5)
    1.74 +             (draw! context layer1 g 55 5))
    1.75            (size [this context] [70 65])))
    1.76      (def layer
    1.77           (reify-layer
    1.78            (render! [this context g]
    1.79 -                   ;;(register-context context)
    1.80 -                   (.drawLine g 0 0 (:width context) (:height context))
    1.81 -                   (draw! context layer2 g 15 20))
    1.82 +             (.drawLine g 0 0 (:width context) (:height context))
    1.83 +             (draw! context layer2 g 15 20))
    1.84            (size [this context] [100 100])))
    1.85      (doto frame
    1.86        (.addWindowListener
     2.1 --- a/src/indyvon/core.clj	Mon Jun 14 06:26:07 2010 +0400
     2.2 +++ b/src/indyvon/core.clj	Tue Jun 15 04:35:57 2010 +0400
     2.3 @@ -4,17 +4,24 @@
     2.4  ;; This file is part of Indyvon.
     2.5  ;;
     2.6  
     2.7 -(ns indyvon.core)
     2.8 +(ns indyvon.core
     2.9 +  (:import (java.awt Color Font)))
    2.10  
    2.11  (defprotocol Layer
    2.12    (render! [this context graphics])
    2.13    (size [this context])
    2.14    (anchor [this context]))
    2.15  
    2.16 -(defrecord LayerContext [layer parent x y width height update-fn dispatcher])
    2.17 +(defrecord Theme [fore-color back-color border-color font])
    2.18 +
    2.19 +(defn default-theme []
    2.20 +  (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
    2.21 +  
    2.22 +(defrecord LayerContext
    2.23 +  [layer parent x y width height update-fn dispatcher font-context theme])
    2.24  
    2.25  (defn default-context []
    2.26 -  (LayerContext. nil nil 0 0 0 0 nil nil))
    2.27 +  (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme)))
    2.28  
    2.29  (defn- spec-map
    2.30    ([specs]
    2.31 @@ -35,12 +42,17 @@
    2.32                       (anchor [_ _] [0 0]))
    2.33                     specs)))
    2.34  
    2.35 -(defn- make-graphics [g x y w h clip]
    2.36 +(defn- make-graphics [graphics x y w h clip]
    2.37    (if clip
    2.38 -    (.create g x y w h)
    2.39 -    (doto (.create g)
    2.40 +    (.create graphics x y w h)
    2.41 +    (doto (.create graphics)
    2.42        (.translate x y))))
    2.43  
    2.44 +(defn- apply-theme [graphics theme]
    2.45 +  (doto graphics
    2.46 +    (.setColor (:fore-color theme))
    2.47 +    (.setFont (:font theme))))
    2.48 +
    2.49  (defn draw!
    2.50    "Render layer in a new graphics context."
    2.51    ([context layer graphics]
    2.52 @@ -77,3 +89,40 @@
    2.53                         (~'size [l# c#] (size layer# c#))
    2.54                         (~'anchor [l# c#] (anchor layer# c#)))
    2.55                       specs))))
    2.56 +
    2.57 +;;
    2.58 +;; Layer implementations.
    2.59 +;;
    2.60 +
    2.61 +(defn border-layer
    2.62 +  "Decorate layer with a border."
    2.63 +  ([content]
    2.64 +     (border-layer content 1))
    2.65 +  ([content width]
    2.66 +     (border-layer content width 0))
    2.67 +  ([content width gap]
    2.68 +     (let [offset (+ width gap)]
    2.69 +       (reify-layer
    2.70 +        (render! [l c g]
    2.71 +           (let [w (:width c)
    2.72 +                 h (:height c)]
    2.73 +             (.setColor g (-> c :theme :border-color))
    2.74 +             (doseq [i (range 0 width)]
    2.75 +               (.drawRect g i i (- w 1 i i) (- h 1 i i)))
    2.76 +             (draw! c content g offset offset (- w offset offset)
    2.77 +                    (- h offset offset))))
    2.78 +        (size [l c]
    2.79 +           (let [s (size content c)]
    2.80 +             [(+ (s 0) offset offset)
    2.81 +              (+ (s 1) offset offset)]))
    2.82 +        (anchor [l c]
    2.83 +           (let [a (anchor content c)]
    2.84 +             [(+ (a 0) offset)
    2.85 +              (+ (a 1) offset)]))))))
    2.86 +
    2.87 +;; (defn text-layer
    2.88 +;;   ([text]
    2.89 +;;      (text :left :top))
    2.90 +;;   ([text h-align v-align]
    2.91 +;;      (let [newline #"\\r\\n|\\n|\\r|\\u0085|\\u2028|\\u2029"]
    2.92 +;;        (reify-layer))))
    2.93 \ No newline at end of file
     3.1 --- a/src/indyvon/event.clj	Mon Jun 14 06:26:07 2010 +0400
     3.2 +++ b/src/indyvon/event.clj	Tue Jun 15 04:35:57 2010 +0400
     3.3 @@ -71,10 +71,8 @@
     3.4                         (- (.getY event) y)
     3.5                         (.getClickCount event)
     3.6                         (.isPopupTrigger event)]
     3.7 -    (getXOnScreen []
     3.8 -                  (.getXOnScreen event))
     3.9 -    (getYOnScreen []
    3.10 -                  (.getYOnScreen event))))
    3.11 +    (getXOnScreen [] (.getXOnScreen event))
    3.12 +    (getYOnScreen [] (.getYOnScreen event))))
    3.13  
    3.14  (defn- translate-and-dispatch
    3.15    ([contexts event]
    3.16 @@ -130,30 +128,30 @@
    3.17      (reify
    3.18       EventDispatcher
    3.19       (listen! [this component]
    3.20 -             (doto component
    3.21 -               (.addMouseListener this)
    3.22 -               (.addMouseMotionListener this)))
    3.23 +        (doto component
    3.24 +          (.addMouseListener this)
    3.25 +          (.addMouseMotionListener this)))
    3.26       (register [this context]
    3.27 -               (dosync (alter context-tree-r add-context context)))
    3.28 +        (dosync (alter context-tree-r add-context context)))
    3.29       (commit [this]
    3.30 -             (dosync (ref-set context-tree @context-tree-r)
    3.31 -                     (ref-set context-tree-r {})))
    3.32 +        (dosync (ref-set context-tree @context-tree-r)
    3.33 +                (ref-set context-tree-r {})))
    3.34       (picked? [this layer] false)
    3.35       (hovered? [this layer] false)
    3.36       MouseListener
    3.37       (mouseEntered [this event]
    3.38 -                   (dispatch-mouse-motion hovered context-tree event))
    3.39 +        (dispatch-mouse-motion hovered context-tree event))
    3.40       (mouseExited [this event]
    3.41 -                  (dispatch-mouse-motion hovered context-tree event))
    3.42 +        (dispatch-mouse-motion hovered context-tree event))
    3.43       (mouseClicked [this event]
    3.44 -                   (dispatch-mouse-button picked hovered context-tree event))
    3.45 +        (dispatch-mouse-button picked hovered context-tree event))
    3.46       (mousePressed [this event]
    3.47 -                   (dispatch-mouse-button picked hovered context-tree event))
    3.48 +        (dispatch-mouse-button picked hovered context-tree event))
    3.49       (mouseReleased [this event]
    3.50 -                    (dispatch-mouse-button picked hovered context-tree event))
    3.51 +        (dispatch-mouse-button picked hovered context-tree event))
    3.52       MouseMotionListener
    3.53       (mouseDragged [this event]
    3.54 -                   (translate-and-dispatch @picked event))
    3.55 +        (translate-and-dispatch @picked event))
    3.56       (mouseMoved [this event]
    3.57 -                 (dispatch-mouse-motion hovered context-tree event)))))
    3.58 +        (dispatch-mouse-motion hovered context-tree event)))))
    3.59