|
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@87
|
24 (def scroll-text (partial advance [:b] [:a :b]))
|
|
rlm@81
|
25
|
|
rlm@87
|
26 (defn start [] [[] (root)])
|
|
rlm@81
|
27
|
|
rlm@250
|
28 (defn-memo title
|
|
rlm@250
|
29 ([] (title (start)))
|
|
rlm@250
|
30 ([script]
|
|
rlm@250
|
31 (->> script
|
|
rlm@250
|
32 (advance [] [:a])
|
|
rlm@250
|
33 (advance [] [:start])
|
|
rlm@250
|
34 (advance [] [:a])
|
|
rlm@250
|
35 (advance [] [:start]))))
|
|
rlm@81
|
36
|
|
rlm@250
|
37 (defn-memo oak
|
|
rlm@250
|
38 ([] (oak (title)))
|
|
rlm@250
|
39 ([script]
|
|
rlm@250
|
40 (->> script
|
|
rlm@250
|
41 scroll-text
|
|
rlm@250
|
42 scroll-text
|
|
rlm@250
|
43 scroll-text
|
|
rlm@250
|
44 scroll-text
|
|
rlm@250
|
45 scroll-text
|
|
rlm@250
|
46 scroll-text
|
|
rlm@250
|
47 scroll-text
|
|
rlm@250
|
48 scroll-text
|
|
rlm@250
|
49 scroll-text
|
|
rlm@250
|
50 scroll-text
|
|
rlm@250
|
51 scroll-text
|
|
rlm@250
|
52 scroll-text
|
|
rlm@250
|
53 scroll-text)))
|
|
rlm@81
|
54
|
|
rlm@250
|
55 (defn-memo name-entry-rlm
|
|
rlm@250
|
56 ([] (name-entry-rlm (oak)))
|
|
rlm@250
|
57 ([script]
|
|
rlm@250
|
58 (->> script
|
|
rlm@250
|
59 (advance [] [:a])
|
|
rlm@250
|
60 (advance [] [:r] DE)
|
|
rlm@250
|
61 (play-moves
|
|
rlm@250
|
62 [[]
|
|
rlm@250
|
63 [:r] [] [:r] [] [:r] [] [:r] []
|
|
rlm@250
|
64 [:r] [] [:r] [] [:r] [] [:d] [:a]
|
|
rlm@250
|
65 [:l] [] [:l] [] [:l] [] [:l] []
|
|
rlm@250
|
66 [:l] [] [:l] [:a] [] [:r] [:a]
|
|
rlm@250
|
67 [:r] [] [:r] [] [:r] [] [:r] []
|
|
rlm@250
|
68 [:r] [] [:d] [] [:d] [] [:d] [:a]]))))
|
|
rlm@91
|
69
|
|
rlm@250
|
70 (defn-memo name-entry-ash
|
|
rlm@250
|
71 ([] (name-entry-ash (oak)))
|
|
rlm@250
|
72 ([script]
|
|
rlm@250
|
73 (->> script
|
|
rlm@250
|
74 (advance [] [:d])
|
|
rlm@250
|
75 (advance [] [:d])
|
|
rlm@250
|
76 (advance [] [:a]))))
|
|
rlm@91
|
77
|
|
rlm@250
|
78 (defn-memo rival-name-entry-gary
|
|
rlm@250
|
79 ([] (rival-name-entry-gary (name-entry-ash)))
|
|
rlm@250
|
80 ([script]
|
|
rlm@250
|
81 (->> script
|
|
rlm@250
|
82 scroll-text
|
|
rlm@250
|
83 scroll-text
|
|
rlm@250
|
84 scroll-text
|
|
rlm@250
|
85 scroll-text
|
|
rlm@250
|
86 scroll-text
|
|
rlm@250
|
87 (advance [] [:d])
|
|
rlm@250
|
88 (advance [] [:d])
|
|
rlm@250
|
89 (advance [] [:a]))))
|
|
rlm@250
|
90
|
|
rlm@250
|
91 (defn-memo rival-name-entry-blue
|
|
rlm@250
|
92 ([] (rival-name-entry-blue (name-entry-ash)))
|
|
rlm@250
|
93 ([script]
|
|
rlm@250
|
94 (->> script
|
|
rlm@250
|
95 scroll-text
|
|
rlm@250
|
96 scroll-text
|
|
rlm@250
|
97 scroll-text
|
|
rlm@250
|
98 scroll-text
|
|
rlm@250
|
99 scroll-text
|
|
rlm@250
|
100 (advance [] [:d])
|
|
rlm@250
|
101 (advance [] [:a]))))
|
|
rlm@81
|
102
|
|
rlm@250
|
103 (defn-memo finish-title
|
|
rlm@250
|
104 ([] (finish-title (rival-name-entry-blue)))
|
|
rlm@250
|
105 ([script]
|
|
rlm@250
|
106 (->> script
|
|
rlm@250
|
107 scroll-text
|
|
rlm@250
|
108 scroll-text
|
|
rlm@250
|
109 scroll-text
|
|
rlm@250
|
110 scroll-text
|
|
rlm@250
|
111 scroll-text
|
|
rlm@250
|
112 scroll-text
|
|
rlm@250
|
113 scroll-text)))
|
|
rlm@91
|
114
|
|
rlm@250
|
115 (def title-frames 2194)
|
|
rlm@89
|
116
|
|
rlm@89
|
117 (defn title-checkpoint! []
|
|
rlm@88
|
118 (let [[moves state] (finish-title)]
|
|
rlm@250
|
119 (assert (= title-frames (count moves)))
|
|
rlm@250
|
120 [(write-moves! moves "title-checkpoint")
|
|
rlm@250
|
121 (write-state! state "title-checkpoint")]))
|
|
rlm@88
|
122
|
|
rlm@88
|
123 (defn intro []
|
|
rlm@250
|
124 [(read-moves "title-checkpoint")
|
|
rlm@250
|
125 (read-state "title-checkpoint")])
|
|
rlm@88
|
126
|
|
rlm@88
|
127 (defn test-intro []
|
|
rlm@88
|
128 (play-vbm (moves->filename title-frames)))
|
|
rlm@88
|
129
|
|
rlm@87
|
130 ;; TODO might be able to glue these together more elegantly with monads
|
|
rlm@87
|
131
|
