Mercurial > hg > indyvon

changeset 10:9af27ccccfac

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Separated namespaces.
author Mikhail Kryshen <mikhail@kryshen.net>
date Sun, 13 Jun 2010 04:57:14 +0400
parents 160e9ec945a2
children ea6fc44f19c8
files project.clj src/indyvon/component.clj src/indyvon/core.clj src/indyvon/event.clj
diffstat 4 files changed, 240 insertions(+), 266 deletions(-) [+]
line wrap: on
line diff
--- a/project.clj	Sun Jun 13 02:49:09 2010 +0400
+++ b/project.clj	Sun Jun 13 04:57:14 2010 +0400
@@ -3,4 +3,6 @@
   :dependencies [[org.clojure/clojure "1.2.0-master-SNAPSHOT"]
                  [org.clojure/clojure-contrib "1.2.0-SNAPSHOT"]]
   :dev-dependencies [[leiningen/lein-swank "1.2.0-SNAPSHOT"]]
-  :namespaces [indyvon.core])
+  :namespaces [indyvon.core
+               indyvon.event
+               indyvon.component])
--- a/src/indyvon/component.clj	Sun Jun 13 02:49:09 2010 +0400
+++ b/src/indyvon/component.clj	Sun Jun 13 04:57:14 2010 +0400
@@ -1,54 +1,92 @@
-;; (ns indyvon.component
-;;   (:use indyvon.core)
-;;   (:import (java.awt Graphics Graphics2D Dimension AWTEvent))
-;;   (:gen-class
-;;    :name indyvon.IdvComponent
-;;    :extends java.awt.Component
-;;    :constructors {[indyvon.core.Layer] [],
-;;                   [indyvon.core.Layer indyvon.core.EventDispatcher] []}
-;;    :exposes-methods {enableEvents enableEventsSuper}
-;;    :state state
-;;    :init init
-;;    :post-init post-init))
+;;
+;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
+;;
+;; This file is part of Indyvon.
+;;
+
+(ns indyvon.component
+  (:use indyvon.core
+        indyvon.event)
+  (:import (java.awt Component Dimension Color)
+           (java.awt.event MouseEvent)))
+
+(defn- make-update-fn [component]
+  (fn [] (.repaint component)))
 
-;; (defrecord State [layer event])
-
-;; (defn- -init
-;;   ([layer]
-;;      [[] (State. layer (make-event-dispatcher))])
-;;   ([layer dispatcher]
-;;      [[] (State. layer dispatcher)]))
-
-;; (defn -enableEvents [this mask]
-;;   (.enableEventsSuper this mask))
+(defn make-component
+  ([layer]
+     (make-component layer (make-event-dispatcher)))
+  ([layer event-dispatcher]
+     (let [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))]
+                      (render-layer! 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)))))]
+       (listen! event-dispatcher component)
+       component)))
 
-;; (defn- -post-init [this & args]
-;;   (.enableEvents
-;;    this
-;;    ^long (reduce bit-or
-;;                  [AWTEvent/MOUSE_EVENT_MASK
-;;                   AWTEvent/MOUSE_MOTION_EVENT_MASK
-;;                   AWTEvent/MOUSE_WHEEL_EVENT_MASK
-;;                   AWTEvent/KEY_EVENT_MASK])))
-
-;; (defn- make-update-fn [component]
-;;   (fn [] (.repaint component)))
+(comment
+  (do 
+    (def frame (java.awt.Frame. "Test"))
+    (def layer1
+         (reify-layer
+          (render! [this context g]
+                   (register-context context)
+                   (.setColor g Color/WHITE)
+                   (.fillRect g 0 0 (:width context) (:height context)))
+          (size [this context] [30 20])))
+    (def layer2
+         (reify-layer
+          (render! [this context g]
+                   (register-context context)
+                   (.setColor g Color/BLUE)
+                   (.fillRect g 0 0 (:width context) (:height context))
+                   (render-layer! context layer1 g 10 5)
+                   (render-layer! context layer1 g 50 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))
+                   (render-layer! context layer2 g 15 20))
+          (size [this context] [100 100])))
+    (doto frame
+      (.addWindowListener
+       (proxy [java.awt.event.WindowAdapter] []
+         (windowClosing [event] (.dispose frame))))
+      (.add (make-component layer))
+      (.pack)
+      (.setVisible true))
 
-;; (defn -paint [this g]
-;;   (let [layer (-> this .state :layer)
-;;         size (.getSize this)
-;;         width (.width size)
-;;         height (.height size)]
-;;     (binding [*graphics* g
-;;               *update-fn* (make-update-fn this)]
-;;       (render-layer! layer 0 0 width height false))))
-
-;; (defn -update [this g]
-;;      (-paint this g))
-
-;; (defn -processEvent [this event]
-;;   (dispatch (-> this .state :dispatcher) event))
-
-;; (defn -getPreferredSize [this]
-;;   (let [s (-> this .state :layer size)]
-;;     (Dimension. (s 0) (s 1))))
+    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_ENTERED]
+      [layer context event]
+      (println "1 ENTERED"))
+    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_EXITED]
+      [layer context event]
+      (println "1 EXITED"))
+    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_MOVED]
+      [layer context event]
+      (println "1 MOVED"))
+    (defmethod handle-layer-event [layer2 MouseEvent/MOUSE_ENTERED]
+      [layer context event]
+      (println "2 ENTERED"))
+    (defmethod handle-layer-event [layer2 MouseEvent/MOUSE_EXITED]
+      [layer context event]
+      (println "2 EXITED"))
+    (defmethod handle-layer-event [layer2 MouseEvent/MOUSE_MOVED]
+      [layer context event]
+      (println "2 MOVED"))
+    )
+  )
--- a/src/indyvon/core.clj	Sun Jun 13 02:49:09 2010 +0400
+++ b/src/indyvon/core.clj	Sun Jun 13 04:57:14 2010 +0400
@@ -1,8 +1,10 @@
-(ns indyvon.core
-  (:require (clojure [set :as s]))
-  (:import (java.awt Dimension Point Component Graphics2D Color AWTEvent)
-           (java.awt.event MouseEvent MouseAdapter MouseMotionAdapter
-                           MouseListener MouseMotionListener)))
+;;
+;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
+;;
+;; This file is part of Indyvon.
+;;
+
+(ns indyvon.core)
 
 (defprotocol Layer
   (render! [this context graphics])
@@ -62,212 +64,3 @@
          (finally
           (.dispose graphics))))))
 
-;;
-;; Event handling
-;;
-
-(defmulti handle-layer-event 
-  (fn [layer context event]
-    [layer (.getID event)]))
-
-(defmethod handle-layer-event :default [layer context event])
-
-(defprotocol EventDispatcher
-  (register [this context])
-  (commit [this])
-  (hovered? [this layer])
-  (picked? [this layer]))
-
-(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))))
-
-(defn- register-context
-  [context-tree context]
-  (let [parent (registered-parent context-tree context)]
-    (assoc context-tree parent (conj (context-tree parent) context)
-           context nil)))
-
-(defn- inside?
-  ([x y context]
-     (inside? x y (:x context) (:y context)
-              (:width context) (:height context)))
-  ([px py x y w h]
-     (and (>= px x)
-          (>= py y)
-          (< px (+ x w))
-          (< 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))))
-
-(defn- remove-all [coll1 coll2 pred]
-  (filter #(not (some (partial pred %) coll2)) coll1))
-
-(defn- translate-mouse-event
-  [#^MouseEvent event x y id]
-  (proxy [MouseEvent] [(.getComponent event)
-                       id
-                       (.getWhen event)
-                       (.getModifiers event)
-                       (- (.getX event) x)
-                       (- (.getY event) y)
-                       (.getClickCount event)
-                       (.isPopupTrigger event)]
-    (getXOnScreen []
-                  (.getXOnScreen event))
-    (getYOnScreen []
-                  (.getYOnScreen event))))
-
-(defn- translate-and-dispatch
-  ([contexts event]
-     (translate-and-dispatch contexts event (.getID event)))
-  ([contexts event id]
-  (doseq [c contexts]
-    (handle-layer-event
-     (:layer c)
-     c
-     (translate-mouse-event event (:x c) (:y c) id)))))
-
-(defn- dispatch-mouse-motion*
-  "Dispatches mouse motion events. Returns a new set of contexts which
-  currently are under cursor."
-  [hovered context-tree #^MouseEvent event]
-  (let [x (.getX event)
-        y (.getY event)
-        hovered2 (under-cursor context-tree x y)
-        pred #(= (:layer %1) (:layer %2))
-        exited (remove-all hovered hovered2 pred)
-        entered (remove-all hovered2 hovered pred)
-        moved (remove-all hovered2 entered pred)]
-    (translate-and-dispatch exited event MouseEvent/MOUSE_EXITED)
-    (translate-and-dispatch entered event MouseEvent/MOUSE_ENTERED)
-    (translate-and-dispatch moved event MouseEvent/MOUSE_MOVED)
-    hovered2))
-
-(defn- dispatch-mouse-motion
-  [hovered-ref context-tree #^MouseEvent event]
-  (dosync
-   (alter hovered-ref dispatch-mouse-motion* context-tree event)))
-
-(defn make-event-dispatcher []
-  (let [context-tree-r (ref {}) ; register
-        context-tree (ref {})   ; dispatch
-        hovered (ref '())
-        picked (ref '())]
-    (reify
-     EventDispatcher
-     (register [this context]
-               (dosync (alter context-tree-r register-context context)))
-     (commit [this]
-             (dosync (ref-set context-tree @context-tree-r)
-                     (ref-set context-tree-r {})))
-     (picked? [this layer] false)
-     (hovered? [this layer] false)
-     MouseListener
-     (mouseClicked [this event])
-     (mouseEntered [this event]
-                   (dispatch-mouse-motion hovered context-tree event))
-     (mouseExited [this event]
-                  (dispatch-mouse-motion hovered context-tree event))
-     (mousePressed [this event])
-     (mouseReleased [this event])
-     MouseMotionListener
-     (mouseDragged [this event]
-                   (translate-and-dispatch @picked event))
-     (mouseMoved [this event]
-                 (dispatch-mouse-motion hovered context-tree event)))))
-
-;;
-;; Connection to AWT.
-;;
-
-(defn- make-update-fn [component]
-  (fn [] (.repaint component)))
-
-(defn make-component
-  ([layer]
-     (make-component layer (make-event-dispatcher)))
-  ([layer event-dispatcher]
-     (doto
-         (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))]
-                    (render-layer! context layer g 0 0 width height false))
-                  (commit event-dispatcher))
-           (getPreferredSize []
-                             (let [s (size layer nil)] ;; TODO: supply context
-                               (Dimension. (s 0) (s 1)))))
-       (.addMouseListener event-dispatcher)
-       (.addMouseMotionListener event-dispatcher))))
-
-(comment
-  (do 
-    (def frame (java.awt.Frame. "Test"))
-    (def layer1
-         (reify-layer
-          (render! [this context g]
-                   (register (:dispatcher context) context)
-                   (.setColor g Color/WHITE)
-                   (.fillRect g 0 0 (:width context) (:height context)))
-          (size [this context] [50 30])))
-    (def layer2
-         (reify-layer
-          (render! [this context g]
-                   (register (:dispatcher context) context)
-                   (.setColor g Color/BLUE)
-                   (.fillRect g 0 0 (:width context) (:height context))
-                   (render-layer! context layer1 g 10 5))
-          (size [this context] [70 65])))
-    (def layer
-         (reify-layer
-          (render! [this context g]
-                   ;;(register (:dispatcher context) context)
-                   (.drawLine g 0 0 (:width context) (:height context))
-                   (render-layer! context layer2 g 15 20))
-          (size [this context] [100 100])))
-    (doto frame
-      (.addWindowListener
-       (proxy [java.awt.event.WindowAdapter] []
-         (windowClosing [event] (.dispose frame))))
-      (.add (make-component layer))
-      (.pack)
-      (.setVisible true))
-
-    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_ENTERED]
-      [layer context event]
-      (println "1 ENTERED"))
-    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_EXITED]
-      [layer context event]
-      (println "1 EXITED"))
-    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_MOVED]
-      [layer context event]
-      (println "1 MOVED"))
-    (defmethod handle-layer-event [layer2 MouseEvent/MOUSE_ENTERED]
-      [layer context event]
-      (println "2 ENTERED"))
-    (defmethod handle-layer-event [layer2 MouseEvent/MOUSE_EXITED]
-      [layer context event]
-      (println "2 EXITED"))
-    (defmethod handle-layer-event [layer2 MouseEvent/MOUSE_MOVED]
-      [layer context event]
-      (println "2 MOVED")) 
-    )
-  )
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/indyvon/event.clj	Sun Jun 13 04:57:14 2010 +0400
@@ -0,0 +1,141 @@
+;;
+;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
+;;
+;; This file is part of Indyvon.
+;;
+
+(ns indyvon.event
+  (:use indyvon.core)
+  (:import (java.awt.event MouseEvent MouseListener MouseMotionListener)))
+
+(defmulti handle-layer-event 
+  (fn [layer context event]
+    [layer (.getID event)]))
+
+(defmethod handle-layer-event :default [layer context event])
+
+(defprotocol EventDispatcher
+  (listen! [this component])
+  (register [this context])
+  (commit [this])
+  (hovered? [this layer])
+  (picked? [this layer]))
+
+(defn register-context [context]
+  (register (:dispatcher context) context))
+
+(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))))
+
+(defn- add-context
+  [context-tree context]
+  (let [parent (registered-parent context-tree context)]
+    (assoc context-tree parent (conj (context-tree parent) context)
+           context nil)))
+
+(defn- inside?
+  ([x y context]
+     (inside? x y (:x context) (:y context)
+              (:width context) (:height context)))
+  ([px py x y w h]
+     (and (>= px x)
+          (>= py y)
+          (< px (+ x w))
+          (< 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))))
+
+(defn- remove-all [coll1 coll2 pred]
+  (filter #(not (some (partial pred %) coll2)) coll1))
+
+(defn- translate-mouse-event
+  [#^MouseEvent event x y id]
+  (proxy [MouseEvent] [(.getComponent event)
+                       id
+                       (.getWhen event)
+                       (.getModifiers event)
+                       (- (.getX event) x)
+                       (- (.getY event) y)
+                       (.getClickCount event)
+                       (.isPopupTrigger event)]
+    (getXOnScreen []
+                  (.getXOnScreen event))
+    (getYOnScreen []
+                  (.getYOnScreen event))))
+
+(defn- translate-and-dispatch
+  ([contexts event]
+     (translate-and-dispatch contexts event (.getID event)))
+  ([contexts event id]
+  (doseq [c contexts]
+    (handle-layer-event
+     (:layer c)
+     c
+     (translate-mouse-event event (:x c) (:y c) id)))))
+
+(defn- dispatch-mouse-motion*
+  "Dispatches mouse motion events. Returns a new set of contexts which
+  currently are under cursor."
+  [hovered context-tree #^MouseEvent event]
+  (let [x (.getX event)
+        y (.getY event)
+        hovered2 (under-cursor context-tree x y)
+        pred #(= (:layer %1) (:layer %2))
+        exited (remove-all hovered hovered2 pred)
+        entered (remove-all hovered2 hovered pred)
+        moved (remove-all hovered2 entered pred)]
+    (translate-and-dispatch exited event MouseEvent/MOUSE_EXITED)
+    (translate-and-dispatch entered event MouseEvent/MOUSE_ENTERED)
+    (translate-and-dispatch moved event MouseEvent/MOUSE_MOVED)
+    hovered2))
+
+(defn- dispatch-mouse-motion
+  [hovered-ref context-tree #^MouseEvent event]
+  (dosync
+   (alter hovered-ref dispatch-mouse-motion* context-tree event)))
+
+(defn make-event-dispatcher []
+  (let [context-tree-r (ref {}) ; register
+        context-tree (ref {})   ; dispatch
+        hovered (ref '())
+        picked (ref '())]
+    (reify
+     EventDispatcher
+     (listen! [this component]
+             (doto component
+               (.addMouseListener this)
+               (.addMouseMotionListener this)))
+     (register [this context]
+               (dosync (alter context-tree-r add-context context)))
+     (commit [this]
+             (dosync (ref-set context-tree @context-tree-r)
+                     (ref-set context-tree-r {})))
+     (picked? [this layer] false)
+     (hovered? [this layer] false)
+     MouseListener
+     (mouseClicked [this event])
+     (mouseEntered [this event]
+                   (dispatch-mouse-motion hovered context-tree event))
+     (mouseExited [this event]
+                  (dispatch-mouse-motion hovered context-tree event))
+     (mousePressed [this event])
+     (mouseReleased [this event])
+     MouseMotionListener
+     (mouseDragged [this event]
+                   (translate-and-dispatch @picked event))
+     (mouseMoved [this event]
+                 (dispatch-mouse-motion hovered context-tree event)))))
+