Mercurial > vba-clojure

comparison clojure/com/aurellem/cruft/title.clj @ 87:e8855121f413

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
collect cruft, rename other files
author Robert McIntyre <rlm@mit.edu>
date Sat, 10 Mar 2012 14:48:17 -0600
parents
children
comparison
equal deleted inserted replaced
86:9864032ef3c8 87:e8855121f413
1 (ns com.aurellem.title
2 (:use (com.aurellem gb-driver vbm)))
3
4 (defn delayed-key
5 ([key delay total]
6 (concat (repeat delay []) [key] (repeat (- total delay 1) [])))
7 ([key total]
8 (delayed-key key (dec total) total)))
9
10 (defn no-action [length]
11 (repeat length []))
12
13 (defn start-summary []
14 (nth (registers) 2))
15
16 (defn common-initial-elements [baseline moves]
17 (loop [common 0 b baseline m moves]
18 (if (empty? m) common
19 (if (= (first b) (first m))
20 (recur (inc common) (rest b) (rest m))
21 common))))
22
23 (defn earliest-press
24 [start-frame
25 end-frame
26 key
27 summary-fn]
28 (let [action-length (- end-frame start-frame)
29 baseline (no-action action-length)]
30 (print "establishing baseline...")
31 (play-moves start-frame baseline)
32 (let [bad-value (summary-fn)]
33 (println bad-value)
34 (loop [n 0]
35 (let [moves (delayed-key key n action-length)
36 header-length
37 (common-initial-elements moves baseline)]
38 (print "length" (inc n) "...")
39 (without-saves
40 (play-moves
41 (+ start-frame header-length)
42 (drop header-length moves)))
43 (let [result (summary-fn)]
44 (println result)
45 (if (not= result bad-value)
46 (let [keys (delayed-key key (inc n))]
47 (play-moves start-frame keys)
48 keys)
49 (recur (inc n)))))))))
50
51
52 (defn search-first
53 [start-frame
54 baseline
55 gen-move-fn
56 summary-fn]
57 (print "establishing baseline...")
58 (play-moves start-frame baseline)
59 (let [bad-value (summary-fn)]
60 (println bad-value)
61 (loop [n 0]
62 (let [trial-moves (gen-move-fn n)
63 header-length
64 (common-initial-elements trial-moves baseline)]
65 (print "length" (inc n) "...")
66 (without-saves
67 (play-moves
68 (+ start-frame header-length)
69 (drop header-length trial-moves)))
70 (let [result (summary-fn)]
71 (println result)
72 (if (not= result bad-value)
73 (let [keys (take (inc n) trial-moves)]
74 (play-moves start-frame keys)
75 keys)
76 (recur (inc n))))))))
77
78 (defn title-search
79 [start-frame
80 end-frame
81 key
82 summary-fn]
83 (let [action-length (- end-frame start-frame)]
84 (search-first
85 start-frame
86 (no-action action-length)
87 (fn [n] (delayed-key key n action-length))
88 summary-fn)))
89
90 (defn gen-title []
91 (let [start0 (no-action 300)]
92 (play-moves 0 start0)
93 (let [start->first-press
94 (title-search (frame) (+ 50 (frame)) [:a] start-summary)
95 first-press->second-press
96 (title-search (frame) (+ 100 (frame)) [:start] start-summary)
97 second-press->third-press
98 (title-search (frame) (+ 151 (frame)) [:a] start-summary)
99 new-game
100 (title-search (frame) (+ 151 (frame)) [:a] start-summary)]
101 (concat
102 start0
103 start->first-press
104 first-press->second-press
105 second-press->third-press
106 new-game))))
107
108 (def title
109 [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
110 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
111 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
112 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
113 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
114 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
115 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
116 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
117 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
118 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
119 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
120 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
121 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
122 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
123 [] [] [] [] [] [] [] [] [] [] [] [] [] [ :a] [] [] [] [] [] [] []
124 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
125 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
126 [] [] [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] []
127 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
128 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
129 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
130 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
131 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
132 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
133 [] [] [] [] [ :a] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
134 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
135 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
136 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
137 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
138 [] [] [] [] [] [ :a]])
139
140
141 (require '(clojure [zip :as zip]))