yogsototh/freactive
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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.

Browse source
This commit is contained in:
Aaron Craelius 2014-11-18 22:26:16 -05:00
parent fed0f27a73
commit cf678507b6
5 changed files with 180 additions and 183 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
project.clj
View file

@ -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"]

160
src/clojure/freactive/core.cljs
View file

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

10
src/clojure/freactive/dom.cljs
View file

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

32
test/freactive/dom_perf.cljs
View file

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