Mercurial > vba-clojure

comparison clojure/com/aurellem/title2.clj @ 85:3f4fdd270059

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
more progress with the title
author Robert McIntyre <rlm@mit.edu>
date Sat, 10 Mar 2012 00:32:11 -0600
parents 26f002f2868c
children 9864032ef3c8
comparison
equal deleted inserted replaced
84:26f002f2868c 85:3f4fdd270059
10 alt-val (summary alt-branch)] 10 alt-val (summary alt-branch)]
11 (if (not= base-val alt-val) 11 (if (not= base-val alt-val)
12 [(conj actions alt) alt-branch] 12 [(conj actions alt) alt-branch]
13 (recur base-branch (conj actions base)))))) 13 (recur base-branch (conj actions base))))))
14 14
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])))
23
24 (def scroll-text (partial advance [:b] [:a :b]))
25
15 (defn title [] 26 (defn title []
16 (let [[c-1 s-1] (first-difference [] [:a] AF (root)) 27 (->> [[] (root)]
17 [c-2 s-2] (first-difference [] [:start] AF s-1) 28 (advance [] [:a])
18 [c-3 s-3] (first-difference [] [:a] AF s-2) 29 (advance [] [:start])
19 [c-4 s-4] (first-difference [] [:start] AF s-3)] 30 (advance [] [:a])
20 [(concat c-1 c-2 c-3 c-3 c-4) s-4])) 31 (advance [] [:start])))
21 32
22 (def menu-end (second (title))) 33 (def title-end (second (title)))
23
24 (defn scroll-text [[commands state]]
25 (let [[c s] (first-difference [:b] [:a :b] AF state)]
26 [(concat commands c) s]))
27 34
28 (defn oak [] 35 (defn oak []
29 (-> [[] menu-end] 36 (->> [[] title-end]
30 scroll-text 37 scroll-text
31 scroll-text 38 scroll-text
32 scroll-text 39 scroll-text
33 scroll-text 40 scroll-text
34 scroll-text 41 scroll-text
35 scroll-text 42 scroll-text
36 scroll-text 43 scroll-text
37 scroll-text 44 scroll-text
38 scroll-text 45 scroll-text
39 scroll-text 46 scroll-text
40 scroll-text 47 scroll-text
41 scroll-text 48 scroll-text
42 scroll-text)) 49 scroll-text
50 (advance [] [:a])))
51
52 ;; looks like it might need a monad here if this pattern continues
43 53
44 (def oak-end (second (oak))) 54 (def oak-end (second (oak)))
45 55
56 (defn name-entry []
57 (->> [[] oak-end]
58 (advance [] [:r] DE)
59 ((fn [[moves state]]
60 (play-moves
61 state
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]
69 ])))))
70
46 71
47 ;; looks like it might need a monad here if this pattern continues