Moved state-machine to experimental, refactor dom-perf example to use core.async instead - it's a little more verbose for something simple like this, but it probably is much more robust in the long run.
This commit is contained in:
parent
fed0f27a73
commit
cf678507b6
5 changed files with 180 additions and 183 deletions
|
@ -12,7 +12,8 @@
|
|||
[lein-figwheel "0.1.5-SNAPSHOT"]]
|
||||
:dependencies
|
||||
[[com.cemerick/clojurescript.test "0.3.1"]
|
||||
[figwheel "0.1.5-SNAPSHOT"]]
|
||||
[figwheel "0.1.5-SNAPSHOT"]
|
||||
[org.clojure/core.async "0.1.346.0-17112a-alpha"]]
|
||||
:resource-paths ["example"]
|
||||
:cljsbuild {:builds [{:id "example"
|
||||
:source-paths ["src/clojure" "test"]
|
||||
|
|
|
@ -372,163 +372,3 @@
|
|||
([ref korks-or-getter] (cursor* ref korks-or-getter nil true ))
|
||||
([ref getter setter] (cursor* ref getter setter true)))
|
||||
|
||||
;(defn debug-rx* [the-rx capture-callback invalidation-callback]
|
||||
; (add-invalidation-watch the-rx capture-callback invalidation-callback)
|
||||
; (add-invalidation-watch the-rx capture-callback invalidation-callback))
|
||||
|
||||
(deftype StateMachine [state state-transitions allowed-states default-accept
|
||||
watches]
|
||||
Object
|
||||
(equiv [this other]
|
||||
(-equiv this other))
|
||||
|
||||
IReactive
|
||||
(-raw-deref [_] state)
|
||||
|
||||
cljs.core/IEquiv
|
||||
(-equiv [o other] (identical? o other))
|
||||
|
||||
cljs.core/IDeref
|
||||
(-deref [this]
|
||||
(when-let [invalidate *invalidate-rx*]
|
||||
(-add-watch this invalidate invalidate)
|
||||
(when *trace-capture* (*trace-capture* this)))
|
||||
state)
|
||||
|
||||
IMeta
|
||||
(-meta [_] meta)
|
||||
|
||||
IPrintWithWriter
|
||||
(-pr-writer [a writer opts]
|
||||
(-write writer "#<StateMachine: ")
|
||||
(pr-writer state writer opts)
|
||||
(-write writer ">"))
|
||||
|
||||
IWatchable
|
||||
(-notify-watches [this oldval newval]
|
||||
(doseq [[key f] watches]
|
||||
(f key this oldval newval)))
|
||||
(-add-watch [this key f]
|
||||
(set! (.-watches this) (assoc watches key f))
|
||||
this)
|
||||
(-remove-watch [this key]
|
||||
(set! (.-watches this) (dissoc watches key)))
|
||||
|
||||
IHash
|
||||
(-hash [this] (goog/getUid this))
|
||||
|
||||
IReset
|
||||
(-reset! [this new-state]
|
||||
(let [old-state state]
|
||||
(when-not (keyword-identical? new-state old-state)
|
||||
(set! (.-state this) new-state)
|
||||
(-notify-watches this old-state new-state)))
|
||||
state))
|
||||
|
||||
(defn- test-transition
|
||||
([transition]
|
||||
(cond
|
||||
(or (nil? transition)
|
||||
(undefined? transition)) nil
|
||||
(identical? transition true) true
|
||||
(identical? transition false) false
|
||||
:default (transition)))
|
||||
([transition arg]
|
||||
(cond
|
||||
(or (nil? transition)
|
||||
(undefined? transition)) nil
|
||||
(identical? transition true) true
|
||||
(identical? transition false) false
|
||||
:default (transition arg))))
|
||||
|
||||
(defn- test-from-to [transitions from to]
|
||||
(test-transition
|
||||
(get transitions
|
||||
(keyword (str "from-" (name from)
|
||||
"-to-" (name to))))))
|
||||
|
||||
(defn- test-from [transitions from to]
|
||||
(test-transition
|
||||
(get transitions
|
||||
(keyword (str "from-" (name from))))
|
||||
to))
|
||||
|
||||
(defn- test-to [transitions from to]
|
||||
(test-transition
|
||||
(get transitions
|
||||
(keyword (str "to-" (name to))))
|
||||
from))
|
||||
|
||||
(defn transition!
|
||||
"Attempts to transition the state-machine to the requested-state. Returns
|
||||
the state of the machine after the request has been made."
|
||||
[state-machine requested-state]
|
||||
(let [cur-state (.-state state-machine)]
|
||||
(if-not (keyword-identical? cur-state requested-state)
|
||||
(let [transitions (.-state-transitions state-machine)
|
||||
allowed-states (.-allowed-states state-machine)]
|
||||
(if
|
||||
(and
|
||||
(if allowed-states
|
||||
(allowed-states requested-state)
|
||||
true)
|
||||
(let [from-to (test-from-to transitions cur-state requested-state)]
|
||||
(if-not (nil? from-to)
|
||||
from-to
|
||||
(let [from (test-from transitions cur-state requested-state)]
|
||||
(if-not (nil? from)
|
||||
(when from
|
||||
(let [to (test-to transitions cur-state requested-state)]
|
||||
(if-not (nil? to)
|
||||
to
|
||||
(.-default-accept state-machine))))
|
||||
(let [to (test-to transitions cur-state requested-state)]
|
||||
(if-not (nil? to)
|
||||
to
|
||||
(.-default-accept state-machine))))))))
|
||||
|
||||
(do
|
||||
(set! (.-state state-machine) requested-state)
|
||||
(-notify-watches state-machine cur-state requested-state)
|
||||
;(println "from" cur-state "to" requested-state)
|
||||
requested-state)
|
||||
cur-state))
|
||||
cur-state)))
|
||||
|
||||
(defn state-machine
|
||||
"Takes an initial-state and a map of state-transitions.
|
||||
|
||||
A state transition is named by a keyword that can be prefixed with either
|
||||
:from- and to-. A convenience :from-state1-to-state2 form is
|
||||
also allowed.
|
||||
|
||||
:from- and :to- transitions are used as tests to check if a requested
|
||||
transiton is allowed and should either be a function taking a single parameter
|
||||
representing the requested state (for :from- transitions) or the current state
|
||||
(for :to- transitions) - or - a boolean value representing an unconditional
|
||||
accept/reject for that transition. In order for a :from- or :to- transition
|
||||
to succeed it must return a truthy value. If the matching transition
|
||||
function is not found the :default-accept policy will be used. Convienence
|
||||
:from-state1-to-state2 will take priority over :from- and :to- transitions
|
||||
and take a 0-arity function or a boolean value.
|
||||
|
||||
For example, if the current state is :off and the state
|
||||
requested is :on, The state machine will attempt to first to find a
|
||||
transition named :from-off. If that succeeds it will look for a :to-on
|
||||
transition. If that succeeds, the new state will be :on.
|
||||
|
||||
A set of allowed-states can also be defined and any other states will be
|
||||
rejected.
|
||||
"
|
||||
[initial-state state-transitions
|
||||
& {:keys [default-accept allowed-states]
|
||||
:or {default-accept true}}]
|
||||
(assert (keyword? initial-state) "state must be keyword")
|
||||
(when allowed-states
|
||||
(assert (set? allowed-states) "allowed-states must be a set")
|
||||
(assert (allowed-states initial-state) "initial-state must be in allowed states"))
|
||||
(StateMachine. initial-state state-transitions allowed-states default-accept nil))
|
||||
|
||||
|
||||
(def s0 (state-machine :x {:from-x-to-y false}))
|
||||
(transition! s0 :y)
|
|
@ -93,14 +93,6 @@
|
|||
(.-element-spec state))
|
||||
x))
|
||||
|
||||
(defprotocol IHasDOMNode
|
||||
(-get-dom-node [x]))
|
||||
|
||||
(defn get-dom-node [x]
|
||||
(if (dom-node? x)
|
||||
x
|
||||
(-get-dom-node x)))
|
||||
|
||||
(defprotocol IRemove
|
||||
(-remove! [x]))
|
||||
|
||||
|
@ -289,7 +281,7 @@
|
|||
(defn set-data-state!
|
||||
([element state]
|
||||
(let [cur-state (get-data-state element)
|
||||
state (name state)]
|
||||
state (when state (name state))]
|
||||
(when-not (identical? cur-state state)
|
||||
(do-set-data-state! element state)
|
||||
(let [leave-transition (get-transition element (keyword (str "after-" cur-state)))]
|
||||
|
|
158
src/clojure/freactive/experimental/state_machine.cljs
Normal file
158
src/clojure/freactive/experimental/state_machine.cljs
Normal file
|
@ -0,0 +1,158 @@
|
|||
(ns freactive.experimental.state-machine)
|
||||
|
||||
(deftype StateMachine [state state-transitions allowed-states default-accept
|
||||
watches]
|
||||
Object
|
||||
(equiv [this other]
|
||||
(-equiv this other))
|
||||
|
||||
IReactive
|
||||
(-raw-deref [_] state)
|
||||
|
||||
cljs.core/IEquiv
|
||||
(-equiv [o other] (identical? o other))
|
||||
|
||||
cljs.core/IDeref
|
||||
(-deref [this]
|
||||
(when-let [invalidate *invalidate-rx*]
|
||||
(-add-watch this invalidate invalidate)
|
||||
(when *trace-capture* (*trace-capture* this)))
|
||||
state)
|
||||
|
||||
IMeta
|
||||
(-meta [_] meta)
|
||||
|
||||
IPrintWithWriter
|
||||
(-pr-writer [a writer opts]
|
||||
(-write writer "#<StateMachine: ")
|
||||
(pr-writer state writer opts)
|
||||
(-write writer ">"))
|
||||
|
||||
IWatchable
|
||||
(-notify-watches [this oldval newval]
|
||||
(doseq [[key f] watches]
|
||||
(f key this oldval newval)))
|
||||
(-add-watch [this key f]
|
||||
(set! (.-watches this) (assoc watches key f))
|
||||
this)
|
||||
(-remove-watch [this key]
|
||||
(set! (.-watches this) (dissoc watches key)))
|
||||
|
||||
IHash
|
||||
(-hash [this] (goog/getUid this))
|
||||
|
||||
IReset
|
||||
(-reset! [this new-state]
|
||||
(let [old-state state]
|
||||
(when-not (keyword-identical? new-state old-state)
|
||||
(set! (.-state this) new-state)
|
||||
(-notify-watches this old-state new-state)))
|
||||
state))
|
||||
|
||||
(defn- test-transition
|
||||
([transition]
|
||||
(cond
|
||||
(or (nil? transition)
|
||||
(undefined? transition)) nil
|
||||
(identical? transition true) true
|
||||
(identical? transition false) false
|
||||
:default (transition)))
|
||||
([transition arg]
|
||||
(cond
|
||||
(or (nil? transition)
|
||||
(undefined? transition)) nil
|
||||
(identical? transition true) true
|
||||
(identical? transition false) false
|
||||
:default (transition arg))))
|
||||
|
||||
(defn- test-from-to [transitions from to]
|
||||
(test-transition
|
||||
(get transitions
|
||||
(keyword (str "from-" (name from)
|
||||
"-to-" (name to))))))
|
||||
|
||||
(defn- test-from [transitions from to]
|
||||
(test-transition
|
||||
(get transitions
|
||||
(keyword (str "from-" (name from))))
|
||||
to))
|
||||
|
||||
(defn- test-to [transitions from to]
|
||||
(test-transition
|
||||
(get transitions
|
||||
(keyword (str "to-" (name to))))
|
||||
from))
|
||||
|
||||
(defn transition!
|
||||
"Attempts to transition the state-machine to the requested-state. Returns
|
||||
the state of the machine after the request has been made."
|
||||
[state-machine requested-state]
|
||||
(let [cur-state (.-state state-machine)]
|
||||
(if-not (keyword-identical? cur-state requested-state)
|
||||
(let [transitions (.-state-transitions state-machine)
|
||||
allowed-states (.-allowed-states state-machine)]
|
||||
(if
|
||||
(and
|
||||
(if allowed-states
|
||||
(allowed-states requested-state)
|
||||
true)
|
||||
(let [from-to (test-from-to transitions cur-state requested-state)]
|
||||
(if-not (nil? from-to)
|
||||
from-to
|
||||
(let [from (test-from transitions cur-state requested-state)]
|
||||
(if-not (nil? from)
|
||||
(when from
|
||||
(let [to (test-to transitions cur-state requested-state)]
|
||||
(if-not (nil? to)
|
||||
to
|
||||
(.-default-accept state-machine))))
|
||||
(let [to (test-to transitions cur-state requested-state)]
|
||||
(if-not (nil? to)
|
||||
to
|
||||
(.-default-accept state-machine))))))))
|
||||
|
||||
(do
|
||||
(set! (.-state state-machine) requested-state)
|
||||
(-notify-watches state-machine cur-state requested-state)
|
||||
;(println "from" cur-state "to" requested-state)
|
||||
requested-state)
|
||||
cur-state))
|
||||
cur-state)))
|
||||
|
||||
(defn state-machine
|
||||
"Takes an initial-state and a map of state-transitions.
|
||||
|
||||
A state transition is named by a keyword that can be prefixed with either
|
||||
:from- and to-. A convenience :from-state1-to-state2 form is
|
||||
also allowed.
|
||||
|
||||
:from- and :to- transitions are used as tests to check if a requested
|
||||
transiton is allowed and should either be a function taking a single parameter
|
||||
representing the requested state (for :from- transitions) or the current state
|
||||
(for :to- transitions) - or - a boolean value representing an unconditional
|
||||
accept/reject for that transition. In order for a :from- or :to- transition
|
||||
to succeed it must return a truthy value. If the matching transition
|
||||
function is not found the :default-accept policy will be used. Convienence
|
||||
:from-state1-to-state2 will take priority over :from- and :to- transitions
|
||||
and take a 0-arity function or a boolean value.
|
||||
|
||||
For example, if the current state is :off and the state
|
||||
requested is :on, The state machine will attempt to first to find a
|
||||
transition named :from-off. If that succeeds it will look for a :to-on
|
||||
transition. If that succeeds, the new state will be :on.
|
||||
|
||||
A set of allowed-states can also be defined and any other states will be
|
||||
rejected.
|
||||
"
|
||||
[initial-state state-transitions
|
||||
& {:keys [default-accept allowed-states]
|
||||
:or {default-accept true}}]
|
||||
(assert (keyword? initial-state) "state must be keyword")
|
||||
(when allowed-states
|
||||
(assert (set? allowed-states) "allowed-states must be a set")
|
||||
(assert (allowed-states initial-state) "initial-state must be in allowed states"))
|
||||
(StateMachine. initial-state state-transitions allowed-states default-accept nil))
|
||||
|
||||
|
||||
(def s0 (state-machine :x {:from-x-to-y false}))
|
||||
(transition! s0 :y)
|
|
@ -2,12 +2,13 @@
|
|||
(:refer-clojure :exclude [atom])
|
||||
(:require
|
||||
[freactive.dom :as dom]
|
||||
[freactive.core :refer [atom cursor
|
||||
state-machine transition!] :as r]
|
||||
[freactive.core :refer [atom cursor] :as r]
|
||||
[figwheel.client :as fw :include-macros true]
|
||||
[freactive.animation :as animation]
|
||||
[goog.string :as gstring])
|
||||
[goog.string :as gstring]
|
||||
[cljs.core.async :refer [chan put! <!]])
|
||||
(:require-macros
|
||||
[cljs.core.async.macros :refer [go go-loop]]
|
||||
[freactive.macros :refer [rx debug-rx]]))
|
||||
|
||||
(enable-console-print!)
|
||||
|
@ -96,12 +97,19 @@
|
|||
". "]])]
|
||||
(let [ease-x (animation/easer 0.0)
|
||||
ease-y (animation/easer 0.0)
|
||||
graph-state (state-machine :init
|
||||
{:from-showing-to-jitter false
|
||||
:from-disposing-to-jitter false})]
|
||||
graph-state (atom nil)
|
||||
action-ch (chan)]
|
||||
(go-loop []
|
||||
(let [action (<! action-ch)]
|
||||
(case @graph-state
|
||||
:updating
|
||||
(when (= action :ready)
|
||||
(reset! graph-state :ready))
|
||||
(reset! graph-state action))
|
||||
(recur)))
|
||||
[:div
|
||||
{:width "100%" :height "100%"
|
||||
:on-mousedown (fn [_] (transition! graph-state :jitter))}
|
||||
:on-mousedown (fn [_] (put! action-ch :jitter))}
|
||||
[:svg/svg
|
||||
{:width "100%" :height "100%"
|
||||
:style {:position "absolute" :left 0 :top "20px"}
|
||||
|
@ -125,16 +133,15 @@
|
|||
(for [i (range n*) j (range n*)] (circle (nth rights i) (nth tops j)))
|
||||
(for [i (range n*) j (range n*)] (circle (nth rights i) (nth bottoms j)))]
|
||||
{:node-attached (fn [x cb]
|
||||
(transition! graph-state :showing)
|
||||
(animation/start-easing! ease-x 0.0 1.0 1000
|
||||
animation/quad-in nil)
|
||||
(animation/start-easing! ease-y 0.0 1.0 1000 animation/quad-out
|
||||
(fn [] (transition! graph-state :ready))))
|
||||
(fn [] (put! action-ch :ready))))
|
||||
:on-jitter (fn [x cb]
|
||||
(jitter ease-x nil)
|
||||
(jitter ease-y (fn [] (transition! graph-state :ready))))
|
||||
:node-detaching (fn [x cb]
|
||||
(transition! graph-state :disposing)
|
||||
(jitter ease-y (fn []
|
||||
(put! action-ch :ready))))
|
||||
:node-detaching (fn [x cb] (put! action-ch :updating)
|
||||
(animation/start-easing! ease-x 1.0 0.0 1000
|
||||
animation/quad-out nil)
|
||||
(animation/start-easing! ease-y 1.0 0.0 1000 animation/quad-in cb))})))]])])
|
||||
|
@ -142,4 +149,3 @@
|
|||
(dom/mount! (.getElementById js/document "root") (view))
|
||||
|
||||
(fw/watch-and-reload)
|
||||
|
||||
|
|
Loading…
Reference in a new issue