1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/clojure/com/aurellem/cruft/title.clj	Sat Mar 10 14:48:17 2012 -0600
     1.3 @@ -0,0 +1,141 @@
     1.4 +(ns com.aurellem.title
     1.5 +  (:use (com.aurellem gb-driver vbm)))
     1.6 +
     1.7 +(defn delayed-key
     1.8 +  ([key delay total]
     1.9 +     (concat (repeat delay []) [key] (repeat (- total delay 1) [])))
    1.10 +  ([key total]
    1.11 +     (delayed-key key (dec total) total)))
    1.12 +
    1.13 +(defn no-action [length]
    1.14 +  (repeat length []))
    1.15 +
    1.16 +(defn start-summary []
    1.17 +  (nth (registers) 2))
    1.18 +
    1.19 +(defn common-initial-elements [baseline moves]
    1.20 +  (loop [common 0 b baseline m moves]
    1.21 +    (if (empty? m) common
    1.22 +        (if (= (first b) (first m))
    1.23 +          (recur (inc common) (rest b) (rest m))
    1.24 +          common))))
    1.25 +    
    1.26 +(defn earliest-press
    1.27 +  [start-frame
    1.28 +   end-frame
    1.29 +   key
    1.30 +   summary-fn]
    1.31 +  (let [action-length (- end-frame start-frame)
    1.32 +        baseline (no-action action-length)]
    1.33 +    (print "establishing baseline...")
    1.34 +    (play-moves start-frame baseline)
    1.35 +    (let [bad-value (summary-fn)]
    1.36 +      (println bad-value)
    1.37 +      (loop [n 0]
    1.38 +        (let [moves (delayed-key key n action-length)
    1.39 +              header-length
    1.40 +              (common-initial-elements moves baseline)]
    1.41 +          (print "length" (inc n) "...")
    1.42 +          (without-saves
    1.43 +           (play-moves
    1.44 +            (+ start-frame header-length)
    1.45 +            (drop header-length moves)))
    1.46 +          (let [result (summary-fn)]
    1.47 +            (println result)
    1.48 +            (if (not= result bad-value)
    1.49 +              (let [keys (delayed-key key (inc n))]
    1.50 +                  (play-moves start-frame keys)
    1.51 +                  keys)
    1.52 +              (recur (inc n)))))))))
    1.53 +
    1.54 +
    1.55 +(defn search-first
    1.56 +  [start-frame
    1.57 +   baseline
    1.58 +   gen-move-fn
    1.59 +   summary-fn]
    1.60 +  (print "establishing baseline...")
    1.61 +  (play-moves start-frame baseline)
    1.62 +  (let [bad-value (summary-fn)]
    1.63 +    (println bad-value)
    1.64 +    (loop [n 0]
    1.65 +      (let [trial-moves (gen-move-fn n)
    1.66 +            header-length
    1.67 +            (common-initial-elements trial-moves baseline)]
    1.68 +        (print "length" (inc n) "...")
    1.69 +        (without-saves
    1.70 +         (play-moves
    1.71 +          (+ start-frame header-length)
    1.72 +          (drop header-length trial-moves)))
    1.73 +        (let [result (summary-fn)]
    1.74 +          (println result)
    1.75 +          (if (not= result bad-value)
    1.76 +            (let [keys (take (inc n) trial-moves)]
    1.77 +              (play-moves start-frame keys)
    1.78 +              keys)
    1.79 +            (recur (inc n))))))))
    1.80 +
    1.81 +(defn title-search
    1.82 +  [start-frame
    1.83 +   end-frame
    1.84 +   key
    1.85 +   summary-fn]
    1.86 +  (let [action-length (- end-frame start-frame)]
    1.87 +    (search-first
    1.88 +     start-frame
    1.89 +     (no-action action-length)
    1.90 +     (fn [n] (delayed-key key n action-length))
    1.91 +     summary-fn)))
    1.92 +
    1.93 +(defn gen-title []
    1.94 +  (let [start0 (no-action 300)]
    1.95 +    (play-moves 0 start0)
    1.96 +    (let [start->first-press
    1.97 +          (title-search (frame) (+ 50 (frame)) [:a] start-summary)
    1.98 +          first-press->second-press
    1.99 +          (title-search (frame) (+ 100 (frame)) [:start] start-summary)
   1.100 +          second-press->third-press
   1.101 +          (title-search (frame) (+ 151 (frame)) [:a] start-summary)
   1.102 +          new-game
   1.103 +          (title-search (frame) (+ 151 (frame)) [:a] start-summary)]
   1.104 +      (concat
   1.105 +       start0
   1.106 +       start->first-press
   1.107 +       first-press->second-press
   1.108 +       second-press->third-press
   1.109 +       new-game))))
   1.110 +  
   1.111 +(def title
   1.112 +  [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.113 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.114 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.115 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.116 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.117 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.118 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.119 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.120 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.121 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.122 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.123 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.124 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.125 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.126 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [ :a] [] [] [] [] [] [] []
   1.127 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.128 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.129 +   [] [] [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] []
   1.130 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.131 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.132 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.133 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.134 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.135 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.136 +   [] [] [] [] [ :a] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.137 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.138 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.139 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.140 +   [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
   1.141 +   [] [] [] [] [] [ :a]])
   1.142 +
   1.143 +
   1.144 +(require '(clojure [zip :as zip]))
   1.145 \ No newline at end of file