Mercurial > hg > indyvon
changeset 36:5413b188d112
Rename namespaces: indyvon to kryshen.indyvon.
| author | Mikhail Kryshen <mikhail@kryshen.net> |
|---|---|
| date | Thu, 08 Jul 2010 07:03:24 +0400 |
| parents | 0d593970cb76 |
| children | d2fb660ca49f |
| files | project.clj src/indyvon/component.clj src/indyvon/core.clj src/indyvon/demo.clj src/indyvon/layers.clj src/kryshen/indyvon/component.clj src/kryshen/indyvon/core.clj src/kryshen/indyvon/demo.clj src/kryshen/indyvon/layers.clj |
| diffstat | 9 files changed, 584 insertions(+), 584 deletions(-) [+] |
line wrap: on
line diff
--- a/project.clj Thu Jul 08 06:02:12 2010 +0400 +++ b/project.clj Thu Jul 08 07:03:24 2010 +0400 @@ -3,7 +3,7 @@ :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 - indyvon.layers - indyvon.component - indyvon.demo]) + :namespaces [kryshen.indyvon.core + kryshen.indyvon.layers + kryshen.indyvon.component + kryshen.indyvon.demo])
--- a/src/indyvon/component.clj Thu Jul 08 06:02:12 2010 +0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,52 +0,0 @@ -;; -;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net> -;; -;; This file is part of Indyvon. -;; - -(ns indyvon.component - (:use indyvon.core - indyvon.layers) - (:import (indyvon.core Size Bounds) - (java.awt Graphics2D Component Dimension Color) - (javax.swing JFrame JPanel))) - -(defn- font-context [^Component component] - (.getFontRenderContext (.getFontMetrics component (.getFont component)))) - -(defn paint-component - [^Component component layer ^Graphics2D graphics event-dispatcher] - (let [size (.getSize component) - width (.width size) - height (.height size)] - (.clearRect graphics 0 0 width height) - (let [bounds (Bounds. 0 0 width height)] - (binding [*graphics* graphics - *font-context* (.getFontRenderContext graphics) - *target* component - *event-dispatcher* event-dispatcher - *update* #(.repaint component) - *bounds* bounds - *clip* bounds] - (render! layer nil) - (commit event-dispatcher))))) - -(defn preferred-size [component layer] - (binding [*target* component - *font-context*' (font-context component)] - (let [s (size layer nil)] - (Dimension. (:width s) (:height s))))) - -(defn make-jpanel - ([layer] - (make-jpanel layer (root-event-dispatcher))) - ([layer event-dispatcher] - (let [panel - (proxy [JPanel] [] - (paintComponent [g] - (paint-component this layer g event-dispatcher)) - (getPreferredSize [] - (preferred-size this layer)))] - (.setBackground panel (:back-color *theme*)) - (listen! event-dispatcher panel) - panel)))
--- a/src/indyvon/core.clj Thu Jul 08 06:02:12 2010 +0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,310 +0,0 @@ -;; -;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net> -;; -;; This file is part of Indyvon. -;; - -(ns indyvon.core - (:import (java.awt Graphics2D Component Color Font) - (java.awt.event MouseListener MouseMotionListener) - (java.awt.font FontRenderContext))) - -(def ^Graphics2D *graphics*) -(def ^FontRenderContext *font-context*) -(def ^Component *target*) -(def *bounds*) -(def *clip*) -(def *update*) -(def *event-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))) - -(def *theme* (default-theme)) - -(defrecord Location [x y]) -(defrecord Size [width height]) -(defrecord Bounds [x y width height]) - -(defprotocol Layer - "Basic UI element." - (render! [this opts]) - (size [this opts])) - -;; TODO: modifiers -(defrecord MouseEvent [id when x y x-on-screen y-on-screen button]) - -(defprotocol EventDispatcher - (listen! [this ^Component component] - "Listen for events on the specified AWT Component.") - (create-dispatcher [this handle handlers] - "Returns new event dispatcher associated with the specified event - handlers (an event-id -> handler-fn map). Handle is used to - match the contexts between commits.") - (commit [this] - "Apply the registered handlers for event processing.")) - -(defprotocol Anchored - "Provide anchor point for Layers. Used by viewport." - (anchor [this h-align v-align opts] - "Anchor point: [x y], h-align could be :left, :center or :right, - v-align is :top, :center or :bottom")) - -;; Default implementation of Anchored for any Layer. -(extend-protocol Anchored - indyvon.core.Layer - (anchor [this h-align v-align opts] - (if (and (= h-align :left) - (= v-align :top)) - (Location. 0 0) - (let [size (size this opts)] - (Location. - (case h-align - :top 0 - :center (/ (:width size) 2) - :right (:width size)) - (case v-align - :left 0 - :center (/ (:height size) 2) - :bottom (:height size))))))) - -(defn- ^Graphics2D make-graphics [^Graphics2D graphics x y w h] - (.create graphics x y w h)) - -(defn- ^Graphics2D apply-theme [^Graphics2D graphics theme] - (doto graphics - (.setColor (:fore-color theme)) - (.setFont (:font theme)))) - -(defn intersect [b1 b2] - (let [x11 (:x b1) - y11 (:y b1) - x12 (+ x11 (:width b1)) - y12 (+ y11 (:height b1)) - x21 (:x b2) - y21 (:y b2) - x22 (+ x21 (:width b2)) - y22 (+ y21 (:height b2)) - x1 (max x11 x21) - y1 (max y11 y21) - x2 (min x12 x22) - y2 (min y12 y22)] - (Bounds. x1 y1 (- x2 x1) (- y2 y1)))) - -(defn with-translate* [x y w h f & args] - (let [graphics (apply-theme (.create *graphics* x y w h) *theme*) - bounds (Bounds. (+ x (:x *bounds*)) - (+ y (:y *bounds*)) - w h)] - (try - (apply with-bindings* {#'*bounds* bounds - #'*clip* (intersect bounds *clip*) - #'*graphics* graphics} - f args) - (finally - (.dispose graphics))))) - -(defmacro with-translate [x y w h & body] - `(with-translate* ~x ~y ~w ~h (fn [] ~@body))) - - - -(defn with-handlers* [handle handlers f & args] - (apply with-bindings* - {#'*event-dispatcher* - (create-dispatcher *event-dispatcher* handle handlers)} - f args)) - -(defmacro with-handlers - "specs => (:event-id name & handler-body)* - - Execute form with the specified event handlers." - [handle form & specs] - `(with-handlers* ~handle - ~(reduce (fn [m spec] - (assoc m (first spec) - `(fn [~(second spec)] - ~@(nnext spec)))) {} - specs) - (fn [] ~form))) - -(defn- geometry-vec [geometry] - (if (vector? geometry) - geometry - [(:x geometry) (:y geometry) (:width geometry) (:height geometry)])) - -(defn draw! - "Draw a layer. Geometry is either a map or vector [x y] or - [x y width height]." - [layer geometry & args] - (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 -;; - -(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 [handle handlers parent bounds bindings] - EventDispatcher - (listen! [this component] - (listen! parent component)) - (create-dispatcher [this handle handlers] - (create-dispatcher parent handle handlers)) - (commit [this] - (commit parent))) - -(defn- make-node [handle handlers] - (DispatcherNode. handle handlers *event-dispatcher* *clip* - (get-thread-bindings))) - -(defn- assoc-cons [m key val] - (assoc m key (cons val (get m key)))) - -(defn- add-node [tree node] - (assoc-cons tree (:parent node) node)) - -(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 child nodes under cursor." - [x y tree node] - (some #(if (inside? x y (:bounds %)) - (conj (under-cursor x y tree %) %)) - (get tree node))) - -(defn- remove-all [coll1 coll2 pred] - (filter #(not (some (partial pred %) coll2)) coll1)) - -(defn- translate-mouse-event [^java.awt.event.MouseEvent 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 ^java.awt.event.MouseEvent event] - (translate-and-dispatch nodes event (awt-events (.getID event)))) - ([nodes event id] - (doseq [node nodes] - (when-let [handler (get (:handlers node) id)] - (with-bindings* (:bindings node) - handler - (translate-mouse-event event - (-> node :bounds :x) (-> node :bounds :y) id)))) - id)) - -(defn- dispatch-mouse-motion* - "Dispatches mouse motion events. Returns a new set of nodes which - currently are under cursor." - [hovered tree root ^java.awt.event.MouseEvent event] - (let [x (.getX event) - y (.getY event) - hovered2 (under-cursor x y tree root) - pred #(= (:handle %1) (:handle %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 root event] - (dosync - (alter hovered-ref dispatch-mouse-motion* tree root 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 root-event-dispatcher [] - (let [tree-r (ref {}) ; register - tree (ref {}) ; dispatch - hovered (ref '()) - picked (ref '())] - (reify - EventDispatcher - (listen! [this component] - (doto component - (.addMouseListener this) - (.addMouseMotionListener this))) - (create-dispatcher [this handle handlers] - (let [node (make-node handle handlers)] - (dosync (alter tree-r add-node node)) - node)) - (commit [this] - (dosync (ref-set tree @tree-r) - (ref-set tree-r {}))) - MouseListener - (mouseEntered [this event] - (dispatch-mouse-motion hovered @tree this event)) - (mouseExited [this event] - (dispatch-mouse-motion hovered @tree this 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 this 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/demo.clj Thu Jul 08 06:02:12 2010 +0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,89 +0,0 @@ -;; -;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net> -;; -;; This file is part of Indyvon. -;; - -(ns indyvon.demo - (:gen-class) - (:use indyvon.core - indyvon.layers - indyvon.component) - (:import (indyvon.core Size Bounds) - (java.awt Graphics2D Component Dimension Color) - (javax.swing JFrame JPanel))) - -(def frame (JFrame. "Test")) - -(def layer1 - (reify - Layer - (render! [layer opts] - (with-handlers layer - (doto *graphics* - (.setColor Color/RED) - (.fillRect 0 0 (:width *bounds*) (:height *bounds*))) - (:mouse-entered e (println e)) - (:mouse-exited e (println e)) - (:mouse-moved e (println e)))) - (size [layer opts] (Size. 30 20)))) - -(def layer1b (border-layer layer1 2 3)) - -(def layer2 - (reify - Layer - (render! [layer opts] - (doto *graphics* - (.setColor Color/YELLOW) - (.fillRect 0 0 (:width *bounds*) (:height *bounds*))) - (draw! layer1b [10 5]) - (draw! layer1 [55 5])) - (size [layer opts] (Size. 70 65)))) - -(def layer3 - (border-layer (text-layer "Sample\ntext" :right :center))) - -(defn fps-layer [fps] - (border-layer (text-layer (format "%.1f" fps) :right :bottom) 0 5)) - -(def fps - (let [update-interval 0.1 - frames (ref 0) - last (ref 0) - fl (ref (fps-layer 0.0))] - (reify - Layer - (render! [layer opts] - (render! @fl nil) - (dosync - (alter frames + 1) - (let [time (System/currentTimeMillis) - elapsed (/ (- time @last) 1000.0)] - (when (> elapsed update-interval) - (ref-set fl (fps-layer (/ @frames elapsed))) - (ref-set frames 0) - (ref-set last time))))) - (size [layer opts] (size @fl nil))))) - -(def layer - (reify - Layer - (render! [layer opts] - (*update*) - (doto *graphics* - (.setColor (rand-nth [Color/BLACK Color/BLUE Color/RED])) - (.drawLine 0 0 (:width *bounds*) (:height *bounds*))) - (draw! layer2 [15 20]) - (draw! layer3 [100 100 80 50]) - (render! fps nil)) - (size [layer opts] (Size. 400 300)))) - -(defn -main [] - (doto frame - (.addWindowListener - (proxy [java.awt.event.WindowAdapter] [] - (windowClosing [event] (.dispose frame)))) - (.. (getContentPane) (add (make-jpanel (viewport layer)))) - (.pack) - (.setVisible true)))
--- a/src/indyvon/layers.clj Thu Jul 08 06:02:12 2010 +0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,129 +0,0 @@ -;; -;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net> -;; -;; This file is part of Indyvon. -;; - -(ns indyvon.layers - (:use indyvon.core) - (:import (indyvon.core Size Location) - (java.awt Font Cursor) - (java.awt.font FontRenderContext TextLayout))) - -;; Define as macro to avoid unnecessary calculation of inner and outer -;; sizes in the first case. -(defmacro align-xy [inner outer align first center last] - `(case ~align - ~first 0 - ~center (/ (- ~outer ~inner) 2) - ~last (- ~outer ~inner))) - -(defmacro align-x [inner outer align] - `(align-xy ~inner ~outer ~align :left :center :right)) - -(defmacro align-y [inner outer align] - `(align-xy ~inner ~outer ~align :top :center :bottom)) - -(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 opts] - (let [w (:width *bounds*) - h (:height *bounds*)] - (.setColor *graphics* (:border-color *theme*)) - (doseq [i (range 0 width)] - (.drawRect *graphics* i i (- w 1 i i) (- h 1 i i))) - (apply draw! content - [offset offset (- w offset offset) (- h offset offset)] - opts))) - (size [l opts] - (let [s (size content opts)] - (Size. (+ (:width s) offset offset) - (+ (:height s) offset offset)))))))) - -(defn- re-split [^java.util.regex.Pattern re s] - (seq (.split re s))) - -(defn- layout-text [lines ^Font font ^FontRenderContext font-context] - (map #(TextLayout. ^String % font font-context) lines)) - -(defn- text-width [layouts] - (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts)) - -(defn- text-height [layouts] - (reduce (fn [w ^TextLayout tl] (+ w (.getAscent tl) - (.getDescent tl) - (.getLeading tl))) - 0 layouts)) - -(defn text-layer - "Creates a layer to display multiline text." - ([text] - (text-layer text :left :top)) - ([text h-align v-align] - (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)] - (reify Layer - (render! [layer opts] - (let [w (:width *bounds*) - h (:height *bounds*) - font (.getFont *graphics*) - layouts (layout-text lines font *font-context*) - y (align-y (text-height layouts) h v-align)] - (loop [layouts layouts, y y] - (when-first [^TextLayout layout layouts] - (let [ascent (.getAscent layout) - lh (+ ascent (.getDescent layout) (.getLeading layout)) - x (align-x (.getAdvance layout) w h-align)] - (.draw layout *graphics* x (+ y ascent)) - (recur (next layouts) (+ y lh))))))) - (size [layer opts] - (let [layouts (layout-text lines (:font *theme*) *font-context*) - width (text-width layouts) - height (text-height layouts)] - (Size. width height))))))) - -(defn viewport - "Creates scrollable viewport layer." - ([content] (viewport content :left :top)) - ([content h-align v-align] - (let [x (ref 0) - y (ref 0) - fix-x (ref 0) - fix-y (ref 0) - last-width (ref 0) - last-height (ref 0)] - (reify - Layer - (render! [layer opts] - (with-handlers layer - (let [anchor (anchor content h-align v-align opts) - width (:width *bounds*) - height (:height *bounds*)] - (dosync - (alter x + (align-x width @last-width h-align)) - (alter y + (align-y height @last-height v-align)) - (ref-set last-width width) - (ref-set last-height height)) - (apply draw! content - [(- 0 @x (:x anchor)) (- 0 @y (:y anchor))] opts)) - (:mouse-pressed e - (dosync - (ref-set fix-x (:x-on-screen e)) - (ref-set fix-y (:y-on-screen e))) - (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*))) - (:mouse-released e - (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*))) - (:mouse-dragged e - (dosync - (alter x + (- @fix-x (:x-on-screen e))) - (alter y + (- @fix-y (:y-on-screen e))) - (ref-set fix-x (:x-on-screen e)) - (ref-set fix-y (:y-on-screen e))) - (*update*)))) - (size [layer opts] (size content opts))))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/kryshen/indyvon/component.clj Thu Jul 08 07:03:24 2010 +0400 @@ -0,0 +1,52 @@ +;; +;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net> +;; +;; This file is part of Indyvon. +;; + +(ns kryshen.indyvon.component + (:use kryshen.indyvon.core + kryshen.indyvon.layers) + (:import (kryshen.indyvon.core Size Bounds) + (java.awt Graphics2D Component Dimension Color) + (javax.swing JFrame JPanel))) + +(defn- font-context [^Component component] + (.getFontRenderContext (.getFontMetrics component (.getFont component)))) + +(defn paint-component + [^Component component layer ^Graphics2D graphics event-dispatcher] + (let [size (.getSize component) + width (.width size) + height (.height size)] + (.clearRect graphics 0 0 width height) + (let [bounds (Bounds. 0 0 width height)] + (binding [*graphics* graphics + *font-context* (.getFontRenderContext graphics) + *target* component + *event-dispatcher* event-dispatcher + *update* #(.repaint component) + *bounds* bounds + *clip* bounds] + (render! layer nil) + (commit event-dispatcher))))) + +(defn preferred-size [component layer] + (binding [*target* component + *font-context*' (font-context component)] + (let [s (size layer nil)] + (Dimension. (:width s) (:height s))))) + +(defn make-jpanel + ([layer] + (make-jpanel layer (root-event-dispatcher))) + ([layer event-dispatcher] + (let [panel + (proxy [JPanel] [] + (paintComponent [g] + (paint-component this layer g event-dispatcher)) + (getPreferredSize [] + (preferred-size this layer)))] + (.setBackground panel (:back-color *theme*)) + (listen! event-dispatcher panel) + panel)))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/kryshen/indyvon/core.clj Thu Jul 08 07:03:24 2010 +0400 @@ -0,0 +1,310 @@ +;; +;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net> +;; +;; This file is part of Indyvon. +;; + +(ns kryshen.indyvon.core + (:import (java.awt Graphics2D Component Color Font) + (java.awt.event MouseListener MouseMotionListener) + (java.awt.font FontRenderContext))) + +(def ^Graphics2D *graphics*) +(def ^FontRenderContext *font-context*) +(def ^Component *target*) +(def *bounds*) +(def *clip*) +(def *update*) +(def *event-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))) + +(def *theme* (default-theme)) + +(defrecord Location [x y]) +(defrecord Size [width height]) +(defrecord Bounds [x y width height]) + +(defprotocol Layer + "Basic UI element." + (render! [this opts]) + (size [this opts])) + +;; TODO: modifiers +(defrecord MouseEvent [id when x y x-on-screen y-on-screen button]) + +(defprotocol EventDispatcher + (listen! [this ^Component component] + "Listen for events on the specified AWT Component.") + (create-dispatcher [this handle handlers] + "Returns new event dispatcher associated with the specified event + handlers (an event-id -> handler-fn map). Handle is used to + match the contexts between commits.") + (commit [this] + "Apply the registered handlers for event processing.")) + +(defprotocol Anchored + "Provide anchor point for Layers. Used by viewport." + (anchor [this h-align v-align opts] + "Anchor point: [x y], h-align could be :left, :center or :right, + v-align is :top, :center or :bottom")) + +;; Default implementation of Anchored for any Layer. +(extend-protocol Anchored + kryshen.indyvon.core.Layer + (anchor [this h-align v-align opts] + (if (and (= h-align :left) + (= v-align :top)) + (Location. 0 0) + (let [size (size this opts)] + (Location. + (case h-align + :top 0 + :center (/ (:width size) 2) + :right (:width size)) + (case v-align + :left 0 + :center (/ (:height size) 2) + :bottom (:height size))))))) + +(defn- ^Graphics2D make-graphics [^Graphics2D graphics x y w h] + (.create graphics x y w h)) + +(defn- ^Graphics2D apply-theme [^Graphics2D graphics theme] + (doto graphics + (.setColor (:fore-color theme)) + (.setFont (:font theme)))) + +(defn intersect [b1 b2] + (let [x11 (:x b1) + y11 (:y b1) + x12 (+ x11 (:width b1)) + y12 (+ y11 (:height b1)) + x21 (:x b2) + y21 (:y b2) + x22 (+ x21 (:width b2)) + y22 (+ y21 (:height b2)) + x1 (max x11 x21) + y1 (max y11 y21) + x2 (min x12 x22) + y2 (min y12 y22)] + (Bounds. x1 y1 (- x2 x1) (- y2 y1)))) + +(defn with-translate* [x y w h f & args] + (let [graphics (apply-theme (.create *graphics* x y w h) *theme*) + bounds (Bounds. (+ x (:x *bounds*)) + (+ y (:y *bounds*)) + w h)] + (try + (apply with-bindings* {#'*bounds* bounds + #'*clip* (intersect bounds *clip*) + #'*graphics* graphics} + f args) + (finally + (.dispose graphics))))) + +(defmacro with-translate [x y w h & body] + `(with-translate* ~x ~y ~w ~h (fn [] ~@body))) + + + +(defn with-handlers* [handle handlers f & args] + (apply with-bindings* + {#'*event-dispatcher* + (create-dispatcher *event-dispatcher* handle handlers)} + f args)) + +(defmacro with-handlers + "specs => (:event-id name & handler-body)* + + Execute form with the specified event handlers." + [handle form & specs] + `(with-handlers* ~handle + ~(reduce (fn [m spec] + (assoc m (first spec) + `(fn [~(second spec)] + ~@(nnext spec)))) {} + specs) + (fn [] ~form))) + +(defn- geometry-vec [geometry] + (if (vector? geometry) + geometry + [(:x geometry) (:y geometry) (:width geometry) (:height geometry)])) + +(defn draw! + "Draw a layer. Geometry is either a map or vector [x y] or + [x y width height]." + [layer geometry & args] + (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 +;; + +(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 [handle handlers parent bounds bindings] + EventDispatcher + (listen! [this component] + (listen! parent component)) + (create-dispatcher [this handle handlers] + (create-dispatcher parent handle handlers)) + (commit [this] + (commit parent))) + +(defn- make-node [handle handlers] + (DispatcherNode. handle handlers *event-dispatcher* *clip* + (get-thread-bindings))) + +(defn- assoc-cons [m key val] + (assoc m key (cons val (get m key)))) + +(defn- add-node [tree node] + (assoc-cons tree (:parent node) node)) + +(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 child nodes under cursor." + [x y tree node] + (some #(if (inside? x y (:bounds %)) + (conj (under-cursor x y tree %) %)) + (get tree node))) + +(defn- remove-all [coll1 coll2 pred] + (filter #(not (some (partial pred %) coll2)) coll1)) + +(defn- translate-mouse-event [^java.awt.event.MouseEvent 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 ^java.awt.event.MouseEvent event] + (translate-and-dispatch nodes event (awt-events (.getID event)))) + ([nodes event id] + (doseq [node nodes] + (when-let [handler (get (:handlers node) id)] + (with-bindings* (:bindings node) + handler + (translate-mouse-event event + (-> node :bounds :x) (-> node :bounds :y) id)))) + id)) + +(defn- dispatch-mouse-motion* + "Dispatches mouse motion events. Returns a new set of nodes which + currently are under cursor." + [hovered tree root ^java.awt.event.MouseEvent event] + (let [x (.getX event) + y (.getY event) + hovered2 (under-cursor x y tree root) + pred #(= (:handle %1) (:handle %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 root event] + (dosync + (alter hovered-ref dispatch-mouse-motion* tree root 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 root-event-dispatcher [] + (let [tree-r (ref {}) ; register + tree (ref {}) ; dispatch + hovered (ref '()) + picked (ref '())] + (reify + EventDispatcher + (listen! [this component] + (doto component + (.addMouseListener this) + (.addMouseMotionListener this))) + (create-dispatcher [this handle handlers] + (let [node (make-node handle handlers)] + (dosync (alter tree-r add-node node)) + node)) + (commit [this] + (dosync (ref-set tree @tree-r) + (ref-set tree-r {}))) + MouseListener + (mouseEntered [this event] + (dispatch-mouse-motion hovered @tree this event)) + (mouseExited [this event] + (dispatch-mouse-motion hovered @tree this 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 this 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"))))) +;;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/kryshen/indyvon/demo.clj Thu Jul 08 07:03:24 2010 +0400 @@ -0,0 +1,89 @@ +;; +;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net> +;; +;; This file is part of Indyvon. +;; + +(ns kryshen.indyvon.demo + (:gen-class) + (:use kryshen.indyvon.core + kryshen.indyvon.layers + kryshen.indyvon.component) + (:import (kryshen.indyvon.core Size Bounds) + (java.awt Color) + (javax.swing JFrame))) + +(def frame (JFrame. "Test")) + +(def layer1 + (reify + Layer + (render! [layer opts] + (with-handlers layer + (doto *graphics* + (.setColor Color/RED) + (.fillRect 0 0 (:width *bounds*) (:height *bounds*))) + (:mouse-entered e (println e)) + (:mouse-exited e (println e)) + (:mouse-moved e (println e)))) + (size [layer opts] (Size. 30 20)))) + +(def layer1b (border-layer layer1 2 3)) + +(def layer2 + (reify + Layer + (render! [layer opts] + (doto *graphics* + (.setColor Color/YELLOW) + (.fillRect 0 0 (:width *bounds*) (:height *bounds*))) + (draw! layer1b [10 5]) + (draw! layer1 [55 5])) + (size [layer opts] (Size. 70 65)))) + +(def layer3 + (border-layer (text-layer "Sample\ntext" :right :center))) + +(defn fps-layer [fps] + (border-layer (text-layer (format "%.1f" fps) :right :bottom) 0 5)) + +(def fps + (let [update-interval 0.1 + frames (ref 0) + last (ref 0) + fl (ref (fps-layer 0.0))] + (reify + Layer + (render! [layer opts] + (render! @fl nil) + (dosync + (alter frames + 1) + (let [time (System/currentTimeMillis) + elapsed (/ (- time @last) 1000.0)] + (when (> elapsed update-interval) + (ref-set fl (fps-layer (/ @frames elapsed))) + (ref-set frames 0) + (ref-set last time))))) + (size [layer opts] (size @fl nil))))) + +(def layer + (reify + Layer + (render! [layer opts] + (*update*) + (doto *graphics* + (.setColor (rand-nth [Color/BLACK Color/BLUE Color/RED])) + (.drawLine 0 0 (:width *bounds*) (:height *bounds*))) + (draw! layer2 [15 20]) + (draw! layer3 [100 100 80 50]) + (render! fps nil)) + (size [layer opts] (Size. 400 300)))) + +(defn -main [] + (doto frame + (.addWindowListener + (proxy [java.awt.event.WindowAdapter] [] + (windowClosing [event] (.dispose frame)))) + (.. (getContentPane) (add (make-jpanel (viewport layer)))) + (.pack) + (.setVisible true)))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/kryshen/indyvon/layers.clj Thu Jul 08 07:03:24 2010 +0400 @@ -0,0 +1,129 @@ +;; +;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net> +;; +;; This file is part of Indyvon. +;; + +(ns kryshen.indyvon.layers + (:use kryshen.indyvon.core) + (:import (kryshen.indyvon.core Size Location) + (java.awt Font Cursor) + (java.awt.font FontRenderContext TextLayout))) + +;; Define as macro to avoid unnecessary calculation of inner and outer +;; sizes in the first case. +(defmacro align-xy [inner outer align first center last] + `(case ~align + ~first 0 + ~center (/ (- ~outer ~inner) 2) + ~last (- ~outer ~inner))) + +(defmacro align-x [inner outer align] + `(align-xy ~inner ~outer ~align :left :center :right)) + +(defmacro align-y [inner outer align] + `(align-xy ~inner ~outer ~align :top :center :bottom)) + +(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 opts] + (let [w (:width *bounds*) + h (:height *bounds*)] + (.setColor *graphics* (:border-color *theme*)) + (doseq [i (range 0 width)] + (.drawRect *graphics* i i (- w 1 i i) (- h 1 i i))) + (apply draw! content + [offset offset (- w offset offset) (- h offset offset)] + opts))) + (size [l opts] + (let [s (size content opts)] + (Size. (+ (:width s) offset offset) + (+ (:height s) offset offset)))))))) + +(defn- re-split [^java.util.regex.Pattern re s] + (seq (.split re s))) + +(defn- layout-text [lines ^Font font ^FontRenderContext font-context] + (map #(TextLayout. ^String % font font-context) lines)) + +(defn- text-width [layouts] + (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts)) + +(defn- text-height [layouts] + (reduce (fn [w ^TextLayout tl] (+ w (.getAscent tl) + (.getDescent tl) + (.getLeading tl))) + 0 layouts)) + +(defn text-layer + "Creates a layer to display multiline text." + ([text] + (text-layer text :left :top)) + ([text h-align v-align] + (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)] + (reify Layer + (render! [layer opts] + (let [w (:width *bounds*) + h (:height *bounds*) + font (.getFont *graphics*) + layouts (layout-text lines font *font-context*) + y (align-y (text-height layouts) h v-align)] + (loop [layouts layouts, y y] + (when-first [^TextLayout layout layouts] + (let [ascent (.getAscent layout) + lh (+ ascent (.getDescent layout) (.getLeading layout)) + x (align-x (.getAdvance layout) w h-align)] + (.draw layout *graphics* x (+ y ascent)) + (recur (next layouts) (+ y lh))))))) + (size [layer opts] + (let [layouts (layout-text lines (:font *theme*) *font-context*) + width (text-width layouts) + height (text-height layouts)] + (Size. width height))))))) + +(defn viewport + "Creates scrollable viewport layer." + ([content] (viewport content :left :top)) + ([content h-align v-align] + (let [x (ref 0) + y (ref 0) + fix-x (ref 0) + fix-y (ref 0) + last-width (ref 0) + last-height (ref 0)] + (reify + Layer + (render! [layer opts] + (with-handlers layer + (let [anchor (anchor content h-align v-align opts) + width (:width *bounds*) + height (:height *bounds*)] + (dosync + (alter x + (align-x width @last-width h-align)) + (alter y + (align-y height @last-height v-align)) + (ref-set last-width width) + (ref-set last-height height)) + (apply draw! content + [(- 0 @x (:x anchor)) (- 0 @y (:y anchor))] opts)) + (:mouse-pressed e + (dosync + (ref-set fix-x (:x-on-screen e)) + (ref-set fix-y (:y-on-screen e))) + (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*))) + (:mouse-released e + (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*))) + (:mouse-dragged e + (dosync + (alter x + (- @fix-x (:x-on-screen e))) + (alter y + (- @fix-y (:y-on-screen e))) + (ref-set fix-x (:x-on-screen e)) + (ref-set fix-y (:y-on-screen e))) + (*update*)))) + (size [layer opts] (size content opts))))))