Mercurial > vba-clojure
view clojure/com/aurellem/run/title.clj @ 256:c7b002525041
improved scroll-text to scroll through multiple lines of text
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Mon, 26 Mar 2012 06:11:49 -0500 |
parents | 5dafe6188ca5 |
children | 8e63b0bb8ea3 |
line wrap: on
line source
1 (ns com.aurellem.run.title2 (:use (com.aurellem.gb gb-driver vbm)))4 (defn first-difference [base alt summary root]5 (loop [branch-point root6 actions []]7 (let [base-branch (step branch-point base)8 base-val (summary base-branch)9 alt-branch (step branch-point alt)10 alt-val (summary alt-branch)]11 (if (not= base-val alt-val)12 [(conj actions alt) alt-branch]13 (recur base-branch (conj actions base))))))15 (defn advance16 ([base alt summary [commands state]]17 (let [[c s] (first-difference base alt summary state)]18 [(concat commands c) s]))19 ([base alt [commands state]]20 (advance base alt AF [commands state]))21 ([alt [commands state]]22 (advance [] alt [commands state])))24 (defn scroll-text25 ([script]26 (advance [:b] [:a :b] script))27 ([n script]28 (reduce (fn [script _]29 (scroll-text script))30 script31 (range n))))33 (defn start [] [[] (root)])35 (defn-memo title36 ([] (title (start)))37 ([script]38 (->> script39 (advance [] [:a])40 (advance [] [:start])41 (advance [] [:a])42 (advance [] [:start]))))44 (defn-memo oak45 ([] (oak (title)))46 ([script]47 (->> script48 (scroll-text 13))))50 (defn-memo name-entry-rlm51 ([] (name-entry-rlm (oak)))52 ([script]53 (->> script54 (advance [] [:a])55 (advance [] [:r] DE)56 (play-moves57 [[]58 [:r] [] [:r] [] [:r] [] [:r] []59 [:r] [] [:r] [] [:r] [] [:d] [:a]60 [:l] [] [:l] [] [:l] [] [:l] []61 [:l] [] [:l] [:a] [] [:r] [:a]62 [:r] [] [:r] [] [:r] [] [:r] []63 [:r] [] [:d] [] [:d] [] [:d] [:a]]))))65 (defn-memo name-entry-ash66 ([] (name-entry-ash (oak)))67 ([script]68 (->> script69 (advance [] [:d])70 (advance [] [:d])71 (advance [] [:a]))))73 (defn-memo rival-name-entry-gary74 ([] (rival-name-entry-gary (name-entry-ash)))75 ([script]76 (->> script77 (scroll-text 5)78 (advance [] [:d])79 (advance [] [:d])80 (advance [] [:a]))))82 (defn-memo rival-name-entry-blue83 ([] (rival-name-entry-blue (name-entry-ash)))84 ([script]85 (->> script86 (scroll-text 5)87 (advance [] [:d])88 (advance [] [:a]))))90 (defn-memo finish-title91 ([] (finish-title (rival-name-entry-blue)))92 ([script]93 (->> script94 (scroll-text 7))))96 (def title-frames 2194)98 (defn title-checkpoint! []99 (let [[moves state] (finish-title)]100 (assert (= title-frames (count moves)))101 [(write-moves! moves "title-checkpoint")102 (write-state! state "title-checkpoint")]))104 (defn intro []105 [(read-moves "title-checkpoint")106 (read-state "title-checkpoint")])108 (defn test-intro []109 (play-vbm (moves-filename "title-checkpoint")))111 ;; TODO might be able to glue these together more elegantly with monads