Mercurial > vba-clojure

annotate clojure/com/aurellem/run/title.clj @ 311:8fa0f36140b4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
began writing out my notes on the ROM in an org file.
author Dylan Holmes <ocsenave@gmail.com>
date Sun, 01 Apr 2012 03:20:33 -0500
parents c7b002525041
children 8e63b0bb8ea3
rev   line source
rlm@170 1 (ns com.aurellem.run.title
rlm@170 2 (:use (com.aurellem.gb gb-driver vbm)))
rlm@81 3
rlm@87 4 (defn first-difference [base alt summary root]
rlm@87 5 (loop [branch-point root
rlm@87 6 actions []]
rlm@87 7 (let [base-branch (step branch-point base)
rlm@87 8 base-val (summary base-branch)
rlm@87 9 alt-branch (step branch-point alt)
rlm@87 10 alt-val (summary alt-branch)]
rlm@87 11 (if (not= base-val alt-val)
rlm@87 12 [(conj actions alt) alt-branch]
rlm@87 13 (recur base-branch (conj actions base))))))
rlm@81 14
rlm@87 15 (defn advance
rlm@87 16 ([base alt summary [commands state]]
rlm@87 17 (let [[c s] (first-difference base alt summary state)]
rlm@87 18 [(concat commands c) s]))
rlm@87 19 ([base alt [commands state]]
rlm@87 20 (advance base alt AF [commands state]))
rlm@87 21 ([alt [commands state]]
rlm@87 22 (advance [] alt [commands state])))
rlm@81 23
rlm@256 24 (defn scroll-text
rlm@256 25 ([script]
rlm@256 26 (advance [:b] [:a :b] script))
rlm@256 27 ([n script]
rlm@256 28 (reduce (fn [script _]
rlm@256 29 (scroll-text script))
rlm@256 30 script
rlm@256 31 (range n))))
rlm@81 32
rlm@87 33 (defn start [] [[] (root)])
rlm@81 34
rlm@250 35 (defn-memo title
rlm@250 36 ([] (title (start)))
rlm@250 37 ([script]
rlm@250 38 (->> script
rlm@250 39 (advance [] [:a])
rlm@250 40 (advance [] [:start])
rlm@250 41 (advance [] [:a])
rlm@250 42 (advance [] [:start]))))
rlm@81 43
rlm@250 44 (defn-memo oak
rlm@250 45 ([] (oak (title)))
rlm@250 46 ([script]
rlm@250 47 (->> script
rlm@256 48 (scroll-text 13))))
rlm@81 49
rlm@250 50 (defn-memo name-entry-rlm
rlm@250 51 ([] (name-entry-rlm (oak)))
rlm@250 52 ([script]
rlm@250 53 (->> script
rlm@250 54 (advance [] [:a])
rlm@250 55 (advance [] [:r] DE)
rlm@250 56 (play-moves
rlm@250 57 [[]
rlm@250 58 [:r] [] [:r] [] [:r] [] [:r] []
rlm@250 59 [:r] [] [:r] [] [:r] [] [:d] [:a]
rlm@250 60 [:l] [] [:l] [] [:l] [] [:l] []
rlm@250 61 [:l] [] [:l] [:a] [] [:r] [:a]
rlm@250 62 [:r] [] [:r] [] [:r] [] [:r] []
rlm@250 63 [:r] [] [:d] [] [:d] [] [:d] [:a]]))))
rlm@91 64
rlm@250 65 (defn-memo name-entry-ash
rlm@250 66 ([] (name-entry-ash (oak)))
rlm@250 67 ([script]
rlm@250 68 (->> script
rlm@250 69 (advance [] [:d])
rlm@250 70 (advance [] [:d])
rlm@250 71 (advance [] [:a]))))
rlm@91 72
rlm@250 73 (defn-memo rival-name-entry-gary
rlm@250 74 ([] (rival-name-entry-gary (name-entry-ash)))
rlm@250 75 ([script]
rlm@250 76 (->> script
rlm@256 77 (scroll-text 5)
rlm@250 78 (advance [] [:d])
rlm@250 79 (advance [] [:d])
rlm@250 80 (advance [] [:a]))))
rlm@250 81
rlm@250 82 (defn-memo rival-name-entry-blue
rlm@250 83 ([] (rival-name-entry-blue (name-entry-ash)))
rlm@250 84 ([script]
rlm@250 85 (->> script
rlm@256 86 (scroll-text 5)
rlm@250 87 (advance [] [:d])
rlm@250 88 (advance [] [:a]))))
rlm@81 89
rlm@250 90 (defn-memo finish-title
rlm@250 91 ([] (finish-title (rival-name-entry-blue)))
rlm@250 92 ([script]
rlm@250 93 (->> script
rlm@256 94 (scroll-text 7))))
rlm@256 95
rlm@250 96 (def title-frames 2194)
rlm@89 97
rlm@89 98 (defn title-checkpoint! []
rlm@88 99 (let [[moves state] (finish-title)]
rlm@250 100 (assert (= title-frames (count moves)))
rlm@250 101 [(write-moves! moves "title-checkpoint")
rlm@250 102 (write-state! state "title-checkpoint")]))
rlm@88 103
rlm@88 104 (defn intro []
rlm@250 105 [(read-moves "title-checkpoint")
rlm@250 106 (read-state "title-checkpoint")])
rlm@88 107
rlm@88 108 (defn test-intro []
rlm@254 109 (play-vbm (moves-filename "title-checkpoint")))
rlm@88 110
rlm@87 111 ;; TODO might be able to glue these together more elegantly with monads
rlm@87 112