|
rlm@84
|
1 (ns com.aurellem.title2
|
|
rlm@84
|
2 (:use (com.aurellem gb-funs vbm)))
|
|
rlm@84
|
3
|
|
rlm@84
|
4 (defn first-difference [base alt summary root]
|
|
rlm@84
|
5 (loop [branch-point root
|
|
rlm@84
|
6 actions []]
|
|
rlm@84
|
7 (let [base-branch (step branch-point base)
|
|
rlm@84
|
8 base-val (summary base-branch)
|
|
rlm@84
|
9 alt-branch (step branch-point alt)
|
|
rlm@84
|
10 alt-val (summary alt-branch)]
|
|
rlm@84
|
11 (if (not= base-val alt-val)
|
|
rlm@84
|
12 [(conj actions alt) alt-branch]
|
|
rlm@84
|
13 (recur base-branch (conj actions base))))))
|
|
rlm@84
|
14
|
|
rlm@85
|
15 (defn advance
|
|
rlm@85
|
16 ([base alt summary [commands state]]
|
|
rlm@85
|
17 (let [[c s] (first-difference base alt summary state)]
|
|
rlm@85
|
18 [(concat commands c) s]))
|
|
rlm@85
|
19 ([base alt [commands state]]
|
|
rlm@85
|
20 (advance base alt AF [commands state]))
|
|
rlm@85
|
21 ([alt [commands state]]
|
|
rlm@85
|
22 (advance [] alt [commands state])))
|
|
rlm@85
|
23
|
|
rlm@85
|
24 (def scroll-text (partial advance [:b] [:a :b]))
|
|
rlm@85
|
25
|
|
rlm@84
|
26 (defn title []
|
|
rlm@85
|
27 (->> [[] (root)]
|
|
rlm@85
|
28 (advance [] [:a])
|
|
rlm@85
|
29 (advance [] [:start])
|
|
rlm@85
|
30 (advance [] [:a])
|
|
rlm@85
|
31 (advance [] [:start])))
|
|
rlm@84
|
32
|
|
rlm@85
|
33 (def title-end (second (title)))
|
|
rlm@84
|
34
|
|
rlm@84
|
35 (defn oak []
|
|
rlm@85
|
36 (->> [[] title-end]
|
|
rlm@85
|
37 scroll-text
|
|
rlm@85
|
38 scroll-text
|
|
rlm@85
|
39 scroll-text
|
|
rlm@85
|
40 scroll-text
|
|
rlm@85
|
41 scroll-text
|
|
rlm@85
|
42 scroll-text
|
|
rlm@85
|
43 scroll-text
|
|
rlm@85
|
44 scroll-text
|
|
rlm@85
|
45 scroll-text
|
|
rlm@85
|
46 scroll-text
|
|
rlm@85
|
47 scroll-text
|
|
rlm@85
|
48 scroll-text
|
|
rlm@85
|
49 scroll-text
|
|
rlm@85
|
50 (advance [] [:a])))
|
|
rlm@85
|
51
|
|
rlm@85
|
52 ;; looks like it might need a monad here if this pattern continues
|
|
rlm@84
|
53
|
|
rlm@84
|
54 (def oak-end (second (oak)))
|
|
rlm@85
|
55
|
|
rlm@85
|
56 (defn name-entry []
|
|
rlm@85
|
57 (->> [[] oak-end]
|
|
rlm@85
|
58 (advance [] [:r] DE)
|
|
rlm@85
|
59 ((fn [[moves state]]
|
|
rlm@85
|
60 (play-moves
|
|
rlm@85
|
61 state
|
|
rlm@85
|
62 [[]
|
|
rlm@85
|
63 [:r] [] [:r] [] [:r] [] [:r] []
|
|
rlm@85
|
64 [:r] [] [:r] [] [:r] [] [:d] [:a]
|
|
rlm@85
|
65 [:l] [] [:l] [] [:l] [] [:l] []
|
|
rlm@85
|
66 [:l] [] [:l] [:a] [] [:r] [:a]
|
|
rlm@85
|
67 [:r] [] [:r] [] [:r] [] [:r] []
|
|
rlm@85
|
68 [:r] [] [:d] [] [:d] [] [:d] [:a]
|
|
rlm@85
|
69 ])))))
|
|
rlm@85
|
70
|
|
rlm@84
|
71
|
