Initial state machine skeleton with testcase

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

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 #{}})
+))
+