--- a/src/indyvon/component.clj	Sun Jul 04 06:03:48 2010 +0400
+++ b/src/indyvon/component.clj	Mon Jul 05 06:11:42 2010 +0400
@@ -5,46 +5,45 @@
 ;;
 
 (ns indyvon.component
-  (:use indyvon.core indyvon.layers)
+  (:use indyvon.core)
   (:import (java.awt Component Dimension Color)
            (javax.swing JFrame JPanel)))
 
 (defn- font-context [component]
   (.getFontRenderContext (.getFontMetrics component (.getFont component))))
 
-(defn paint-component [component layer context graphics]
+(defn paint-component [component layer graphics event-dispatcher]
   (let [size (.getSize component)
         width (.width size)
-        height (.height size)
-        context (assoc context
-                  :target component
-                  :font-context (.getFontRenderContext graphics)
-                  :update-fn #(.repaint component))]
+        height (.height size)]
     (.clearRect graphics 0 0 width height)
-    (draw! layer context graphics 0 0 width height false))
-  (commit (:dispatcher context)))
+    (binding [*path* nil
+              *graphics* graphics
+              *font-context*' (.getFontRenderContext graphics)
+              *event-dispatcher* event-dispatcher
+              *update* #(.repaint component)
+              *bounds* (indyvon.core.Bounds. 0 0 width height)]
+      (render! layer nil)
+      (commit event-dispatcher))))
 
-(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))))
+(defn preferred-size [component layer]
+  (binding [*path* nil
+            *font-context*' (font-context component)]
+    (let [s (size layer nil)]
+      (Dimension. (:width s) (:height s)))))
 
 (defn make-jpanel
   ([layer]
      (make-jpanel layer (make-event-dispatcher)))
   ([layer event-dispatcher]
-     (let [context (default-context)
-           context (assoc context :dispatcher event-dispatcher)
-           panel
+     (let [panel
            (proxy [JPanel] []
              (paintComponent [g]
-                (paint-component this layer context g))
+                (paint-component this layer g event-dispatcher))
              (getPreferredSize []
-                (preferred-size this layer context)))]
+                (preferred-size this layer)))]
+       (.setBackground panel (:back-color *theme*))
        (listen! event-dispatcher panel)
-       (.setBackground panel (-> context :theme :back-color))
        panel)))
 
 (comment

--- a/src/indyvon/core.clj	Sun Jul 04 06:03:48 2010 +0400
+++ b/src/indyvon/core.clj	Mon Jul 05 06:11:42 2010 +0400
@@ -8,145 +8,92 @@
   (:import (java.awt Color Font)
            (java.awt.event MouseListener MouseMotionListener)))
 
-(def *context*)
-(def *graphics*)
-
+(defrecord Location [x y])
 (defrecord Size [width height])
 (defrecord Bounds [x y width height])
 
+(def *graphics*)
 (def *font-context*)
 (def *bounds*)
-(def *theme*)
 (def *target*)
 (def *update*)
 (def *event-dispatcher*)
+(def *path*)
+
+(defrecord Theme [fore-color back-color border-color font])
+     
+(defn- default-theme []
+  (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
+
+(def *theme* (default-theme))
 
 (defprotocol Layer
   "Basic UI element."
-  (render! [this context graphics])
-  (size [this context]))
+  (render! [this opts])
+  (size [this opts]))
+
+(defn layer? [x]
+  (satisfies? Layer x)) 
+
+(defprotocol EventDispatcher
+  (listen! [this component])
+  (register [this handle-path])
+  (handler [this handle-path event-id f])
+  (commit [this]))
 
 ;; TODO: modifiers
 (defrecord MouseEvent [id when x y x-on-screen y-on-screen button])
 
-(defprotocol MouseHandler
-  "Layers that also satisfy this protocol will recieve mouse events."
-  (handle-mouse [this context event]))
-
-(defprotocol EventDispatcher
-  (listen! [this component])
-  (register [this context])
-  (commit [this])
-  (hovered? [this layer])
-  (picked? [this layer]))
-
-(defprotocol Anchored
-  "Provide anchor point for Layers. Used by viewport."
-  (anchor [this context h-align v-align]
-          "Anchor point: [x y], h-align could be :left, :center
-           or :right, v-align is :top, :center or :bottom"))
+(defn- apply-theme [graphics]
+  (doto graphics
+    (.setColor (:fore-color *theme*))
+    (.setFont (:font *theme*))))
 
-;; Default implementation of Anchored for any Layer.
-(extend-protocol Anchored
-  indyvon.core.Layer
-  (anchor [this context h-align v-align]
-          (if (and (= h-align :left)
-                   (= v-align :top))
-            [0 0]
-            (let [size (size this context)]
-              [(case h-align
-                 :top 0
-                 :center (/ (size 0) 2)
-                 :right (size 0))
-               (case v-align
-                 :left 0
-                 :center (/ (size 1) 2)
-                 :bottom (size 1))]))))
-
-(defrecord Theme [fore-color back-color border-color font])
+(defn with-translate* [x y w h f & args]
+  (let [graphics (apply-theme (.create *graphics* x y w h))]
+    (try
+      (apply with-bindings* {#'*bounds* (Bounds. (+ x (:x *bounds*))
+                                                 (+ y (:y *bounds*))
+                                                 w h)
+                             #'*graphics* graphics}
+             f args)
+      (finally
+       (.dispose graphics)))))
 
-(defn default-theme []
-  (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
-  
-(defrecord LayerContext
-  [handle           ; Identifies context for dispatching mouse
-                    ; entered/exited and mainaining keyboard focus.
-   parent           ; Parent context.
-   x y width height ; Geometry.
-   update-fn        ; Call to request repaint.
-   dispatcher       ; Event dispatcher.
-   font-context     ; An instance of java.awt.font.FontRenderContext.
-   theme            ; An instance of Theme.
-   target           ; Component.
-   handlers])       ; Map: event-id -> handler fn.
+(defmacro with-translate [x y w h & body]
+  `(with-translate* ~x ~y ~w ~h (fn [] ~@body)))
 
-(defn default-context []
-  (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme) nil nil))
-
-(defn update [context]
-  ((:update-fn context)))
+(defn with-handle* [handle f & args]
+  (let [path (cons handle *path*)]
+    (register *event-dispatcher* path)
+    (apply with-bindings* {#'*path* path} f args)))
 
-(defn- make-graphics [graphics x y w h clip]
-  (if clip
-    (.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))))
+(defmacro with-handle [handle & body]
+  `(with-handle* ~handle (fn [] ~@body)))
 
-;; (defn with-context* [opts fn & args]
-;;   (let [context (apply assoc *context*
-;;                        :parent *context*
-;;                        :handlers nil
-;;                        opts)
-;;         graphics (make-graphics *graphics* x y w h false)
-;;         graphics (apply-theme graphics (:theme context))]
-;;     (try
-;;       (register (:dispatcher context) context)
-;;       (with-bindings* {#'*context* context
-;;                        #'*graphics* graphics}
-;;         fn args)
-;;       (finally
-;;        (.dispose graphics)))))
+(defn handle-event* [event-id f & args]
+  (let [f (if args #(f % args) f)]
+    (handler *event-dispatcher* *path* event-id f)))
 
-;; (defmacro with-context [opts & body]
-;;   `(with-context* ~opts #(~@body)))
+(defmacro handle-event [event-id name & body]
+  `(handle-event* ~event-id (fn [~name] ~@body)))
 
-(defn draw!
-  "Render layer in a new graphics context."
-  ([layer context graphics]
-     (draw! layer context graphics
-                    0 0 (:width context) (:height context)))
-  ([layer context graphics x y]
-     (draw! layer context graphics x y true))
-  ([layer context graphics x y clip]
-     (let [s (size layer context)]
-       (draw! layer context graphics
-              x y (s 0) (s 1) clip)))
-  ([layer context graphics x y w h]
-     (draw! layer context graphics
-            x y w h true))
-  ([layer context graphics x y w h clip]
-     (let [context (assoc context
-                     :handle layer
-                     :parent context
-                     :x (+ (:x context) x)
-                     :y (+ (:y context) y)
-                     :width w
-                     :height h)
-           graphics (make-graphics graphics x y w h clip)
-           graphics (apply-theme graphics (:theme context))]
-       (try
-         (register (:dispatcher context) context)
-         (render! layer context graphics)
-         (finally
-          (.dispose graphics))))))
+(defn- geometry-vec [geometry]
+  (if (vector? geometry)
+    geometry
+    [(:x geometry) (:y geometry) (:width geometry) (:height geometry)]))
+
+(defn draw! [layer geometry & args]
+  "Draw a layer. Geometry is either a map or vector [x y] or
+   [x y width height]."
+  (let [[x y w h] (geometry-vec geometry)
+        size (if-not (and w h) (size layer args))
+        w (or w (:width size))
+        h (or h (:height size))]
+    (with-translate* x y w h render! layer args)))
 
 ;;
-;; EventDispatcher implementation
+;; EventDispatcher
 ;;
 
 (def awt-events
@@ -158,25 +105,28 @@
       java.awt.event.MouseEvent/MOUSE_PRESSED  :mouse-pressed
       java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released})
 
-(defn- registered-parent
-  "Returns first context parent registered for event processing."
-  [context-tree context]
-  (let [parent (:parent context)]
-    (cond
-     (nil? parent) nil
-     (contains? context-tree parent) parent
-     :default (recur context-tree parent))))
+(defrecord DispatcherNode [id bounds children handlers])
+
+(defn- add-child [node child]
+  (assoc node :children (cons child (:children node))))
 
-(defn- add-context
-  [context-tree context]
-  (let [parent (registered-parent context-tree context)]
-    (assoc context-tree parent (cons context (context-tree parent))
-           context nil)))
+(defn- add-path [tree path]
+  (let [parent-path (next path)
+        parent-node (get tree parent-path)
+        node (DispatcherNode. path *bounds* nil
+                              (get-in tree [path :handlers]))]
+    (assoc tree
+      parent-path (add-child parent-node node)
+      path node)))
+
+(defn add-handler [tree path event-id f]
+  (let [keys [path :handlers event-id]]
+  (assoc-in tree keys (cons f (get-in tree keys)))))
 
 (defn- inside?
-  ([x y context]
-     (inside? x y (:x context) (:y context)
-              (:width context) (:height context)))
+  ([x y bounds]
+     (inside? x y (:x bounds) (:y bounds)
+              (:width bounds) (:height bounds)))
   ([px py x y w h]
      (and (>= px x)
           (>= py y)
@@ -184,13 +134,13 @@
           (< py (+ y h)))))
 
 (defn- under-cursor
-  "Returns a sequence of contexts under cursor."
-  ([context-tree x y]
-     (under-cursor context-tree x y nil))
-  ([context-tree x y context]
-     (some #(if (inside? x y %)
-              (conj (under-cursor context-tree x y %) %))
-           (context-tree context))))
+  "Returns a sequence of nodes under cursor."
+  ([tree x y]
+     (under-cursor tree x y nil))
+  ([tree x y node]
+     (some #(if (inside? x y (:bounds %))
+              (conj (under-cursor tree x y %) %))
+           (get tree (:children node)))))
 
 (defn- remove-all [coll1 coll2 pred]
   (filter #(not (some (partial pred %) coll2)) coll1))
@@ -203,30 +153,26 @@
                (.getButton event)))
 
 (defn- translate-and-dispatch
-  ([contexts event]
-     (translate-and-dispatch contexts event (awt-events (.getID event))))
-  ([contexts event id]
-     (doseq [context contexts]
-       (if-let [handler (get (:handlers context) id)]
-         (handler context (translate-mouse-event
-                           event (:x context) (:y context) id))))
+  ([nodes event]
+     (translate-and-dispatch nodes event (awt-events (.getID event))))
+  ([nodes event id]
+     (doseq [node nodes
+             :let [bounds (:bounds node)
+                   event (translate-mouse-event event
+                           (:x bounds) (:y bounds) id)]
+             handler (get (:handlers node) id)]
+       ;; TODO restore more of the original context.
+       (with-bindings* {#'*bounds* bounds} handler event))
      id))
 
-(defn- context-id [context]
-  (loop [context context
-         id nil]
-    (if context
-      (recur (:parent context) (cons (:handle context) id))
-      id)))
-
 (defn- dispatch-mouse-motion*
-  "Dispatches mouse motion events. Returns a new set of contexts which
+  "Dispatches mouse motion events. Returns a new set of nodes which
   currently are under cursor."
-  [hovered context-tree event]
+  [hovered tree event]
   (let [x (.getX event)
         y (.getY event)
-        hovered2 (under-cursor context-tree x y)
-        pred #(= (context-id %1) (context-id %2))
+        hovered2 (under-cursor tree x y)
+        pred #(= (:id %1) (:id %2))
         exited (remove-all hovered hovered2 pred)
         entered (remove-all hovered2 hovered pred)
         moved (remove-all hovered2 entered pred)]
@@ -236,12 +182,12 @@
     hovered2))
 
 (defn- dispatch-mouse-motion
-  [hovered-ref context-tree event]
+  [hovered-ref tree event]
   (dosync
-   (alter hovered-ref dispatch-mouse-motion* context-tree event)))
+   (alter hovered-ref dispatch-mouse-motion* tree event)))
 
 (defn- dispatch-mouse-button*
-  "Dispatches mouse button events. Returns a new set of contexts which
+  "Dispatches mouse button events. Returns a new set of nodes which
   currently are picked with a pressed button."
   [picked hovered event]
   (if (= (translate-and-dispatch hovered event) :mouse-pressed)
@@ -254,8 +200,10 @@
    (alter picked-ref dispatch-mouse-button* @hovered-ref event)))
 
 (defn make-event-dispatcher []
-  (let [context-tree-r (ref {}) ; register
-        context-tree (ref {})   ; dispatch
+  (let [root-node (DispatcherNode. nil nil nil nil)
+        tree-i {nil root-node} ; initial
+        tree-r (ref tree-i)    ; register
+        tree (ref tree-i)      ; dispatch
         hovered (ref '())
         picked (ref '())]
     (reify
@@ -264,19 +212,18 @@
         (doto component
           (.addMouseListener this)
           (.addMouseMotionListener this)))
-     (register [this context]
-        (if (:handlers context)
-          (dosync (alter context-tree-r add-context context))))
+     (register [this path]
+        (dosync (alter tree-r add-path path)))
+     (handler [this path event-id f]
+        (dosync (alter tree-r add-handler path event-id f)))
      (commit [this]
-        (dosync (ref-set context-tree @context-tree-r)
-                (ref-set context-tree-r {})))
-     (picked? [this layer] false)
-     (hovered? [this layer] false)
+        (dosync (ref-set tree @tree-r)
+                (ref-set tree-r tree-i)))
      MouseListener
      (mouseEntered [this event]
-        (dispatch-mouse-motion hovered @context-tree event))
+        (dispatch-mouse-motion hovered @tree event))
      (mouseExited [this event]
-        (dispatch-mouse-motion hovered @context-tree event))
+        (dispatch-mouse-motion hovered @tree event))
      (mouseClicked [this event]
         (dispatch-mouse-button picked hovered event))
      (mousePressed [this event]
@@ -287,4 +234,29 @@
      (mouseDragged [this event]
         (translate-and-dispatch @picked event))
      (mouseMoved [this event]
-        (dispatch-mouse-motion hovered @context-tree event)))))
+        (dispatch-mouse-motion hovered @tree event)))))
+
+;;
+;; ИДЕИ:
+;;
+;; Контекст: биндинги или запись?
+;;
+;; Установка обработчиков (в контексте слоя):
+;;
+;; (listen
+;;   (:mouse-entered e
+;;     ...)
+;;   (:mouse-exited e
+;;     ...))
+;;
+;; Не надо IMGUI.
+;; Построение сцены путем декорирования слоев:
+;;
+;; (listener
+;;  (:action e (println e))
+;;  (:mouse-dragged e (println e))
+;;  (theme :font "Helvetica-14"
+;;    (vbox
+;;      (button (text-layer "Button 1"))
+;;      (button (text-layer "Button 2")))))
+;;

--- a/src/indyvon/core_new.clj	Sun Jul 04 06:03:48 2010 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,228 +0,0 @@
-;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
-;;
-;; This file is part of Indyvon.
-;;
-
-(ns indyvon.core_new
-  (:import (java.awt Color Font)
-           (java.awt.event MouseListener MouseMotionListener)))
-
-(defrecord Location [x y])
-(defrecord Size [width height])
-(defrecord Bounds [x y width height])
-
-(def *graphics*)
-(def *font-context*)
-(def *bounds*)
-(def *theme*)
-(def *target*)
-(def *update*)
-(def *event-dispatcher*)
-(def *path*)
-
-(defprotocol Layer
-  "Basic UI element."
-  (render! [this opts])
-  (size [this opts]))
-
-(defn layer? [x]
-  (satisfies? Layer x)) 
-
-(defprotocol EventDispatcher
-  (listen! [this component])
-  (register [this handle-path])
-  (handler [this handle-path event-id f])
-  (commit [this]))
-
-;; TODO: modifiers
-(defrecord MouseEvent [id when x y x-on-screen y-on-screen button])
-
-(defn with-translate* [x y w h f & args]
-  (let [graphics (.create *graphics* x y w h)]  
-    (try
-      (apply with-bindings* {#'*bounds* (Bounds. (+ x (:x *bounds*))
-                                                 (+ y (:y *bounds*))
-                                                 w h)
-                             #'*graphics* graphics}
-             f args)
-      (finally
-       (.dispose graphics)))))
-
-(defn with-handle* [handle f & args]
-  (let [path (cons handle *path*)]
-    (register *event-dispatcher* path)
-    (apply with-bindings* {#'*path* path} f args)))
-
-(defn- geometry-vec [geometry]
-  (if (vector? geometry)
-    geometry
-    [(:x geometry) (:y geometry) (:width geometry) (:height geometry)]))
-
-(defn draw! [layer geometry & args]
-  "Draw a layer. Geometry is either a map or vector [x y] or
-   [x y width height]."
-  (let [[x y w h] (geometry-vec geometry)
-        size (if-not (and w h) (size layer args))
-        w (or w (:width size))
-        h (or h (:height size))]
-    (with-translate* x y w h render! layer args)))
-
-(defn draw-root! [layer width height graphics event-dispatcher]
-  (with-bindings* {#'*path* nil
-                   #'*graphics* graphics
-                   #'*event-dispatcher* event-dispatcher
-                   #'*bounds* (Bounds. 0 0 width height)}
-    render! layer))
-
-;;
-;; EventDispatcher
-;;
-
-(def awt-events
-     {java.awt.event.MouseEvent/MOUSE_CLICKED  :mouse-clicked
-      java.awt.event.MouseEvent/MOUSE_DRAGGED  :mouse-dragged
-      java.awt.event.MouseEvent/MOUSE_ENTERED  :mouse-entered
-      java.awt.event.MouseEvent/MOUSE_EXITED   :mouse-exited
-      java.awt.event.MouseEvent/MOUSE_MOVED    :mouse-moved
-      java.awt.event.MouseEvent/MOUSE_PRESSED  :mouse-pressed
-      java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released})
-
-(defrecord DispatcherNode [id bounds children handlers])
-
-(defn- add-child [node child]
-  (assoc node :children (cons child (:children node))))
-
-(defn- add-path [tree path]
-  (let [parent-path (next path)
-        parent-node (get tree parent-path)
-        node (DispatcherNode. path *bounds* nil
-                              (get-in tree [path :handlers]))]
-    (assoc tree
-      parent-path (add-child parent-node node)
-      path node)))
-
-(defn add-handler [tree path event-id f]
-  (let [keys [path :handlers event-id]]
-  (assoc-in tree keys (cons f (get-in tree keys)))))
-
-(defn- inside?
-  ([x y bounds]
-     (inside? x y (:x bounds) (:y bounds)
-              (:width bounds) (:height bounds)))
-  ([px py x y w h]
-     (and (>= px x)
-          (>= py y)
-          (< px (+ x w))
-          (< py (+ y h)))))
-
-(defn- under-cursor
-  "Returns a sequence of nodes under cursor."
-  ([tree x y]
-     (under-cursor tree x y nil))
-  ([tree x y node]
-     (some #(if (inside? x y (:bounds %))
-              (conj (under-cursor tree x y %) %))
-           (get tree (:children node)))))
-
-(defn- remove-all [coll1 coll2 pred]
-  (filter #(not (some (partial pred %) coll2)) coll1))
-
-(defn- translate-mouse-event
-  [event x y id]
-  (MouseEvent. id (.getWhen event)
-               (- (.getX event) x) (- (.getY event) y)
-               (.getXOnScreen event) (.getYOnScreen event)
-               (.getButton event)))
-
-(defn- translate-and-dispatch
-  ([nodes event]
-     (translate-and-dispatch nodes event (awt-events (.getID event))))
-  ([nodes event id]
-     (doseq [node nodes
-             :let [bounds (:bounds node)
-                   event (translate-mouse-event event
-                           (:x bounds) (:y bounds) id)]
-             handler (get (:handlers node) id)]
-       ;; TODO restore more of the original context.
-       (with-bindings* {#'*bounds* bounds} handler event))
-     id))
-
-(defn- dispatch-mouse-motion*
-  "Dispatches mouse motion events. Returns a new set of nodes which
-  currently are under cursor."
-  [hovered tree event]
-  (let [x (.getX event)
-        y (.getY event)
-        hovered2 (under-cursor tree x y)
-        pred #(= (:id %1) (:id %2))
-        exited (remove-all hovered hovered2 pred)
-        entered (remove-all hovered2 hovered pred)
-        moved (remove-all hovered2 entered pred)]
-    (translate-and-dispatch exited event :mouse-exited)
-    (translate-and-dispatch entered event :mouse-entered)
-    (translate-and-dispatch moved event :mouse-moved)
-    hovered2))
-
-(defn- dispatch-mouse-motion
-  [hovered-ref tree event]
-  (dosync
-   (alter hovered-ref dispatch-mouse-motion* tree event)))
-
-(defn- dispatch-mouse-button*
-  "Dispatches mouse button events. Returns a new set of nodes which
-  currently are picked with a pressed button."
-  [picked hovered event]
-  (if (= (translate-and-dispatch hovered event) :mouse-pressed)
-    hovered
-    nil))
-
-(defn- dispatch-mouse-button
-  [picked-ref hovered-ref event]
-  (dosync
-   (alter picked-ref dispatch-mouse-button* @hovered-ref event)))
-
-(defn make-event-dispatcher []
-  (let [root-node (DispatcherNode. nil nil nil nil)
-        tree-i {nil root-node} ; initial
-        tree-r (ref tree-i)    ; register
-        tree (ref tree-i)      ; dispatch
-        hovered (ref '())
-        picked (ref '())]
-    (reify
-     EventDispatcher
-     (listen! [this component]
-        (doto component
-          (.addMouseListener this)
-          (.addMouseMotionListener this)))
-     (register [this path]
-        (dosync (alter tree-r add-path path)))
-     (handler [this path event-id f]
-        (dosync (alter tree-r add-handler path event-id f)))
-     (commit [this]
-        (dosync (ref-set tree @tree-r)
-                (ref-set tree-r tree-i)))
-     MouseListener
-     (mouseEntered [this event]
-        (dispatch-mouse-motion hovered @tree event))
-     (mouseExited [this event]
-        (dispatch-mouse-motion hovered @tree event))
-     (mouseClicked [this event]
-        (dispatch-mouse-button picked hovered event))
-     (mousePressed [this event]
-        (dispatch-mouse-button picked hovered event))
-     (mouseReleased [this event]
-        (dispatch-mouse-button picked hovered event))
-     MouseMotionListener
-     (mouseDragged [this event]
-        (translate-and-dispatch @picked event))
-     (mouseMoved [this event]
-        (dispatch-mouse-motion hovered @tree event)))))
-
-;; (with-handle :button1
-;;   (draw! button [5 5 100 200] "Cick Me!"))
-
-;; (when-event :action :button1
-;;     ...)
-
-;; (handle-event :mouse-entered :button1
-;;     ...)