Mercurial > vba-clojure
view clojure/com/aurellem/run/title.clj @ 190:9a7a46c4aa1b
extending functionality of support namespaces in prepreation of give-pokemon
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Thu, 22 Mar 2012 16:34:10 -0500 |
parents | 09caf6a5bbf4 |
children | b7f682bb3090 |
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 title []29 (->> (start)30 (advance [] [:a])31 (advance [] [:start])32 (advance [] [:a])33 (advance [] [:start])))35 (defn-memo oak []36 (->> (title)37 scroll-text38 scroll-text39 scroll-text40 scroll-text41 scroll-text42 scroll-text43 scroll-text44 scroll-text45 scroll-text46 scroll-text47 scroll-text48 scroll-text49 scroll-text50 ))52 (defn-memo name-entry-rlm []53 (->> (oak)54 (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]64 ])))66 (defn-memo name-entry-ash []67 (->> (oak)68 (advance [] [:d])69 (advance [] [:d])70 (advance [] [:a])))72 (defn-memo rival-name-entry-gary []73 (->> (name-entry-ash)74 scroll-text75 scroll-text76 scroll-text77 scroll-text78 scroll-text79 (advance [] [:d])80 (advance [] [:d])81 (advance [] [:a])))83 (defn-memo rival-name-entry-blue []84 (->> (name-entry-ash)85 scroll-text86 scroll-text87 scroll-text88 scroll-text89 scroll-text90 (advance [] [:d])91 (advance [] [:a])))93 (defn-memo finish-title []94 (->> (rival-name-entry-blue)95 scroll-text96 scroll-text97 scroll-text98 scroll-text99 scroll-text100 scroll-text101 scroll-text))103 (def title-frames 2323)105 (defn title-checkpoint! []106 (let [[moves state] (finish-title)]107 (assert (= title-frames (:frame state)))108 [(write-moves! moves) (write-state! state)]))110 (defn intro []111 [(read-moves title-frames)112 (read-state title-frames)])114 (defn test-intro []115 (play-vbm (moves->filename title-frames)))117 ;; TODO might be able to glue these together more elegantly with monads