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"]]
|
[lein-figwheel "0.1.5-SNAPSHOT"]]
|
||||||
:dependencies
|
:dependencies
|
||||||
[[com.cemerick/clojurescript.test "0.3.1"]
|
[[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"]
|
:resource-paths ["example"]
|
||||||
:cljsbuild {:builds [{:id "example"
|
:cljsbuild {:builds [{:id "example"
|
||||||
:source-paths ["src/clojure" "test"]
|
:source-paths ["src/clojure" "test"]
|
||||||
|
|
|
@ -372,163 +372,3 @@
|
||||||
([ref korks-or-getter] (cursor* ref korks-or-getter nil true ))
|
([ref korks-or-getter] (cursor* ref korks-or-getter nil true ))
|
||||||
([ref getter setter] (cursor* ref getter setter 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))
|
(.-element-spec state))
|
||||||
x))
|
x))
|
||||||
|
|
||||||
(defprotocol IHasDOMNode
|
|
||||||
(-get-dom-node [x]))
|
|
||||||
|
|
||||||
(defn get-dom-node [x]
|
|
||||||
(if (dom-node? x)
|
|
||||||
x
|
|
||||||
(-get-dom-node x)))
|
|
||||||
|
|
||||||
(defprotocol IRemove
|
(defprotocol IRemove
|
||||||
(-remove! [x]))
|
(-remove! [x]))
|
||||||
|
|
||||||
|
@ -289,7 +281,7 @@
|
||||||
(defn set-data-state!
|
(defn set-data-state!
|
||||||
([element state]
|
([element state]
|
||||||
(let [cur-state (get-data-state element)
|
(let [cur-state (get-data-state element)
|
||||||
state (name state)]
|
state (when state (name state))]
|
||||||
(when-not (identical? cur-state state)
|
(when-not (identical? cur-state state)
|
||||||
(do-set-data-state! element state)
|
(do-set-data-state! element state)
|
||||||
(let [leave-transition (get-transition element (keyword (str "after-" cur-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])
|
(:refer-clojure :exclude [atom])
|
||||||
(:require
|
(:require
|
||||||
[freactive.dom :as dom]
|
[freactive.dom :as dom]
|
||||||
[freactive.core :refer [atom cursor
|
[freactive.core :refer [atom cursor] :as r]
|
||||||
state-machine transition!] :as r]
|
|
||||||
[figwheel.client :as fw :include-macros true]
|
[figwheel.client :as fw :include-macros true]
|
||||||
[freactive.animation :as animation]
|
[freactive.animation :as animation]
|
||||||
[goog.string :as gstring])
|
[goog.string :as gstring]
|
||||||
|
[cljs.core.async :refer [chan put! <!]])
|
||||||
(:require-macros
|
(:require-macros
|
||||||
|
[cljs.core.async.macros :refer [go go-loop]]
|
||||||
[freactive.macros :refer [rx debug-rx]]))
|
[freactive.macros :refer [rx debug-rx]]))
|
||||||
|
|
||||||
(enable-console-print!)
|
(enable-console-print!)
|
||||||
|
@ -96,12 +97,19 @@
|
||||||
". "]])]
|
". "]])]
|
||||||
(let [ease-x (animation/easer 0.0)
|
(let [ease-x (animation/easer 0.0)
|
||||||
ease-y (animation/easer 0.0)
|
ease-y (animation/easer 0.0)
|
||||||
graph-state (state-machine :init
|
graph-state (atom nil)
|
||||||
{:from-showing-to-jitter false
|
action-ch (chan)]
|
||||||
:from-disposing-to-jitter false})]
|
(go-loop []
|
||||||
|
(let [action (<! action-ch)]
|
||||||
|
(case @graph-state
|
||||||
|
:updating
|
||||||
|
(when (= action :ready)
|
||||||
|
(reset! graph-state :ready))
|
||||||
|
(reset! graph-state action))
|
||||||
|
(recur)))
|
||||||
[:div
|
[:div
|
||||||
{:width "100%" :height "100%"
|
{:width "100%" :height "100%"
|
||||||
:on-mousedown (fn [_] (transition! graph-state :jitter))}
|
:on-mousedown (fn [_] (put! action-ch :jitter))}
|
||||||
[:svg/svg
|
[:svg/svg
|
||||||
{:width "100%" :height "100%"
|
{:width "100%" :height "100%"
|
||||||
:style {:position "absolute" :left 0 :top "20px"}
|
: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 tops j)))
|
||||||
(for [i (range n*) j (range n*)] (circle (nth rights i) (nth bottoms j)))]
|
(for [i (range n*) j (range n*)] (circle (nth rights i) (nth bottoms j)))]
|
||||||
{:node-attached (fn [x cb]
|
{:node-attached (fn [x cb]
|
||||||
(transition! graph-state :showing)
|
|
||||||
(animation/start-easing! ease-x 0.0 1.0 1000
|
(animation/start-easing! ease-x 0.0 1.0 1000
|
||||||
animation/quad-in nil)
|
animation/quad-in nil)
|
||||||
(animation/start-easing! ease-y 0.0 1.0 1000 animation/quad-out
|
(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]
|
:on-jitter (fn [x cb]
|
||||||
(jitter ease-x nil)
|
(jitter ease-x nil)
|
||||||
(jitter ease-y (fn [] (transition! graph-state :ready))))
|
(jitter ease-y (fn []
|
||||||
:node-detaching (fn [x cb]
|
(put! action-ch :ready))))
|
||||||
(transition! graph-state :disposing)
|
:node-detaching (fn [x cb] (put! action-ch :updating)
|
||||||
(animation/start-easing! ease-x 1.0 0.0 1000
|
(animation/start-easing! ease-x 1.0 0.0 1000
|
||||||
animation/quad-out nil)
|
animation/quad-out nil)
|
||||||
(animation/start-easing! ease-y 1.0 0.0 1000 animation/quad-in cb))})))]])])
|
(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))
|
(dom/mount! (.getElementById js/document "root") (view))
|
||||||
|
|
||||||
(fw/watch-and-reload)
|
(fw/watch-and-reload)
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue