rlm@81: (ns com.aurellem.title
rlm@81:   (:use (com.aurellem gb-driver vbm)))
rlm@81: 
rlm@87: (defn first-difference [base alt summary root]
rlm@87:   (loop [branch-point root
rlm@87:          actions []]
rlm@87:     (let [base-branch (step branch-point base)
rlm@87:           base-val (summary base-branch)
rlm@87:           alt-branch (step branch-point alt)
rlm@87:           alt-val (summary alt-branch)]
rlm@87:       (if (not= base-val alt-val)
rlm@87:         [(conj actions alt) alt-branch]
rlm@87:         (recur base-branch (conj actions base))))))
rlm@81: 
rlm@87: (defn advance
rlm@87:   ([base alt summary [commands state]]
rlm@87:      (let [[c s] (first-difference base alt summary state)]
rlm@87:        [(concat commands c) s]))
rlm@87:   ([base alt [commands state]]
rlm@87:      (advance base alt AF [commands state]))
rlm@87:   ([alt [commands state]]
rlm@87:      (advance [] alt [commands state])))
rlm@81: 
rlm@87: (def scroll-text (partial advance [:b] [:a :b]))
rlm@81: 
rlm@87: (defn start [] [[] (root)])
rlm@81: 
rlm@88: (defn-memo title []
rlm@88:   (->> (start)
rlm@87:        (advance [] [:a])
rlm@87:        (advance [] [:start])
rlm@87:        (advance [] [:a])
rlm@87:        (advance [] [:start])))
rlm@81: 
rlm@88: (defn-memo oak []
rlm@87:   (->> (title)
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@91:        ))
rlm@81: 
rlm@91: (defn-memo name-entry-rlm []
rlm@87:   (->> (oak)
rlm@91:        (advance [] [:a])
rlm@87:        (advance [] [:r] DE)
rlm@87:        (play-moves
rlm@87:         [[]
rlm@87:          [:r] [] [:r] [] [:r] [] [:r] []
rlm@87:          [:r] [] [:r] [] [:r] [] [:d] [:a]  
rlm@87:          [:l] [] [:l] [] [:l] [] [:l] []
rlm@87:          [:l] [] [:l] [:a] [] [:r] [:a]
rlm@87:          [:r] [] [:r] [] [:r] [] [:r] []
rlm@87:          [:r] [] [:d] [] [:d] [] [:d] [:a]
rlm@87:          ])))
rlm@91: 
rlm@91: (defn-memo name-entry-ash []
rlm@91:   (->> (oak)
rlm@91:        (advance [] [:d])
rlm@91:        (advance [] [:d])
rlm@91:        (advance [] [:a])))
rlm@91:        
rlm@91: (defn-memo rival-name-entry-gary []
rlm@91:   (->> (name-entry-ash)
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        (advance [] [:d])
rlm@87:        (advance [] [:d])
rlm@87:        (advance [] [:a])))
rlm@81: 
rlm@91: (defn-memo rival-name-entry-blue []
rlm@91:   (->> (name-entry-ash)
rlm@91:        scroll-text
rlm@91:        scroll-text
rlm@91:        scroll-text
rlm@91:        scroll-text
rlm@91:        scroll-text
rlm@91:        (advance [] [:d])
rlm@91:        (advance [] [:a])))
rlm@91: 
rlm@87: (defn-memo finish-title []
rlm@91:   (->> (rival-name-entry-blue)
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text
rlm@87:        scroll-text))
rlm@81: 
rlm@89: (def title-frames 2323)
rlm@89: 
rlm@89: (defn title-checkpoint! []
rlm@88:   (let [[moves state] (finish-title)]
rlm@89:     (assert (= title-frames (:frame state)))
rlm@88:     [(write-moves! moves) (write-state! state)]))
rlm@88: 
rlm@88: (defn intro []
rlm@88:   [(read-moves title-frames)
rlm@88:    (read-state title-frames)])
rlm@88: 
rlm@88: (defn test-intro []
rlm@88:   (play-vbm (moves->filename title-frames)))
rlm@88: 
rlm@87: ;; TODO might be able to glue these together more elegantly with monads
rlm@87: