First cut at simple GUI event dispatch system

src/hottub/gui.clj

@@ -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}))