Permalink
Browse files

initial import

Signed-off-by: Chris Granger <ibdknox@gmail.com>
  • Loading branch information...
ibdknox committed Feb 4, 2012
0 parents commit 599038aea1fc14edbebe6f3ea154ea6afe6be0e7
Showing with 214 additions and 0 deletions.
  1. +5 −0 .gitignore
  2. +13 −0 README.md
  3. +3 −0 project.clj
  4. +26 −0 src/waltz/history.cljs
  5. +22 −0 src/waltz/macros.clj
  6. +109 −0 src/waltz/state.cljs
  7. +29 −0 src/waltz/transition.cljs
  8. +7 −0 test/waltz/core_test.clj
@@ -0,0 +1,5 @@
+pom.xml
+*jar
+/lib/
+/classes/
+.lein-deps-sum
@@ -0,0 +1,13 @@
+# waltz
+
+I'm an app. I sure don't do much.
+
+## Usage
+
+FIXME
+
+## License
+
+Copyright (C) 2011 FIXME
+
+Distributed under the Eclipse Public License, the same as Clojure.
@@ -0,0 +1,3 @@
+(defproject waltz "0.1.0-SNAPSHOT"
+ :description "FIXME: write description"
+ :dependencies [[clojure "1.3.0"]])
@@ -0,0 +1,26 @@
+(ns waltz.history
+ (:refer-clojure :exclude [set get])
+ (:require [clojure.browser.event :as event]
+ [goog.History :as history]
+ [goog.history.Html5History :as history5]))
+
+(defn create-history []
+ (let [h (if (history5/isSupported)
+ (goog.history.Html5History.)
+ (goog.History.))]
+ (.setEnabled h true)
+ h))
+
+(def history (create-history))
+
+(defn set [token]
+ (.setToken history (name token)))
+
+(defn get []
+ (let [t (.getToken history)]
+ (if (= "" t)
+ nil
+ (keyword t))))
+
+(defn listen [callback]
+ (event/listen history "navigate" callback))
@@ -0,0 +1,22 @@
+(ns waltz.macros)
+
+(defmacro defstate
+ [sm name & body]
+ `(let [s# (-> (waltz.state/state*)
+ ~@body)]
+ (waltz.state/add-state ~sm ~name s#)))
+
+(defmacro deftrans
+ [sm name params & body]
+ `(waltz.state/add-transition ~sm ~name (fn ~params
+ ~@body)))
+
+(defmacro in [sm & body]
+ (if (second body)
+ `(waltz.state/in* ~sm (fn ~@body))
+ `(waltz.state/in* ~sm ~@body)))
+
+(defmacro out [sm & body]
+ (if (second body)
+ `(waltz.state/out* ~sm (fn ~@body))
+ `(waltz.state/out* ~sm ~@body)))
@@ -0,0 +1,109 @@
+(ns waltz.state
+ (:refer-clojure :exclude [set]))
+
+(declare get-name)
+
+(defn debug-log [sm v & vs]
+ (when (and js/console
+ (@sm :debug))
+ (let [s (apply str (get-name sm) " :: " v vs)]
+ (.log js/console s))))
+
+(defn ->coll [v]
+ (if (coll? v)
+ v
+ [v]))
+
+(defn state* []
+ {:in []
+ :out []
+ :constraints []})
+
+(defn machine [& [n]]
+ (atom {:debug true
+ :name (name n)
+ :current #{}
+ :states {}
+ :transitions {}}))
+
+(defn get-name [sm]
+ (get-in-sm sm [:name]))
+
+(defn get-in-sm [sm ks]

This comment has been minimized.

Show comment Hide comment
@bhenry

bhenry Apr 19, 2012

is this supposed to be before get-name? i can't figure out how this compiles.

@bhenry

bhenry Apr 19, 2012

is this supposed to be before get-name? i can't figure out how this compiles.

This comment has been minimized.

Show comment Hide comment
@ibdknox

ibdknox Apr 19, 2012

Owner

It should be, yeah. The ClojureScript compiler doesn't have the same ordering strictness that the Clojure compiler does because JS as a runtime doesn't have the same requirements as the JVM does.

@ibdknox

ibdknox Apr 19, 2012

Owner

It should be, yeah. The ClojureScript compiler doesn't have the same ordering strictness that the Clojure compiler does because JS as a runtime doesn't have the same requirements as the JVM does.

This comment has been minimized.

Show comment Hide comment
@bhenry

bhenry Apr 19, 2012

oh that's right. it's easy to forget that i'm looking at clojurescript.

@bhenry

bhenry Apr 19, 2012

oh that's right. it's easy to forget that i'm looking at clojurescript.

+ (get-in @sm ks))
+
+(defn assoc-sm [sm ks v]
+ (swap! sm #(assoc-in % ks v)))
+
+(defn update-sm [sm & fntail]
+ (swap! sm #(apply update-in % fntail)))
+
+(defn current [sm]
+ (get-in-sm sm [:current]))
+
+(defn in? [sm state]
+ ((current sm) state))
+
+(defn has-state? [sm state]
+ (get-in-sm sm [:states state]))
+
+(defn has-transition? [sm trans]
+ (get-in-sm sm [:transitions trans]))
+
+(defn add-state [sm name v]
+ (assoc-sm sm [:states name] v))
+
+(defn add-transition [sm name v]
+ (assoc-sm sm [:transitions name] v))
+
+(defn in* [state fn]
+ (update-in state [:in] conj fn))
+
+(defn out* [state fn]
+ (update-in state [:out] conj fn))
+
+(defn constraint [state fn]
+ (update-in state [:constraint] conj fn))
+
+(defn can-transition? [sm state]
+ (let [trans (get-in-sm sm [:states state :constraints])]
+ (if trans
+ (every? #(% state) trans)
+ true)))
+
+(defn set [sm states & context]
+ (doseq [state (->coll states)]
+ (when (can-transition? sm state)
+ (let [cur-in (get-in-sm sm [:states state :in])]
+ (update-sm sm [:current] conj state)
+ (debug-log sm "(set " (str state) ") -> " (pr-str (current sm)))
+ (when (seq cur-in)
+ (debug-log sm "(in " (str state) ")")
+ (doseq [func cur-in]
+ (apply func context))))))
+ sm)
+
+(defn unset [sm states & context]
+ (doseq [state (->coll states)]
+ (when (in? sm state)
+ (let [cur-out (get-in-sm sm [:states state :out])]
+ (update-sm sm [:current] disj state)
+ (debug-log sm "(unset " (str state ")") " -> " (pr-str (current sm)))
+ (when (seq cur-out)
+ (debug-log sm "(out " (str state) ")")
+ (doseq [func cur-out]
+ (apply func context))))))
+ sm)
+
+(defn set-ex [sm to-unset to-set & context]
+ (apply unset sm to-unset context)
+ (apply set sm to-set context))
+
+(defn transition [sm ts & context]
+ (doseq [trans (->coll ts)]
+ (when-let [t (get-in-sm sm [:transitions trans])]
+ (let [res (apply t context)]
+ (debug-log sm "(trans " (str trans) ") -> " (boolean res) " :: context " (pr-str context))))))
+
+(defn set-debug [sm dbg]
+ (assoc-sm sm :debug dbg))
@@ -0,0 +1,29 @@
+(ns waltz.transition
+ (:require [waltz.history :as history]
+ [waltz.state :as state])
+ (:use [waltz.state :only [transition debug-log]]))
+
+(defn exclude [sm name to-set to-unset]
+ (state/add-transition sm name (fn [& args]
+ (state/unset sm to-unset)
+ (apply state/set sm to-set args))))
+
+(defn by-url [sm]
+ (let [url (.-location.pathname js/window)]
+ (transition sm [:url url])))
+
+(defn by-hash [sm]
+ (history/listen (fn [e]
+ (let [token (.-token e)
+ token (if (= "" token)
+ "index"
+ token)
+ type (.-type e)
+ navigation? (.-isNavigation e)
+ kw (keyword (str "hash:" token))]
+ (debug-log sm "hash keyword: " kw)
+ (debug-log sm "hash changed: " token " :: navigation? " navigation? " :: type " type)
+ (when navigation?
+ (transition sm kw))))))
+
+
@@ -0,0 +1,7 @@
+(ns waltz.core-test
+ (:use clojure.test
+ waltz.core))
+
+(deftest a-test
+ (testing "FIXME, I fail."
+ (is (= 0 1))))

0 comments on commit 599038a

Please sign in to comment.