1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/clojure/com/aurellem/run/title.clj	Mon Mar 19 21:23:46 2012 -0500
     1.3 @@ -0,0 +1,118 @@
     1.4 +(ns com.aurellem.title
     1.5 +  (:use (com.aurellem gb-driver 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 advance
    1.19 +  ([base alt summary [commands state]]
    1.20 +     (let [[c s] (first-difference base alt summary state)]
    1.21 +       [(concat commands c) s]))
    1.22 +  ([base alt [commands state]]
    1.23 +     (advance base alt AF [commands state]))
    1.24 +  ([alt [commands state]]
    1.25 +     (advance [] alt [commands state])))
    1.26 +
    1.27 +(def scroll-text (partial advance [:b] [:a :b]))
    1.28 +
    1.29 +(defn start [] [[] (root)])
    1.30 +
    1.31 +(defn-memo title []
    1.32 +  (->> (start)
    1.33 +       (advance [] [:a])
    1.34 +       (advance [] [:start])
    1.35 +       (advance [] [:a])
    1.36 +       (advance [] [:start])))
    1.37 +
    1.38 +(defn-memo oak []
    1.39 +  (->> (title)
    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 +       scroll-text
    1.47 +       scroll-text
    1.48 +       scroll-text
    1.49 +       scroll-text
    1.50 +       scroll-text
    1.51 +       scroll-text
    1.52 +       scroll-text
    1.53 +       ))
    1.54 +
    1.55 +(defn-memo name-entry-rlm []
    1.56 +  (->> (oak)
    1.57 +       (advance [] [:a])
    1.58 +       (advance [] [:r] DE)
    1.59 +       (play-moves
    1.60 +        [[]
    1.61 +         [:r] [] [:r] [] [:r] [] [:r] []
    1.62 +         [:r] [] [:r] [] [:r] [] [:d] [:a]  
    1.63 +         [:l] [] [:l] [] [:l] [] [:l] []
    1.64 +         [:l] [] [:l] [:a] [] [:r] [:a]
    1.65 +         [:r] [] [:r] [] [:r] [] [:r] []
    1.66 +         [:r] [] [:d] [] [:d] [] [:d] [:a]
    1.67 +         ])))
    1.68 +
    1.69 +(defn-memo name-entry-ash []
    1.70 +  (->> (oak)
    1.71 +       (advance [] [:d])
    1.72 +       (advance [] [:d])
    1.73 +       (advance [] [:a])))
    1.74 +       
    1.75 +(defn-memo rival-name-entry-gary []
    1.76 +  (->> (name-entry-ash)
    1.77 +       scroll-text
    1.78 +       scroll-text
    1.79 +       scroll-text
    1.80 +       scroll-text
    1.81 +       scroll-text
    1.82 +       (advance [] [:d])
    1.83 +       (advance [] [:d])
    1.84 +       (advance [] [:a])))
    1.85 +
    1.86 +(defn-memo rival-name-entry-blue []
    1.87 +  (->> (name-entry-ash)
    1.88 +       scroll-text
    1.89 +       scroll-text
    1.90 +       scroll-text
    1.91 +       scroll-text
    1.92 +       scroll-text
    1.93 +       (advance [] [:d])
    1.94 +       (advance [] [:a])))
    1.95 +
    1.96 +(defn-memo finish-title []
    1.97 +  (->> (rival-name-entry-blue)
    1.98 +       scroll-text
    1.99 +       scroll-text
   1.100 +       scroll-text
   1.101 +       scroll-text
   1.102 +       scroll-text
   1.103 +       scroll-text
   1.104 +       scroll-text))
   1.105 +
   1.106 +(def title-frames 2323)
   1.107 +
   1.108 +(defn title-checkpoint! []
   1.109 +  (let [[moves state] (finish-title)]
   1.110 +    (assert (= title-frames (:frame state)))
   1.111 +    [(write-moves! moves) (write-state! state)]))
   1.112 +
   1.113 +(defn intro []
   1.114 +  [(read-moves title-frames)
   1.115 +   (read-state title-frames)])
   1.116 +
   1.117 +(defn test-intro []
   1.118 +  (play-vbm (moves->filename title-frames)))
   1.119 +
   1.120 +;; TODO might be able to glue these together more elegantly with monads
   1.121 +