1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/clojure/com/aurellem/title2.clj	Fri Mar 09 23:28:07 2012 -0600
     1.3 @@ -0,0 +1,47 @@
     1.4 +(ns com.aurellem.title2
     1.5 +  (:use (com.aurellem gb-funs vbm)))
     1.6 +
     1.7 +(defn first-difference [base alt summary root]
     1.8 +  (loop [branch-point root
     1.9 +         actions []]
    1.10 +    (let [base-branch (step branch-point base)
    1.11 +          base-val (summary base-branch)
    1.12 +          alt-branch (step branch-point alt)
    1.13 +          alt-val (summary alt-branch)]
    1.14 +      (if (not= base-val alt-val)
    1.15 +        [(conj actions alt) alt-branch]
    1.16 +        (recur base-branch (conj actions base))))))
    1.17 +
    1.18 +(defn title []
    1.19 +  (let [[c-1 s-1] (first-difference [] [:a] AF (root))
    1.20 +        [c-2 s-2] (first-difference [] [:start] AF s-1)
    1.21 +        [c-3 s-3] (first-difference [] [:a] AF s-2)
    1.22 +        [c-4 s-4] (first-difference [] [:start] AF s-3)]
    1.23 +    [(concat c-1 c-2 c-3 c-3 c-4) s-4]))
    1.24 +
    1.25 +(def menu-end (second (title)))
    1.26 +
    1.27 +(defn scroll-text [[commands state]]
    1.28 +  (let [[c s] (first-difference [:b] [:a :b] AF state)]
    1.29 +    [(concat commands c) s]))
    1.30 +
    1.31 +(defn oak []
    1.32 +  (-> [[] menu-end]
    1.33 +      scroll-text
    1.34 +      scroll-text
    1.35 +      scroll-text
    1.36 +      scroll-text
    1.37 +      scroll-text
    1.38 +      scroll-text
    1.39 +      scroll-text
    1.40 +      scroll-text
    1.41 +      scroll-text
    1.42 +      scroll-text
    1.43 +      scroll-text
    1.44 +      scroll-text
    1.45 +      scroll-text))
    1.46 +
    1.47 +(def oak-end (second (oak)))
    1.48 +  
    1.49 +
    1.50 +;; looks like it might need a monad here if this pattern continues
    1.51 \ No newline at end of file