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