|
rlm@81
|
1 (ns com.aurellem.title
|
|
rlm@81
|
2 (:use (com.aurellem 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@87
|
28 (defn-memo title [start]
|
|
rlm@87
|
29 (->> start
|
|
rlm@87
|
30 (advance [] [:a])
|
|
rlm@87
|
31 (advance [] [:start])
|
|
rlm@87
|
32 (advance [] [:a])
|
|
rlm@87
|
33 (advance [] [:start])))
|
|
rlm@81
|
34
|
|
rlm@87
|
35 (defn-memo oak [start]
|
|
rlm@87
|
36 (->> (title)
|
|
rlm@87
|
37 scroll-text
|
|
rlm@87
|
38 scroll-text
|
|
rlm@87
|
39 scroll-text
|
|
rlm@87
|
40 scroll-text
|
|
rlm@87
|
41 scroll-text
|
|
rlm@87
|
42 scroll-text
|
|
rlm@87
|
43 scroll-text
|
|
rlm@87
|
44 scroll-text
|
|
rlm@87
|
45 scroll-text
|
|
rlm@87
|
46 scroll-text
|
|
rlm@87
|
47 scroll-text
|
|
rlm@87
|
48 scroll-text
|
|
rlm@87
|
49 scroll-text
|
|
rlm@87
|
50 (advance [] [:a])))
|
|
rlm@81
|
51
|
|
rlm@87
|
52 (defn-memo name-entry []
|
|
rlm@87
|
53 (->> (oak)
|
|
rlm@87
|
54 (advance [] [:r] DE)
|
|
rlm@87
|
55 (play-moves
|
|
rlm@87
|
56 [[]
|
|
rlm@87
|
57 [:r] [] [:r] [] [:r] [] [:r] []
|
|
rlm@87
|
58 [:r] [] [:r] [] [:r] [] [:d] [:a]
|
|
rlm@87
|
59 [:l] [] [:l] [] [:l] [] [:l] []
|
|
rlm@87
|
60 [:l] [] [:l] [:a] [] [:r] [:a]
|
|
rlm@87
|
61 [:r] [] [:r] [] [:r] [] [:r] []
|
|
rlm@87
|
62 [:r] [] [:d] [] [:d] [] [:d] [:a]
|
|
rlm@87
|
63 ])))
|
|
rlm@87
|
64
|
|
rlm@87
|
65 (defn-memo rival-name-entry []
|
|
rlm@87
|
66 (->> (name-entry)
|
|
rlm@87
|
67 scroll-text
|
|
rlm@87
|
68 scroll-text
|
|
rlm@87
|
69 scroll-text
|
|
rlm@87
|
70 scroll-text
|
|
rlm@87
|
71 scroll-text
|
|
rlm@87
|
72 (advance [] [:d])
|
|
rlm@87
|
73 (advance [] [:d])
|
|
rlm@87
|
74 (advance [] [:a])))
|
|
rlm@81
|
75
|
|
rlm@87
|
76 (defn-memo finish-title []
|
|
rlm@87
|
77 (->> (rival-name-entry)
|
|
rlm@87
|
78 scroll-text
|
|
rlm@87
|
79 scroll-text
|
|
rlm@87
|
80 scroll-text
|
|
rlm@87
|
81 scroll-text
|
|
rlm@87
|
82 scroll-text
|
|
rlm@87
|
83 scroll-text
|
|
rlm@87
|
84 scroll-text))
|
|
rlm@81
|
85
|
|
rlm@87
|
86 (defn-memo intro []
|
|
rlm@87
|
87 (-> (start) title oak name-entry rival-name-entry finish-title))
|
|
rlm@81
|
88
|
|
rlm@87
|
89
|
|
rlm@87
|
90 ;; TODO might be able to glue these together more elegantly with monads
|
|
rlm@87
|
91
|
