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@85: (defn advance
rlm@85:   ([base alt summary [commands state]]
rlm@85:      (let [[c s] (first-difference base alt summary state)]
rlm@85:        [(concat commands c) s]))
rlm@85:   ([base alt [commands state]]
rlm@85:      (advance base alt AF [commands state]))
rlm@85:   ([alt [commands state]]
rlm@85:      (advance [] alt [commands state])))
rlm@85: 
rlm@85: (def scroll-text (partial advance [:b] [:a :b]))
rlm@85: 
rlm@84: (defn title []
rlm@85:   (->> [[] (root)]
rlm@85:        (advance [] [:a])
rlm@85:        (advance [] [:start])
rlm@85:        (advance [] [:a])
rlm@85:        (advance [] [:start])))
rlm@84: 
rlm@85: (def title-end (second (title)))
rlm@84: 
rlm@84: (defn oak []
rlm@85:   (->> [[] title-end]
rlm@85:        scroll-text
rlm@85:        scroll-text
rlm@85:        scroll-text
rlm@85:        scroll-text
rlm@85:        scroll-text
rlm@85:        scroll-text
rlm@85:        scroll-text
rlm@85:        scroll-text
rlm@85:        scroll-text
rlm@85:        scroll-text
rlm@85:        scroll-text
rlm@85:        scroll-text
rlm@85:        scroll-text
rlm@85:        (advance [] [:a])))
rlm@85: 
rlm@85: ;; looks like it might need a monad here if this pattern continues
rlm@84: 
rlm@84: (def oak-end (second (oak)))
rlm@85:            
rlm@85: (defn name-entry []
rlm@85:   (->> [[] oak-end]
rlm@85:        (advance [] [:r] DE)
rlm@85:        ((fn [[moves state]]
rlm@85:           (play-moves
rlm@85:            state
rlm@85:             [[]
rlm@85:              [:r] [] [:r] [] [:r] [] [:r] []
rlm@85:              [:r] [] [:r] [] [:r] [] [:d] [:a]  
rlm@85:              [:l] [] [:l] [] [:l] [] [:l] []
rlm@85:              [:l] [] [:l] [:a] [] [:r] [:a]
rlm@85:              [:r] [] [:r] [] [:r] [] [:r] []
rlm@85:              [:r] [] [:d] [] [:d] [] [:d] [:a]
rlm@85:              ])))))
rlm@85:           
rlm@84: