Mercurial > vba-clojure

     1 (ns com.aurellem.title

     2   (:use (com.aurellem gb-driver vbm)))

     3 

     4 (defn delayed-key

     5   ([key delay total]

     6      (concat (repeat delay []) [key] (repeat (- total delay 1) [])))

     7   ([key total]

     8      (delayed-key key (dec total) total)))

     9 

    10 (defn no-action [length]

    11   (repeat length []))

    12 

    13 (defn start-summary []

    14   (nth (registers) 2))

    15 

    16 (defn common-initial-elements [baseline moves]

    17   (loop [common 0 b baseline m moves]

    18     (if (empty? m) common

    19         (if (= (first b) (first m))

    20           (recur (inc common) (rest b) (rest m))

    21           common))))

    22     

    23 (defn earliest-press

    24   [start-frame

    25    end-frame

    26    key

    27    summary-fn]

    28   (let [action-length (- end-frame start-frame)

    29         baseline (no-action action-length)]

    30     (print "establishing baseline...")

    31     (play-moves start-frame baseline)

    32     (let [bad-value (summary-fn)]

    33       (println bad-value)

    34       (loop [n 0]

    35         (let [moves (delayed-key key n action-length)

    36               header-length

    37               (common-initial-elements moves baseline)]

    38           (print "length" (inc n) "...")

    39           (without-saves

    40            (play-moves

    41             (+ start-frame header-length)

    42             (drop header-length moves)))

    43           (let [result (summary-fn)]

    44             (println result)

    45             (if (not= result bad-value)

    46               (let [keys (delayed-key key (inc n))]

    47                   (play-moves start-frame keys)

    48                   keys)

    49               (recur (inc n)))))))))

    50 

    51 

    52 (defn search-first

    53   [start-frame

    54    baseline

    55    gen-move-fn

    56    summary-fn]

    57   (print "establishing baseline...")

    58   (play-moves start-frame baseline)

    59   (let [bad-value (summary-fn)]

    60     (println bad-value)

    61     (loop [n 0]

    62       (let [trial-moves (gen-move-fn n)

    63             header-length

    64             (common-initial-elements trial-moves baseline)]

    65         (print "length" (inc n) "...")

    66         (without-saves

    67          (play-moves

    68           (+ start-frame header-length)

    69           (drop header-length trial-moves)))

    70         (let [result (summary-fn)]

    71           (println result)

    72           (if (not= result bad-value)

    73             (let [keys (take (inc n) trial-moves)]

    74               (play-moves start-frame keys)

    75               keys)

    76             (recur (inc n))))))))

    77 

    78 (defn title-search

    79   [start-frame

    80    end-frame

    81    key

    82    summary-fn]

    83   (let [action-length (- end-frame start-frame)]

    84     (search-first

    85      start-frame

    86      (no-action action-length)

    87      (fn [n] (delayed-key key n action-length))

    88      summary-fn)))

    89 

    90 (defn gen-title []

    91   (let [start0 (no-action 300)]

    92     (play-moves 0 start0)

    93     (let [start->first-press

    94           (title-search (frame) (+ 50 (frame)) [:a] start-summary)

    95           first-press->second-press

    96           (title-search (frame) (+ 100 (frame)) [:start] start-summary)

    97           second-press->third-press

    98           (title-search (frame) (+ 151 (frame)) [:a] start-summary)

    99           new-game

   100           (title-search (frame) (+ 151 (frame)) [:a] start-summary)]

   101       (concat

   102        start0

   103        start->first-press

   104        first-press->second-press

   105        second-press->third-press

   106        new-game))))

   107   

   108 (def title

   109   [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   110    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   111    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   112    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   113    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   114    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   115    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   116    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   117    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   118    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   119    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   120    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   121    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   122    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   123    [] [] [] [] [] [] [] [] [] [] [] [] [] [ :a] [] [] [] [] [] [] []

   124    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   125    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   126    [] [] [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] []

   127    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   128    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   129    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   130    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   131    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   132    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   133    [] [] [] [] [ :a] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   134    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   135    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   136    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   137    [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

   138    [] [] [] [] [] [ :a]])

   139 

   140 

   141 (require '(clojure [zip :as zip]))
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 17 Mar 2012 01:23:47 -0500
parents	e8855121f413
children