1.1 --- a/clojure/com/aurellem/run/util.clj	Mon Apr 02 10:58:16 2012 -0500
     1.2 +++ b/clojure/com/aurellem/run/util.clj	Mon Apr 02 20:30:02 2012 -0500
     1.3 @@ -1,5 +1,5 @@
     1.4  (ns com.aurellem.run.util
     1.5 -  (:use (com.aurellem.gb util gb-driver vbm characters))
     1.6 +  (:use (com.aurellem.gb util gb-driver vbm characters saves))
     1.7    (:import [com.aurellem.gb.gb_driver SaveState]))
     1.8  
     1.9  (def ↑ [:u])
    1.10 @@ -19,9 +19,8 @@
    1.11          [(conj actions alt) alt-branch]
    1.12          (recur base-branch (conj actions base))))))
    1.13  
    1.14 -
    1.15  (defn repeat-until-different
    1.16 -  [buttons metric [moves root]]
    1.17 +  [buttons metric [moves root :as script]]
    1.18    (let [baseline (metric root)]
    1.19      (loop [actions (vec moves)
    1.20             state root]
    1.21 @@ -31,8 +30,26 @@
    1.22            [new-actions new-state]
    1.23            (recur new-actions new-state))))))
    1.24  
    1.25 +(defn delayed-difference
    1.26 +  [base alt delay difference-metric [moves root :as script]]
    1.27 +  (loop [branch-point root
    1.28 +         actions moves]
    1.29 +    (let [base-branch (step branch-point base)
    1.30 +          base-val
    1.31 +          (difference-metric
    1.32 +           (run-moves base-branch
    1.33 +                      (repeat delay base)))
    1.34 +          alt-branch (step branch-point alt)
    1.35 +          alt-val
    1.36 +          (difference-metric
    1.37 +           (run-moves alt-branch
    1.38 +                      (repeat delay base)))]
    1.39 +      (if (not= base-val alt-val)
    1.40 +        [(conj actions alt) alt-branch]
    1.41 +        (recur base-branch (conj actions base))))))
    1.42  
    1.43  
    1.44 +  
    1.45  ;; (defn advance
    1.46  ;;   ([base alt difference-metric [commands state]]
    1.47  ;;      (let [[c s]
    1.48 @@ -70,32 +87,19 @@
    1.49    (reduce (fn [script dir]
    1.50              (move dir script)) script directions))
    1.51  
    1.52 -(defn scroll-text
    1.53 -  ([script]
    1.54 -     (advance [:b] [:a :b] script))
    1.55 -  ([n script]
    1.56 -     (reduce (fn [script _]
    1.57 -               (scroll-text script))
    1.58 -             script
    1.59 -             (range n))))
    1.60 -
    1.61  (defn menu
    1.62    [directions script]
    1.63    (reduce (fn [script direction]
    1.64              (move direction script))
    1.65            script directions))
    1.66  
    1.67 -(defn end-text [script]
    1.68 -  (->> script
    1.69 -       (scroll-text)
    1.70 -       (play-moves [[] [:a]])))
    1.71  
    1.72  (defn search-string
    1.73 -  [array string]
    1.74 +  [^SaveState state string]
    1.75    (let [codes
    1.76          (str->character-codes string)
    1.77          codes-length (count codes)
    1.78 -        mem (vec array)
    1.79 +        mem (vec (memory state))
    1.80          mem-length (count mem)]
    1.81      (loop [idx 0]
    1.82        (if (< (- mem-length idx) codes-length)
    1.83 @@ -105,6 +109,50 @@
    1.84            idx
    1.85            (recur (inc idx)))))))
    1.86  
    1.87 +(def text-address 0x9DC1)
    1.88 +
    1.89 +(defn displayed-text
    1.90 +  ([^SaveState state]
    1.91 +     (character-codes->str
    1.92 +      (subvec (vec (memory state))
    1.93 +              text-address
    1.94 +              (+ text-address 82))))
    1.95 +  ([] (displayed-text @current-state)))
    1.96 +
    1.97 +;; (defn scroll-text
    1.98 +;;   ([script]
    1.99 +;;      (first-difference [:b] [:a :b] AF script))
   1.100 +;;   ([n script]
   1.101 +;;      (reduce (fn [script _]
   1.102 +;;                (scroll-text script))
   1.103 +;;              script
   1.104 +;;              (range n))))
   1.105 +
   1.106 +(defn scroll-text
   1.107 +  ([script]
   1.108 +     (delayed-difference
   1.109 +      [:b] [:a :b] 25 displayed-text script))
   1.110 +  ([n script]
   1.111 +     (reduce (fn [script _]
   1.112 +               (scroll-text script))
   1.113 +             script
   1.114 +             (range n))))
   1.115 +
   1.116 +
   1.117 +(defn end-text [script]
   1.118 +  (->> script
   1.119 +       (scroll-text)
   1.120 +       (play-moves [[] [:a]])))
   1.121 +
   1.122 +
   1.123 +
   1.124 +(common-differences
   1.125 + (vec (memory (step (talk-to-oak) [:a])))
   1.126 + (vec (memory (step (talk-to-oak) []))))
   1.127 + 
   1.128 +
   1.129 +
   1.130 +
   1.131  
   1.132  (defn do-nothing [n script]
   1.133    (->> script