rlm@81: (ns com.aurellem.title
rlm@81:   (:use (com.aurellem gb-driver vbm)))
rlm@81: 
rlm@81: (defn delayed-key
rlm@81:   ([key delay total]
rlm@81:      (concat (repeat delay []) [key] (repeat (- total delay 1) [])))
rlm@81:   ([key total]
rlm@81:      (delayed-key key (dec total) total)))
rlm@81: 
rlm@81: (defn no-action [length]
rlm@81:   (repeat length []))
rlm@81: 
rlm@81: (defn start-summary []
rlm@81:   (nth (registers) 2))
rlm@81: 
rlm@81: (defn common-initial-elements [baseline moves]
rlm@81:   (loop [common 0 b baseline m moves]
rlm@81:     (if (empty? m) common
rlm@81:         (if (= (first b) (first m))
rlm@81:           (recur (inc common) (rest b) (rest m))
rlm@81:           common))))
rlm@81:     
rlm@81: (defn earliest-press
rlm@81:   [start-frame
rlm@81:    end-frame
rlm@81:    key
rlm@81:    summary-fn]
rlm@81:   (let [action-length (- end-frame start-frame)
rlm@81:         baseline (no-action action-length)]
rlm@81:     (print "establishing baseline...")
rlm@81:     (play-moves start-frame baseline)
rlm@81:     (let [bad-value (summary-fn)]
rlm@81:       (println bad-value)
rlm@81:       (loop [n 0]
rlm@81:         (let [moves (delayed-key key n action-length)
rlm@81:               header-length
rlm@81:               (common-initial-elements moves baseline)]
rlm@81:           (print "length" (inc n) "...")
rlm@81:           (without-saves
rlm@81:            (play-moves
rlm@81:             (+ start-frame header-length)
rlm@81:             (drop header-length moves)))
rlm@81:           (let [result (summary-fn)]
rlm@81:             (println result)
rlm@81:             (if (not= result bad-value)
rlm@81:               (let [keys (delayed-key key (inc n))]
rlm@81:                   (play-moves start-frame keys)
rlm@81:                   keys)
rlm@81:               (recur (inc n)))))))))
rlm@81: 
rlm@81: 
rlm@81: (defn search-first
rlm@81:   [start-frame
rlm@81:    baseline
rlm@81:    gen-move-fn
rlm@81:    summary-fn]
rlm@81:   (print "establishing baseline...")
rlm@81:   (play-moves start-frame baseline)
rlm@81:   (let [bad-value (summary-fn)]
rlm@81:     (println bad-value)
rlm@81:     (loop [n 0]
rlm@81:       (let [trial-moves (gen-move-fn n)
rlm@81:             header-length
rlm@81:             (common-initial-elements trial-moves baseline)]
rlm@81:         (print "length" (inc n) "...")
rlm@81:         (without-saves
rlm@81:          (play-moves
rlm@81:           (+ start-frame header-length)
rlm@81:           (drop header-length trial-moves)))
rlm@81:         (let [result (summary-fn)]
rlm@81:           (println result)
rlm@81:           (if (not= result bad-value)
rlm@81:             (let [keys (take (inc n) trial-moves)]
rlm@81:               (play-moves start-frame keys)
rlm@81:               keys)
rlm@81:             (recur (inc n))))))))
rlm@81: 
rlm@81: (defn title-search
rlm@81:   [start-frame
rlm@81:    end-frame
rlm@81:    key
rlm@81:    summary-fn]
rlm@81:   (let [action-length (- end-frame start-frame)]
rlm@81:     (search-first
rlm@81:      start-frame
rlm@81:      (no-action action-length)
rlm@81:      (fn [n] (delayed-key key n action-length))
rlm@81:      summary-fn)))
rlm@81: 
rlm@81: (defn gen-title []
rlm@81:   (let [start0 (no-action 300)]
rlm@81:     (play-moves 0 start0)
rlm@81:     (let [start->first-press
rlm@81:           (title-search (frame) (+ 50 (frame)) [:a] start-summary)
rlm@81:           first-press->second-press
rlm@81:           (title-search (frame) (+ 100 (frame)) [:start] start-summary)
rlm@81:           second-press->third-press
rlm@81:           (title-search (frame) (+ 151 (frame)) [:a] start-summary)
rlm@81:           new-game
rlm@81:           (title-search (frame) (+ 151 (frame)) [:a] start-summary)]
rlm@81:       (concat
rlm@81:        start0
rlm@81:        start->first-press
rlm@81:        first-press->second-press
rlm@81:        second-press->third-press
rlm@81:        new-game))))
rlm@81:   
rlm@81: (def title
rlm@81:   [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [ :a] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [ :a] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@81:    [] [] [] [] [] [ :a]])
rlm@81: 
rlm@81: 
rlm@82: (require '(clojure [zip :as zip]))