diff --git a/src/hottub/gui.clj b/src/hottub/gui.clj new file mode 100644 index 0000000..aa6ece3 --- /dev/null +++ b/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}))