Mercurial > vba-clojure
view clojure/com/aurellem/run/title.clj @ 254:5dafe6188ca5
fixed incompetence.
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Mon, 26 Mar 2012 04:17:10 -0500 |
parents | b7f682bb3090 |
children | c7b002525041 |
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 (def scroll-text (partial advance [:b] [:a :b]))26 (defn start [] [[] (root)])28 (defn-memo title29 ([] (title (start)))30 ([script]31 (->> script32 (advance [] [:a])33 (advance [] [:start])34 (advance [] [:a])35 (advance [] [:start]))))37 (defn-memo oak38 ([] (oak (title)))39 ([script]40 (->> script41 scroll-text42 scroll-text43 scroll-text44 scroll-text45 scroll-text46 scroll-text47 scroll-text48 scroll-text49 scroll-text50 scroll-text51 scroll-text52 scroll-text53 scroll-text)))55 (defn-memo name-entry-rlm56 ([] (name-entry-rlm (oak)))57 ([script]58 (->> script59 (advance [] [:a])60 (advance [] [:r] DE)61 (play-moves62 [[]63 [:r] [] [:r] [] [:r] [] [:r] []64 [:r] [] [:r] [] [:r] [] [:d] [:a]65 [:l] [] [:l] [] [:l] [] [:l] []66 [:l] [] [:l] [:a] [] [:r] [:a]67 [:r] [] [:r] [] [:r] [] [:r] []68 [:r] [] [:d] [] [:d] [] [:d] [:a]]))))70 (defn-memo name-entry-ash71 ([] (name-entry-ash (oak)))72 ([script]73 (->> script74 (advance [] [:d])75 (advance [] [:d])76 (advance [] [:a]))))78 (defn-memo rival-name-entry-gary79 ([] (rival-name-entry-gary (name-entry-ash)))80 ([script]81 (->> script82 scroll-text83 scroll-text84 scroll-text85 scroll-text86 scroll-text87 (advance [] [:d])88 (advance [] [:d])89 (advance [] [:a]))))91 (defn-memo rival-name-entry-blue92 ([] (rival-name-entry-blue (name-entry-ash)))93 ([script]94 (->> script95 scroll-text96 scroll-text97 scroll-text98 scroll-text99 scroll-text100 (advance [] [:d])101 (advance [] [:a]))))103 (defn-memo finish-title104 ([] (finish-title (rival-name-entry-blue)))105 ([script]106 (->> script107 scroll-text108 scroll-text109 scroll-text110 scroll-text111 scroll-text112 scroll-text113 scroll-text)))115 (def title-frames 2194)117 (defn title-checkpoint! []118 (let [[moves state] (finish-title)]119 (assert (= title-frames (count moves)))120 [(write-moves! moves "title-checkpoint")121 (write-state! state "title-checkpoint")]))123 (defn intro []124 [(read-moves "title-checkpoint")125 (read-state "title-checkpoint")])127 (defn test-intro []128 (play-vbm (moves-filename "title-checkpoint")))130 ;; TODO might be able to glue these together more elegantly with monads