Mercurial > vba-clojure
comparison clojure/com/aurellem/title2.clj @ 85:3f4fdd270059
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 |