Mercurial > vba-clojure

annotate clojure/com/aurellem/cruft/title.clj @ 89:2f478abe57d0

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