diff --git a/src/hottub/stm.clj b/src/hottub/stm.clj new file mode 100644 index 0000000..f1783da --- /dev/null +++ b/src/hottub/stm.clj @@ -0,0 +1,51 @@ +(ns hottub.stm) + +(defn- dispatch-id-state [stm] [(:id stm) (:state stm)]) +(defmulti enter-state dispatch-id-state) +(defmulti exit-state dispatch-id-state) +(defmulti on-event (fn [stm event] (dispatch-id-state stm))) +(defmulti on-call dispatch-id-state) + +(defmulti start-state-for-stm (fn [stmid] stmid)) +(defmulti is-end-state dispatch-id-state) + +(defmethod enter-state :default [stm] stm) +(defmethod exit-state :default [stm]) +(defmethod on-event :default [stm event] stm) +(defmethod on-call :default [stm] nil) +(defmethod start-state-for-stm :default [stmid] :start) +(defmethod is-end-state :default [stm] (= (:state stm) :end)) + +(defn state [stm] (:state stm)) +(defn value [stm] (:value stm)) + +(defn start [stmid & [value]] + (runI {:id stmid :state (start-state-for-stm stmid) :value value} nil)) + +(defn goto [stm state & [value]] + (assoc stm :state state :value (or value (:value stm)))) + +(defn- runI [stm event] + (if stm + (let [stmnew (if event (on-event stm event) (enter-state stm))] + (cond + (not= (:state stmnew) (:state stm)) + (do + (exit-state stm) + (recur stmnew nil)) + (is-end-state stmnew) + (do + (exit-state stmnew) + (if-let [stmreturn (:return-to stmnew)] + (recur (:return-to stmnew) {:id ::return :stmid (:id stmnew) :state (:state stmnew) :value (:value stmnew)}) + nil)) + (not event) + (if-let [stmcall (on-call stmnew)] + (assoc stmcall :return-to stmnew) + stmnew) + :else stmnew)) + nil)) + +(defn run [stm event] + {:pre [event]} + (runI stm event)) diff --git a/src/hottub/stm/input.clj b/src/hottub/stm/input.clj new file mode 100644 index 0000000..2bc3633 --- /dev/null +++ b/src/hottub/stm/input.clj @@ -0,0 +1,48 @@ +;; Anything you type in here will be executed +;; immediately with the results shown on the +;; right. +(ns hottub.stm.input + (:require [hottub.stm :as stm] + [hottub.gs :as gs])) + +(defn is-active [input v] + (contains? (:mousebuttons input) :left)) + +(defn is-input-event [event] + (= (:type event) :input)) + +(defn advance [stm input state-next activehigh] + (let [active (is-active input (stm/value stm))] + (if (or (and activehigh active) (and (not activehigh) (not active))) + (stm/goto stm state-next) + stm))) + +(defmethod stm/enter-state [:click :start] [stm] + (let [input-now (:input (first (gs/q :name :input)))] + (advance stm input-now :wait-for-press false))) + +(defmethod stm/on-event [:click :start] [stm event] + (if (is-input-event event) + (advance stm event :wait-for-press false) + stm)) + +(defmethod stm/on-event [:click :wait-for-press] [stm event] + (if (is-input-event event) + (advance stm event :wait-for-release true) + stm)) + +(defmethod stm/on-event [:click :wait-for-release] [stm event] + (if (is-input-event event) + (advance stm event :end false) + stm)) + +(gs/with-gs gs/gs-empty + (gs/add-index :name) + (gs/set-entity (gs/gen-id) {:name :input :input {:mousebuttons #{:left}}}) + (-> (stm/start :click) + (stm/run {:type :input :mousebuttons #{}}) + ;(stm/run {:type :input :mousebuttons #{:left}}) + ;(stm/run {:type :input :mousebuttons #{:left}}) + ;(stm/run {:type :input :mousebuttons #{}}) +)) +