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