Mercurial > vba-clojure

annotate clojure/com/aurellem/title.clj @ 83:95cb2152d7cd

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