changeset 314:073600cba28a

scroll text works robustly but is slow
author Robert McIntyre <rlm@mit.edu>
date Mon, 02 Apr 2012 20:30:02 -0500
parents 8e63b0bb8ea3
children 363b650a77cc
files clojure/com/aurellem/gb/saves.clj clojure/com/aurellem/gb/util.clj clojure/com/aurellem/run/util.clj save-states/normal-conversation.sav save-states/talk-to-oak.sav
diffstat 5 files changed, 76 insertions(+), 23 deletions(-) [+]
line wrap: on
line diff
     1.1 --- a/clojure/com/aurellem/gb/saves.clj	Mon Apr 02 10:58:16 2012 -0500
     1.2 +++ b/clojure/com/aurellem/gb/saves.clj	Mon Apr 02 20:30:02 2012 -0500
     1.3 @@ -11,5 +11,8 @@
     1.4  (defn rlm-pallet-town []
     1.5    (read-state "rlm-pallet-town"))
     1.6  
     1.7 +(defn talk-to-oak []
     1.8 +  (read-state "talk-to-oak"))
     1.9  
    1.10 -
    1.11 +(defn normal-conv []
    1.12 +  (read-state "normal-conversation"))
    1.13 \ No newline at end of file
     2.1 --- a/clojure/com/aurellem/gb/util.clj	Mon Apr 02 10:58:16 2012 -0500
     2.2 +++ b/clojure/com/aurellem/gb/util.clj	Mon Apr 02 20:30:02 2012 -0500
     2.3 @@ -147,10 +147,12 @@
     2.4  
     2.5  (defn common-differences [& seqs]
     2.6    (let [backbone (range (count (first seqs)))]
     2.7 -    (filter
     2.8 -     (comp (partial apply distinct?) second)
     2.9 -     (zipmap backbone
    2.10 -             (apply (partial map list) seqs)))))
    2.11 +    (sort-by
    2.12 +     first
    2.13 +     (filter
    2.14 +      (comp (partial apply distinct?) second)
    2.15 +      (zipmap backbone
    2.16 +              (apply (partial map list) seqs))))))
    2.17  
    2.18  (defn temporal-compare [& states]
    2.19    (apply common-differences
     3.1 --- a/clojure/com/aurellem/run/util.clj	Mon Apr 02 10:58:16 2012 -0500
     3.2 +++ b/clojure/com/aurellem/run/util.clj	Mon Apr 02 20:30:02 2012 -0500
     3.3 @@ -1,5 +1,5 @@
     3.4  (ns com.aurellem.run.util
     3.5 -  (:use (com.aurellem.gb util gb-driver vbm characters))
     3.6 +  (:use (com.aurellem.gb util gb-driver vbm characters saves))
     3.7    (:import [com.aurellem.gb.gb_driver SaveState]))
     3.8  
     3.9  (def ↑ [:u])
    3.10 @@ -19,9 +19,8 @@
    3.11          [(conj actions alt) alt-branch]
    3.12          (recur base-branch (conj actions base))))))
    3.13  
    3.14 -
    3.15  (defn repeat-until-different
    3.16 -  [buttons metric [moves root]]
    3.17 +  [buttons metric [moves root :as script]]
    3.18    (let [baseline (metric root)]
    3.19      (loop [actions (vec moves)
    3.20             state root]
    3.21 @@ -31,8 +30,26 @@
    3.22            [new-actions new-state]
    3.23            (recur new-actions new-state))))))
    3.24  
    3.25 +(defn delayed-difference
    3.26 +  [base alt delay difference-metric [moves root :as script]]
    3.27 +  (loop [branch-point root
    3.28 +         actions moves]
    3.29 +    (let [base-branch (step branch-point base)
    3.30 +          base-val
    3.31 +          (difference-metric
    3.32 +           (run-moves base-branch
    3.33 +                      (repeat delay base)))
    3.34 +          alt-branch (step branch-point alt)
    3.35 +          alt-val
    3.36 +          (difference-metric
    3.37 +           (run-moves alt-branch
    3.38 +                      (repeat delay base)))]
    3.39 +      (if (not= base-val alt-val)
    3.40 +        [(conj actions alt) alt-branch]
    3.41 +        (recur base-branch (conj actions base))))))
    3.42  
    3.43  
    3.44 +  
    3.45  ;; (defn advance
    3.46  ;;   ([base alt difference-metric [commands state]]
    3.47  ;;      (let [[c s]
    3.48 @@ -70,32 +87,19 @@
    3.49    (reduce (fn [script dir]
    3.50              (move dir script)) script directions))
    3.51  
    3.52 -(defn scroll-text
    3.53 -  ([script]
    3.54 -     (advance [:b] [:a :b] script))
    3.55 -  ([n script]
    3.56 -     (reduce (fn [script _]
    3.57 -               (scroll-text script))
    3.58 -             script
    3.59 -             (range n))))
    3.60 -
    3.61  (defn menu
    3.62    [directions script]
    3.63    (reduce (fn [script direction]
    3.64              (move direction script))
    3.65            script directions))
    3.66  
    3.67 -(defn end-text [script]
    3.68 -  (->> script
    3.69 -       (scroll-text)
    3.70 -       (play-moves [[] [:a]])))
    3.71  
    3.72  (defn search-string
    3.73 -  [array string]
    3.74 +  [^SaveState state string]
    3.75    (let [codes
    3.76          (str->character-codes string)
    3.77          codes-length (count codes)
    3.78 -        mem (vec array)
    3.79 +        mem (vec (memory state))
    3.80          mem-length (count mem)]
    3.81      (loop [idx 0]
    3.82        (if (< (- mem-length idx) codes-length)
    3.83 @@ -105,6 +109,50 @@
    3.84            idx
    3.85            (recur (inc idx)))))))
    3.86  
    3.87 +(def text-address 0x9DC1)
    3.88 +
    3.89 +(defn displayed-text
    3.90 +  ([^SaveState state]
    3.91 +     (character-codes->str
    3.92 +      (subvec (vec (memory state))
    3.93 +              text-address
    3.94 +              (+ text-address 82))))
    3.95 +  ([] (displayed-text @current-state)))
    3.96 +
    3.97 +;; (defn scroll-text
    3.98 +;;   ([script]
    3.99 +;;      (first-difference [:b] [:a :b] AF script))
   3.100 +;;   ([n script]
   3.101 +;;      (reduce (fn [script _]
   3.102 +;;                (scroll-text script))
   3.103 +;;              script
   3.104 +;;              (range n))))
   3.105 +
   3.106 +(defn scroll-text
   3.107 +  ([script]
   3.108 +     (delayed-difference
   3.109 +      [:b] [:a :b] 25 displayed-text script))
   3.110 +  ([n script]
   3.111 +     (reduce (fn [script _]
   3.112 +               (scroll-text script))
   3.113 +             script
   3.114 +             (range n))))
   3.115 +
   3.116 +
   3.117 +(defn end-text [script]
   3.118 +  (->> script
   3.119 +       (scroll-text)
   3.120 +       (play-moves [[] [:a]])))
   3.121 +
   3.122 +
   3.123 +
   3.124 +(common-differences
   3.125 + (vec (memory (step (talk-to-oak) [:a])))
   3.126 + (vec (memory (step (talk-to-oak) []))))
   3.127 + 
   3.128 +
   3.129 +
   3.130 +
   3.131  
   3.132  (defn do-nothing [n script]
   3.133    (->> script
     4.1 Binary file save-states/normal-conversation.sav has changed
     5.1 Binary file save-states/talk-to-oak.sav has changed