1.1 --- a/src/indyvon/component.clj	Sat Jun 19 04:27:29 2010 +0400
     1.2 +++ b/src/indyvon/component.clj	Sat Jun 19 06:50:24 2010 +0400
     1.3 @@ -5,8 +5,8 @@
     1.4  ;;
     1.5  
     1.6  (ns indyvon.component
     1.7 -  (:use indyvon.core
     1.8 -        indyvon.event)
     1.9 +  (:use indyvon.core)
    1.10 +  (:require (indyvon [event :as event]))
    1.11    (:import (java.awt Component Dimension Color)
    1.12             (java.awt.event MouseEvent)
    1.13             (javax.swing JFrame JPanel)))
    1.14 @@ -21,6 +21,7 @@
    1.15          context (assoc context
    1.16                    :font-context (.getFontRenderContext graphics)
    1.17                    :update-fn #(.repaint component))]
    1.18 +    (.clearRect graphics 0 0 width height)
    1.19      (draw! context layer graphics 0 0 width height false))
    1.20    (commit (:dispatcher context)))
    1.21  
    1.22 @@ -32,7 +33,7 @@
    1.23  
    1.24  (defn make-jpanel
    1.25    ([layer]
    1.26 -     (make-jpanel layer (make-event-dispatcher)))
    1.27 +     (make-jpanel layer (event/make-event-dispatcher)))
    1.28    ([layer event-dispatcher]
    1.29       (let [context (default-context)
    1.30             context (assoc context :dispatcher event-dispatcher)
    1.31 @@ -47,45 +48,73 @@
    1.32         panel)))
    1.33  
    1.34  (comment
    1.35 -  (do 
    1.36 +  (do
    1.37      (def frame (JFrame. "Test"))
    1.38      
    1.39 -    (defn handler [context event]
    1.40 +    (defn handler [event context]
    1.41        (println (:layer context) (.paramString event)))
    1.42        
    1.43      (def layer1
    1.44 -         (reify Layer
    1.45 +         (reify
    1.46 +          Layer
    1.47            (render! [this context g]
    1.48 -             (mouse-handler context handler)
    1.49               (.setColor g Color/RED)
    1.50               (.fillRect g 0 0 (:width context) (:height context)))
    1.51            (size [this context] [30 20])
    1.52 -          (toString [this] "layer1")))
    1.53 +          MouseHandler
    1.54 +          (handle-mouse [this context event]
    1.55 +             (println "layer1" (.paramString event)))))
    1.56      
    1.57      (def layer1b (border-layer layer1 2 3))
    1.58      
    1.59      (def layer2
    1.60 -         (reify Layer
    1.61 +         (reify
    1.62 +          Layer
    1.63            (render! [this context g]
    1.64 -             (mouse-handler context handler)
    1.65               (.setColor g Color/YELLOW)
    1.66               (.fillRect g 0 0 (:width context) (:height context))
    1.67               (draw! context layer1b g 10 5)
    1.68               (draw! context layer1 g 55 5))
    1.69            (size [this context] [70 65])
    1.70 -          (toString [this] "layer2")))
    1.71 +          MouseHandler
    1.72 +          (handle-mouse [this context event]
    1.73 +             (println "layer2" (.paramString event)))))
    1.74      
    1.75      (def layer3
    1.76 -         (border-layer (text-layer "Sample\ntext" :right :bottom)))
    1.77 +         (border-layer (text-layer "Sample\ntext" :right :center)))
    1.78 +
    1.79 +    (defn fps-layer [fps]
    1.80 +      (border-layer (text-layer (format "%.1f" fps) :right :bottom) 0 5))
    1.81 +    
    1.82 +    (def fps
    1.83 +         (let [update-interval 0.1
    1.84 +               frames (ref 0)
    1.85 +               last (ref 0)
    1.86 +               fl (ref (fps-layer 0.0))]
    1.87 +           (reify
    1.88 +            Layer
    1.89 +            (render! [this c g]
    1.90 +               (draw! c @fl g)
    1.91 +               (dosync
    1.92 +                (alter frames + 1)
    1.93 +                (let [time (System/currentTimeMillis)
    1.94 +                      elapsed (/ (- time @last) 1000.0)]
    1.95 +                  (when (> elapsed update-interval)
    1.96 +                    (ref-set fl (fps-layer (/ @frames elapsed)))
    1.97 +                    (ref-set frames 0)
    1.98 +                    (ref-set last time)))))
    1.99 +            (size [this c] (size @fl c)))))
   1.100      
   1.101      (def layer
   1.102           (reify Layer
   1.103 -          (render! [this context g]
   1.104 +           (render! [this context g]
   1.105 +             ;;(update context)
   1.106 +             (.setColor g (rand-nth [Color/BLACK Color/BLUE Color/RED]))       
   1.107               (.drawLine g 0 0 (:width context) (:height context))
   1.108               (draw! context layer2 g 15 20)
   1.109 -             (draw! context layer3 g 100 100 80 50))
   1.110 -          (size [this context] [400 300])
   1.111 -          (toString [this] "layer")))
   1.112 +             (draw! context layer3 g 100 100 80 50)
   1.113 +             (draw! context fps g))
   1.114 +           (size [this context] [400 300])))
   1.115      
   1.116      (doto frame
   1.117        (.addWindowListener

     2.1 --- a/src/indyvon/core.clj	Sat Jun 19 04:27:29 2010 +0400
     2.2 +++ b/src/indyvon/core.clj	Sat Jun 19 06:50:24 2010 +0400
     2.3 @@ -9,9 +9,21 @@
     2.4             (java.awt.font FontRenderContext TextLayout)))
     2.5  
     2.6  (defprotocol Layer
     2.7 +  "Basic UI element."
     2.8    (render! [this context graphics])
     2.9    (size [this context]))
    2.10  
    2.11 +(defprotocol MouseHandler
    2.12 +  "Layers that also satisfy this protocol will recieve mouse events."
    2.13 +  (handle-mouse [this context event]))
    2.14 +
    2.15 +(defprotocol EventDispatcher
    2.16 +  (listen! [this component])
    2.17 +  (register [this context])
    2.18 +  (commit [this])
    2.19 +  (hovered? [this layer])
    2.20 +  (picked? [this layer]))
    2.21 +
    2.22  (defrecord Theme [fore-color back-color border-color font])
    2.23  
    2.24  (defn default-theme []
    2.25 @@ -23,6 +35,9 @@
    2.26  (defn default-context []
    2.27    (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme)))
    2.28  
    2.29 +(defn update [context]
    2.30 +  ((:update-fn context)))
    2.31 +
    2.32  (defn- make-graphics [graphics x y w h clip]
    2.33    (if clip
    2.34      (.create graphics x y w h)
    2.35 @@ -49,18 +64,18 @@
    2.36       (draw! context layer graphics
    2.37              x y w h true))
    2.38    ([context layer graphics x y w h clip]
    2.39 -     (let [graphics (make-graphics graphics x y w h clip)
    2.40 +     (let [context (assoc context
    2.41 +                     :layer layer
    2.42 +                     :parent context
    2.43 +                     :x (+ (:x context) x)
    2.44 +                     :y (+ (:y context) y)
    2.45 +                     :width w
    2.46 +                     :height h)
    2.47 +           graphics (make-graphics graphics x y w h clip)
    2.48             graphics (apply-theme graphics (:theme context))]
    2.49         (try
    2.50 -         (render! layer
    2.51 -                  (assoc context
    2.52 -                    :layer layer
    2.53 -                    :parent context
    2.54 -                    :x (+ (:x context) x)
    2.55 -                    :y (+ (:y context) y)
    2.56 -                    :width w
    2.57 -                    :height h)
    2.58 -                  graphics)
    2.59 +         (register (:dispatcher context) context)
    2.60 +         (render! layer context graphics)
    2.61           (finally
    2.62            (.dispose graphics))))))
    2.63  

     3.1 --- a/src/indyvon/event.clj	Sat Jun 19 04:27:29 2010 +0400
     3.2 +++ b/src/indyvon/event.clj	Sat Jun 19 06:50:24 2010 +0400
     3.3 @@ -9,19 +9,6 @@
     3.4    (:import (java.awt.event MouseEvent MouseListener MouseMotionListener)
     3.5             java.lang.ref.WeakReference))
     3.6  
     3.7 -(defprotocol EventDispatcher
     3.8 -  (listen! [this component])
     3.9 -  (register-mouse-handler [this context handler])
    3.10 -  (commit [this])
    3.11 -  (hovered? [this layer])
    3.12 -  (picked? [this layer]))
    3.13 -
    3.14 -(defn mouse-handler [context handler & args]
    3.15 -  "The supplied handler function will be invoked with context, event
    3.16 -   and additional args when mouse event occurs on the context."
    3.17 -  (let [handler (if args #(apply handler %1 %2 args) handler)]
    3.18 -    (register-mouse-handler (:dispatcher context) context handler)))
    3.19 -
    3.20  (defn- registered-parent
    3.21    "Returns first context parent registered for event processing."
    3.22    [context-tree context]
    3.23 @@ -72,23 +59,19 @@
    3.24      (getXOnScreen [] (.getXOnScreen event))
    3.25      (getYOnScreen [] (.getYOnScreen event))))
    3.26  
    3.27 -(defn- dispatch-event [handlers context event]
    3.28 -  ((handlers context) context event))
    3.29 -
    3.30  (defn- translate-and-dispatch
    3.31 -  ([contexts handlers event]
    3.32 -     (translate-and-dispatch contexts handlers event (.getID event)))
    3.33 -  ([contexts handlers event id]
    3.34 -  (doseq [context contexts]
    3.35 -    (dispatch-event
    3.36 -     handlers
    3.37 -     context
    3.38 -     (translate-mouse-event event (:x context) (:y context) id)))))
    3.39 +  ([contexts event]
    3.40 +     (translate-and-dispatch contexts event (.getID event)))
    3.41 +  ([contexts event id]
    3.42 +     (doseq [context contexts]
    3.43 +       (handle-mouse
    3.44 +        (:layer context) context 
    3.45 +        (translate-mouse-event event (:x context) (:y context) id)))))
    3.46  
    3.47  (defn- dispatch-mouse-motion*
    3.48    "Dispatches mouse motion events. Returns a new set of contexts which
    3.49    currently are under cursor."
    3.50 -  [hovered context-tree handlers event]
    3.51 +  [hovered context-tree event]
    3.52    (let [x (.getX event)
    3.53          y (.getY event)
    3.54          hovered2 (under-cursor context-tree x y)
    3.55 @@ -96,39 +79,33 @@
    3.56          exited (remove-all hovered hovered2 pred)
    3.57          entered (remove-all hovered2 hovered pred)
    3.58          moved (remove-all hovered2 entered pred)]
    3.59 -    (translate-and-dispatch
    3.60 -     exited handlers event MouseEvent/MOUSE_EXITED)
    3.61 -    (translate-and-dispatch
    3.62 -     entered handlers event MouseEvent/MOUSE_ENTERED)
    3.63 -    (translate-and-dispatch
    3.64 -     moved handlers event MouseEvent/MOUSE_MOVED)
    3.65 +    (translate-and-dispatch exited event MouseEvent/MOUSE_EXITED)
    3.66 +    (translate-and-dispatch entered event MouseEvent/MOUSE_ENTERED)
    3.67 +    (translate-and-dispatch moved event MouseEvent/MOUSE_MOVED)
    3.68      hovered2))
    3.69  
    3.70  (defn- dispatch-mouse-motion
    3.71 -  [hovered-ref context-tree handlers event]
    3.72 +  [hovered-ref context-tree event]
    3.73    (dosync
    3.74 -   (alter hovered-ref dispatch-mouse-motion* context-tree handlers event)))
    3.75 +   (alter hovered-ref dispatch-mouse-motion* context-tree event)))
    3.76  
    3.77  (defn- dispatch-mouse-button*
    3.78    "Dispatches mouse button events. Returns a new set of contexts which
    3.79    currently are picked with a pressed button."
    3.80 -  [picked hovered handlers event]
    3.81 -  (translate-and-dispatch hovered handlers event)
    3.82 +  [picked hovered event]
    3.83 +  (translate-and-dispatch hovered event)
    3.84    (if (= (.getID event) MouseEvent/MOUSE_PRESSED)
    3.85      hovered
    3.86      nil))
    3.87  
    3.88  (defn- dispatch-mouse-button
    3.89 -  [picked-ref hovered-ref handlers event]
    3.90 +  [picked-ref hovered-ref event]
    3.91    (dosync
    3.92 -   (alter picked-ref dispatch-mouse-button*
    3.93 -          @hovered-ref handlers event)))
    3.94 +   (alter picked-ref dispatch-mouse-button* @hovered-ref event)))
    3.95  
    3.96  (defn make-event-dispatcher []
    3.97    (let [context-tree-r (ref {}) ; register
    3.98 -        handlers-r (ref {})     ;
    3.99          context-tree (ref {})   ; dispatch
   3.100 -        handlers (ref {})       ;
   3.101          hovered (ref '())
   3.102          picked (ref '())]
   3.103      (reify
   3.104 @@ -137,29 +114,27 @@
   3.105          (doto component
   3.106            (.addMouseListener this)
   3.107            (.addMouseMotionListener this)))
   3.108 -     (register-mouse-handler [this context handler]
   3.109 -        (dosync (alter context-tree-r add-context context)
   3.110 -                (alter handlers-r assoc context handler)))
   3.111 +     (register [this context]
   3.112 +        (when (satisfies? MouseHandler (:layer context))
   3.113 +          (dosync (alter context-tree-r add-context context))))
   3.114       (commit [this]
   3.115          (dosync (ref-set context-tree @context-tree-r)
   3.116 -                (ref-set context-tree-r {})
   3.117 -                (ref-set handlers @handlers-r)
   3.118 -                (ref-set handlers-r {})))
   3.119 +                (ref-set context-tree-r {})))
   3.120       (picked? [this layer] false)
   3.121       (hovered? [this layer] false)
   3.122       MouseListener
   3.123       (mouseEntered [this event]
   3.124 -        (dispatch-mouse-motion hovered context-tree handlers event))
   3.125 +        (dispatch-mouse-motion hovered @context-tree event))
   3.126       (mouseExited [this event]
   3.127 -        (dispatch-mouse-motion hovered context-tree handlers event))
   3.128 +        (dispatch-mouse-motion hovered @context-tree event))
   3.129       (mouseClicked [this event]
   3.130 -        (dispatch-mouse-button picked hovered handlers event))
   3.131 +        (dispatch-mouse-button picked hovered event))
   3.132       (mousePressed [this event]
   3.133 -        (dispatch-mouse-button picked hovered handlers  event))
   3.134 +        (dispatch-mouse-button picked hovered event))
   3.135       (mouseReleased [this event]
   3.136 -        (dispatch-mouse-button picked hovered handlers event))
   3.137 +        (dispatch-mouse-button picked hovered event))
   3.138       MouseMotionListener
   3.139       (mouseDragged [this event]
   3.140 -        (translate-and-dispatch @picked handlers event))
   3.141 +        (translate-and-dispatch @picked event))
   3.142       (mouseMoved [this event]
   3.143 -        (dispatch-mouse-motion hovered context-tree handlers event)))))
   3.144 +        (dispatch-mouse-motion hovered @context-tree event)))))