Mercurial > vba-clojure

comparison clojure/com/aurellem/run/title.clj @ 250:b7f682bb3090

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
updated title and save_corruption to work with all the recent updates
author Robert McIntyre <rlm@mit.edu>
date Mon, 26 Mar 2012 03:49:33 -0500
parents 09caf6a5bbf4
children 5dafe6188ca5
comparison
equal deleted inserted replaced
248:e94d20ad853e 250:b7f682bb3090
23 23
24 (def scroll-text (partial advance [:b] [:a :b])) 24 (def scroll-text (partial advance [:b] [:a :b]))
25 25
26 (defn start [] [[] (root)]) 26 (defn start [] [[] (root)])
27 27
28 (defn-memo title [] 28 (defn-memo title
29 (->> (start) 29 ([] (title (start)))
30 (advance [] [:a]) 30 ([script]
31 (advance [] [:start]) 31 (->> script
32 (advance [] [:a]) 32 (advance [] [:a])
33 (advance [] [:start]))) 33 (advance [] [:start])
34 (advance [] [:a])
35 (advance [] [:start]))))
34 36
35 (defn-memo oak [] 37 (defn-memo oak
36 (->> (title) 38 ([] (oak (title)))
37 scroll-text 39 ([script]
38 scroll-text 40 (->> script
39 scroll-text 41 scroll-text
40 scroll-text 42 scroll-text
41 scroll-text 43 scroll-text
42 scroll-text 44 scroll-text
43 scroll-text 45 scroll-text
44 scroll-text 46 scroll-text
45 scroll-text 47 scroll-text
46 scroll-text 48 scroll-text
47 scroll-text 49 scroll-text
48 scroll-text 50 scroll-text
49 scroll-text 51 scroll-text
50 )) 52 scroll-text
53 scroll-text)))
51 54
52 (defn-memo name-entry-rlm [] 55 (defn-memo name-entry-rlm
53 (->> (oak) 56 ([] (name-entry-rlm (oak)))
54 (advance [] [:a]) 57 ([script]
55 (advance [] [:r] DE) 58 (->> script
56 (play-moves 59 (advance [] [:a])
57 [[] 60 (advance [] [:r] DE)
58 [:r] [] [:r] [] [:r] [] [:r] [] 61 (play-moves
59 [:r] [] [:r] [] [:r] [] [:d] [:a] 62 [[]
60 [:l] [] [:l] [] [:l] [] [:l] [] 63 [:r] [] [:r] [] [:r] [] [:r] []
61 [:l] [] [:l] [:a] [] [:r] [:a] 64 [:r] [] [:r] [] [:r] [] [:d] [:a]
62 [:r] [] [:r] [] [:r] [] [:r] [] 65 [:l] [] [:l] [] [:l] [] [:l] []
63 [:r] [] [:d] [] [:d] [] [:d] [:a] 66 [:l] [] [:l] [:a] [] [:r] [:a]
64 ]))) 67 [:r] [] [:r] [] [:r] [] [:r] []
68 [:r] [] [:d] [] [:d] [] [:d] [:a]]))))
65 69
66 (defn-memo name-entry-ash [] 70 (defn-memo name-entry-ash
67 (->> (oak) 71 ([] (name-entry-ash (oak)))
68 (advance [] [:d]) 72 ([script]
69 (advance [] [:d]) 73 (->> script
70 (advance [] [:a]))) 74 (advance [] [:d])
75 (advance [] [:d])
76 (advance [] [:a]))))
71 77
72 (defn-memo rival-name-entry-gary [] 78 (defn-memo rival-name-entry-gary
73 (->> (name-entry-ash) 79 ([] (rival-name-entry-gary (name-entry-ash)))
74 scroll-text 80 ([script]
75 scroll-text 81 (->> script
76 scroll-text 82 scroll-text
77 scroll-text 83 scroll-text
78 scroll-text 84 scroll-text
79 (advance [] [:d]) 85 scroll-text
80 (advance [] [:d]) 86 scroll-text
81 (advance [] [:a]))) 87 (advance [] [:d])
88 (advance [] [:d])
89 (advance [] [:a]))))
90
91 (defn-memo rival-name-entry-blue
92 ([] (rival-name-entry-blue (name-entry-ash)))
93 ([script]
94 (->> script
95 scroll-text
96 scroll-text
97 scroll-text
98 scroll-text
99 scroll-text
100 (advance [] [:d])
101 (advance [] [:a]))))
82 102
83 (defn-memo rival-name-entry-blue [] 103 (defn-memo finish-title
84 (->> (name-entry-ash) 104 ([] (finish-title (rival-name-entry-blue)))
85 scroll-text 105 ([script]
86 scroll-text 106 (->> script
87 scroll-text 107 scroll-text
88 scroll-text 108 scroll-text
89 scroll-text 109 scroll-text
90 (advance [] [:d]) 110 scroll-text
91 (advance [] [:a]))) 111 scroll-text
112 scroll-text
113 scroll-text)))
92 114
93 (defn-memo finish-title [] 115 (def title-frames 2194)
94 (->> (rival-name-entry-blue)
95 scroll-text
96 scroll-text
97 scroll-text
98 scroll-text
99 scroll-text
100 scroll-text
101 scroll-text))
102
103 (def title-frames 2323)
104 116
105 (defn title-checkpoint! [] 117 (defn title-checkpoint! []
106 (let [[moves state] (finish-title)] 118 (let [[moves state] (finish-title)]
107 (assert (= title-frames (:frame state))) 119 (assert (= title-frames (count moves)))
108 [(write-moves! moves) (write-state! state)])) 120 [(write-moves! moves "title-checkpoint")
121 (write-state! state "title-checkpoint")]))
109 122
110 (defn intro [] 123 (defn intro []
111 [(read-moves title-frames) 124 [(read-moves "title-checkpoint")
112 (read-state title-frames)]) 125 (read-state "title-checkpoint")])
113 126
114 (defn test-intro [] 127 (defn test-intro []
115 (play-vbm (moves->filename title-frames))) 128 (play-vbm (moves->filename title-frames)))
116 129
117 ;; TODO might be able to glue these together more elegantly with monads 130 ;; TODO might be able to glue these together more elegantly with monads