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.title
2 (:use (com.aurellem.gb gb-driver vbm)))
4 (defn first-difference [base alt summary root]
5 (loop [branch-point root
6 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 advance
16 ([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 ([] (title (start)))
30 ([script]
31 (->> script
32 (advance [] [:a])
33 (advance [] [:start])
34 (advance [] [:a])
35 (advance [] [:start]))))
37 (defn-memo oak
38 ([] (oak (title)))
39 ([script]
40 (->> script
41 scroll-text
42 scroll-text
43 scroll-text
44 scroll-text
45 scroll-text
46 scroll-text
47 scroll-text
48 scroll-text
49 scroll-text
50 scroll-text
51 scroll-text
52 scroll-text
53 scroll-text)))
55 (defn-memo name-entry-rlm
56 ([] (name-entry-rlm (oak)))
57 ([script]
58 (->> script
59 (advance [] [:a])
60 (advance [] [:r] DE)
61 (play-moves
62 [[]
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-ash
71 ([] (name-entry-ash (oak)))
72 ([script]
73 (->> script
74 (advance [] [:d])
75 (advance [] [:d])
76 (advance [] [:a]))))
78 (defn-memo rival-name-entry-gary
79 ([] (rival-name-entry-gary (name-entry-ash)))
80 ([script]
81 (->> script
82 scroll-text
83 scroll-text
84 scroll-text
85 scroll-text
86 scroll-text
87 (advance [] [:d])
88 (advance [] [:d])
89 (advance [] [:a]))))
91 (defn-memo rival-name-entry-blue
92 ([] (rival-name-entry-blue (name-entry-ash)))
93 ([script]
94 (->> script
95 scroll-text
96 scroll-text
97 scroll-text
98 scroll-text
99 scroll-text
100 (advance [] [:d])
101 (advance [] [:a]))))
103 (defn-memo finish-title
104 ([] (finish-title (rival-name-entry-blue)))
105 ([script]
106 (->> script
107 scroll-text
108 scroll-text
109 scroll-text
110 scroll-text
111 scroll-text
112 scroll-text
113 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