Store event queue in stm; allows enter-state to post fake events

allow returning nil from enter-state, on-event
change on-call to return a [stmid value] rather than an arbitrary stm, too much weird shit can go wrong
function to remove a state machine's code
starting to build helper macros for defining state machines

src/hottub/stm.clj

@@ -9,9 +9,9 @@
 (defmulti start-state-for-stm (fn [stmid] stmid))
 (defmulti is-end-state dispatch-id-state)
 
-(defmethod enter-state :default [stm] stm)
+(defmethod enter-state :default [stm] nil)
 (defmethod exit-state :default [stm])
-(defmethod on-event :default [stm event] stm)
+(defmethod on-event :default [stm event] nil)
 (defmethod on-call :default [stm] nil)
 (defmethod start-state-for-stm :default [stmid] :start)
 (defmethod is-end-state :default [stm] (= (:state stm) :end))
@@ -19,33 +19,74 @@
 (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]
+(defn post-event [stm event]
-  (if stm
+  (assoc stm :events (conj (:events stm) event)))
-    (let [stmnew (if event (on-event stm event) (enter-state stm))]
+
-      (cond
+(defn- transition [stepnext fntrans stmold & args]
-        (not= (:state stmnew) (:state stm))
+  (if-let [stmnew (apply fntrans stmold args)]
+    (if-not (= (:state stmnew) (:state stmold))
+      (do
+        (exit-state stmold)
+        [stmnew :enter])
+      [stmnew stepnext])
+    [stmold stepnext]))
+
+(declare start)
+
+(defn- process-state [stm step]
+  ;(println step (:state stm) (:value stm) (seq (:events stm)))
+  (case step
+    :enter 
+      (let [[stmnew stepnext] (transition :return-from enter-state stm)] 
+        (recur stmnew stepnext))
+    :return-from
+      (if (is-end-state stm)
         (do
           (exit-state stm)
-            (recur stmnew nil))
+          (if-let [stmreturn (:return-to stm)]
-        (is-end-state stmnew)
+            (let [stmreturn (assoc stmreturn :events (:events stm))]
-          (do
+              (recur (post-event stmreturn {:id ::return :stmid (:id stm) :state (:state stm) :value (:value stm)}) :events))
-            (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))
+        (recur stm :call))
+    :call
+      (if-let [[stmid value] (on-call stm)]
+        (recur (assoc (start stmid value) :return-to (dissoc stm :events) :events (:events stm)) :events)
+        (recur stm :events))
+    :events
+      (let [queue (:events stm)
+            event (first queue)
+            stm (if event (assoc stm :events (pop queue)) stm)]
+        (if event
+          (let [[stmnew stepnext] (transition :events on-event stm event)]
+            (recur stmnew stepnext))
+          stm))
+    stm))
 
-(defn run [stm event]
+(defn start [stmid & [value]] 
-  {:pre [event]}
+  (let [stm {:id stmid 
-  (runI stm event))
+             :state (start-state-for-stm stmid) 
+             :value value 
+             :events clojure.lang.PersistentQueue/EMPTY}]
+    (process-state stm :enter)))
+
+(defn run [stm & events]
+  (process-state (reduce post-event stm events) :events))
+
+(defn- remove-stm-method [stmid multifn]
+  (doseq [[key method] (methods multifn)]
+    (if (and (vector? key) (= (first key) stmid))
+      (remove-method multifn key))))
+
+(defn remove-stm [stmid]
+  (doseq [multifn [enter-state exit-state on-event on-call start-state-for-stm is-end-state]]
+    (remove-stm-method stmid multifn)))
+
+(defmacro defstm [stmid & body]
+  `(doto ~stmid
+     (remove-stm)
+     ~@body))
+
+(defmacro defseries [stmid [startstate afterstate] & statedefs])

src/hottub/stm/input.clj

@@ -14,35 +14,22 @@
 (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/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)))
+    (stm/post-event stm (assoc input-now :type :input))))
 
 (defmethod stm/on-event [:click :start] [stm event]
   (if (is-input-event event)
-    (advance stm event :wait-for-press false)
+    (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)
+    (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)
+    (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 #{}})
-))