First cut at simple GUI event dispatch system
This commit is contained in:
parent
b0bf0746c0
commit
8b3c2d99b0
49
src/hottub/gui.clj
Normal file
49
src/hottub/gui.clj
Normal file
|
@ -0,0 +1,49 @@
|
||||||
|
(ns hottub.gui
|
||||||
|
(:require (hottub [util :as u]
|
||||||
|
[stm :as stm])))
|
||||||
|
|
||||||
|
(defstruct point :x :y)
|
||||||
|
(defstruct rect :x :y :w :h)
|
||||||
|
(defstruct region :x :y :w :h :id)
|
||||||
|
|
||||||
|
(defn point-in-rect [{:keys [x y]} {rx :x ry :y rw :w rh :h}]
|
||||||
|
(and (>= x rx) (<= x (+ rx rw))
|
||||||
|
(>= y ry) (<= y (+ ry rh))))
|
||||||
|
|
||||||
|
(defn region-for-point [point regions]
|
||||||
|
(first (filter #(point-in-rect point %) regions)))
|
||||||
|
|
||||||
|
(defn region-for-id [id regions]
|
||||||
|
(if id
|
||||||
|
(first (filter #(= (:id %) id) regions))
|
||||||
|
nil))
|
||||||
|
|
||||||
|
(defn- point-from-mouse [input] (struct point (:mousex input) (:mousey input)))
|
||||||
|
|
||||||
|
;; ev: {:regions [] :input {} :fnevent fn}
|
||||||
|
(defn- mousebutton-matches [ev button state]
|
||||||
|
(let [input (:input ev)
|
||||||
|
buttons (:mousebuttons input)]
|
||||||
|
(= state (contains? buttons button))))
|
||||||
|
|
||||||
|
(defn- mousebutton-down [stm ev] (mousebutton-matches ev :left true))
|
||||||
|
(defn- mousebutton-up [stm ev] (mousebutton-matches ev :left false))
|
||||||
|
|
||||||
|
(stm/defstm ::gui
|
||||||
|
[:start
|
||||||
|
(nil mousebutton-down [stm {:keys [regions input fnevent]}]
|
||||||
|
(let [region (region-for-point (point-from-mouse input) regions)]
|
||||||
|
(do (if region (fnevent region input :down))
|
||||||
|
(stm/goto stm :wait-for-mouseup {:regionid (:id region)}))))]
|
||||||
|
[:wait-for-mouseup
|
||||||
|
(nil mousebutton-down [stm {:keys [regions input fnevent]}]
|
||||||
|
(if-let [region (region-for-id (:regionid stm) regions)]
|
||||||
|
(do (fnevent region input :drag) nil)))
|
||||||
|
(nil mousebutton-up [stm {:keys [regions input fnevent]}]
|
||||||
|
(let [region (region-for-id (:regionid stm) regions)]
|
||||||
|
(do (if region (fnevent region input :up))
|
||||||
|
(stm/goto stm :start {:regionid nil}))))])
|
||||||
|
|
||||||
|
(defn make-gui [] (stm/start ::gui))
|
||||||
|
(defn gui-input [gui input regions fnevent]
|
||||||
|
(stm/run gui {:regions regions :input input :fnevent fnevent}))
|
Loading…
Reference in a new issue