rlm@84: (ns com.aurellem.title2
rlm@84:   (:use (com.aurellem gb-funs vbm)))
rlm@84: 
rlm@84: (defn first-difference [base alt summary root]
rlm@84:   (loop [branch-point root
rlm@84:          actions []]
rlm@84:     (let [base-branch (step branch-point base)
rlm@84:           base-val (summary base-branch)
rlm@84:           alt-branch (step branch-point alt)
rlm@84:           alt-val (summary alt-branch)]
rlm@84:       (if (not= base-val alt-val)
rlm@84:         [(conj actions alt) alt-branch]
rlm@84:         (recur base-branch (conj actions base))))))
rlm@84: 
rlm@84: (defn title []
rlm@84:   (let [[c-1 s-1] (first-difference [] [:a] AF (root))
rlm@84:         [c-2 s-2] (first-difference [] [:start] AF s-1)
rlm@84:         [c-3 s-3] (first-difference [] [:a] AF s-2)
rlm@84:         [c-4 s-4] (first-difference [] [:start] AF s-3)]
rlm@84:     [(concat c-1 c-2 c-3 c-3 c-4) s-4]))
rlm@84: 
rlm@84: (def menu-end (second (title)))
rlm@84: 
rlm@84: (defn scroll-text [[commands state]]
rlm@84:   (let [[c s] (first-difference [:b] [:a :b] AF state)]
rlm@84:     [(concat commands c) s]))
rlm@84: 
rlm@84: (defn oak []
rlm@84:   (-> [[] menu-end]
rlm@84:       scroll-text
rlm@84:       scroll-text
rlm@84:       scroll-text
rlm@84:       scroll-text
rlm@84:       scroll-text
rlm@84:       scroll-text
rlm@84:       scroll-text
rlm@84:       scroll-text
rlm@84:       scroll-text
rlm@84:       scroll-text
rlm@84:       scroll-text
rlm@84:       scroll-text
rlm@84:       scroll-text))
rlm@84: 
rlm@84: (def oak-end (second (oak)))
rlm@84:   
rlm@84: 
rlm@84: ;; looks like it might need a monad here if this pattern continues