# HG changeset patch
# User Robert McIntyre <rlm@mit.edu>
# Date 1333416628 18000
# Node ID 363b650a77ccab0ef2f2d01bc8eadfc18bc172d3
# Parent  073600cba28ade48a4528506e19acdf4d56afba1# Parent  2060219691fa49f8e98ababb21c71ecd0e68612c
merge

diff -r 2060219691fa -r 363b650a77cc clojure/com/aurellem/exp/item_bridge.clj
--- a/clojure/com/aurellem/exp/item_bridge.clj	Sun Apr 01 21:47:04 2012 -0500
+++ b/clojure/com/aurellem/exp/item_bridge.clj	Mon Apr 02 20:30:28 2012 -0500
@@ -10,12 +10,16 @@
 (defn corrupt-item-state []
   (read-state "corrupt-items"))
 
-(defn view-memory-range [state start end]
-  (dorun
-   (map (fn [loc val]
-          (println (format "%04X : %02X" loc val)))
-        (range start end) (subvec (vec (memory state)) start end)))
-  state)
+(defn view-memory-range
+  ([start end]
+     (view-memory-range
+      @current-state start end))
+  ([state start end]
+     (dorun
+      (map (fn [loc val]
+             (println (format "%04X : %02X" loc val)))
+           (range start end) (subvec (vec (memory state)) start end)))
+     state))
 
 (defn almost-broken
   "if one more memory location is turned into 0x03, the game crashes."
diff -r 2060219691fa -r 363b650a77cc clojure/com/aurellem/gb/saves.clj
--- a/clojure/com/aurellem/gb/saves.clj	Sun Apr 01 21:47:04 2012 -0500
+++ b/clojure/com/aurellem/gb/saves.clj	Mon Apr 02 20:30:28 2012 -0500
@@ -11,5 +11,8 @@
 (defn rlm-pallet-town []
   (read-state "rlm-pallet-town"))
 
+(defn talk-to-oak []
+  (read-state "talk-to-oak"))
 
-
+(defn normal-conv []
+  (read-state "normal-conversation"))
\ No newline at end of file
diff -r 2060219691fa -r 363b650a77cc clojure/com/aurellem/gb/util.clj
--- a/clojure/com/aurellem/gb/util.clj	Sun Apr 01 21:47:04 2012 -0500
+++ b/clojure/com/aurellem/gb/util.clj	Mon Apr 02 20:30:28 2012 -0500
@@ -147,10 +147,12 @@
 
 (defn common-differences [& seqs]
   (let [backbone (range (count (first seqs)))]
-    (filter
-     (comp (partial apply distinct?) second)
-     (zipmap backbone
-             (apply (partial map list) seqs)))))
+    (sort-by
+     first
+     (filter
+      (comp (partial apply distinct?) second)
+      (zipmap backbone
+              (apply (partial map list) seqs))))))
 
 (defn temporal-compare [& states]
   (apply common-differences
diff -r 2060219691fa -r 363b650a77cc clojure/com/aurellem/run/bootstrap_0.clj
--- a/clojure/com/aurellem/run/bootstrap_0.clj	Sun Apr 01 21:47:04 2012 -0500
+++ b/clojure/com/aurellem/run/bootstrap_0.clj	Mon Apr 02 20:30:28 2012 -0500
@@ -28,30 +28,18 @@
          (advance [] [:r] DE)
          (play-moves
           [[]
-           [:r] [] [:r] [] [:r] [] [:r] []
-           [:r] [] [:r] [] [:r] [] [:d] []
-           [:d] [:a]                         ;; space
-           [:l] [] [:d] [:a]                 ;; [PK]
-           [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
-           [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
-           [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
-           [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
-
-           [:d] [] [:r] [:a]                 ;; finish
+           [] [] [:r] [] [:d] [:a]           ;; L
+           [:r] [] [:r] [] [:r] [] [:r] [] 
+           [:r] [] [:d] [] [:d] [:a]         ;; [PK]
+           [:u] [] [:l] [] [:l] []
+           [:l] [] [:l] [] [:l] [:a]         ;; U
+           [:r] [] [:r] [] [:r] []
+           [:r] [] [:r] [] [:d] [:a]         ;; [PK]
+           [] [:a]                           ;; [PK]
+           [] [:a]                           ;; [PK]
+           [:r] [] [:d] [:a]                 ;; END
            ]))))
 
-(defn walk
-  "Move the character along the given directions."
-  [directions script]
-  (reduce (fn [script direction]
-            (move direction script))
-          script directions))
-
-(def ↑ [:u])
-(def ↓ [:d])
-(def ← [:l])
-(def → [:r])
-
 (defn-memo leave-house
   ([] (leave-house (name-rival-bootstrap)))
   ([script]
@@ -70,11 +58,6 @@
           (walk [→ → → → →
                  ↑ ↑ ↑ ↑ ↑ ↑]))))
 
-(defn end-text [script]
-  (->> script
-       (scroll-text)
-       (play-moves [[] [:a]])))
-
 (defn-memo start-pikachu-battle
   ([] (start-pikachu-battle
        (to-pallet-town-edge)))
@@ -126,8 +109,8 @@
 
           (play-moves
            (concat
-            (repeat 42 [])
-                   [[:b] [:b] [:b] [:b]])))))
+            (repeat 50 [])
+                   [[:b] [] []])))))
 
 (defn-memo begin-battle-with-rival
   ([] (begin-battle-with-rival
@@ -139,63 +122,26 @@
           (end-text)
           (scroll-text))))
 
-(defn search-string
-  [array string]
-  (let [codes
-        (str->character-codes string)
-        codes-length (count codes)
-        mem (vec array)
-        mem-length (count mem)]
-    (loop [idx 0]
-      (if (< (- mem-length idx) codes-length)
-        nil
-        (if (= (subvec mem idx (+ idx codes-length))
-               codes)
-          idx
-          (recur (inc idx)))))))
-        
-(defn critical-hit
-  "Put the cursor over the desired attack. This program will
-   determine the appropriate amount of blank frames to
-   insert before pressing [:a] to ensure that the attack is
-   a critical hit."
-  [script]
-  (loop [blanks 6]
-    (let [new-script
-          (->> script
-               (play-moves
-                (concat (repeat blanks [])
-                        [[:a][]])))]
-      (if (let [future-state
-                (run-moves (second new-script)
-                           (repeat 400 []))
-
-                result (search-string (memory future-state)
-                                      "Critical")]
-            (if result
-              (println "critical hit with" blanks "blank frames"))
-            result) 
-        new-script
-        (recur (inc blanks))))))  
-
 (defn-memo battle-with-rival
   ([] (battle-with-rival
         (begin-battle-with-rival)))
   ([script]
      (->> script
-          (play-moves (repeat 381 []))
+          (do-nothing 400)
           (play-moves [[:a]])
           (critical-hit)
-          (play-moves (repeat 100 []))
+          (do-nothing 100)
           (scroll-text)
-          (play-moves
-           (concat (repeat 275 []) [[:a]]))
+          (do-nothing 275)
+          (play-moves [[:a]])
           (critical-hit)
-          (play-moves (repeat 100 []))
+          (do-nothing 100)
           (scroll-text)
-          (play-moves
-           (concat (repeat 270 []) [[:a]]))
-          (play-moves [[][][][][][][][][:a]]))))
+          (do-nothing 270)
+          (play-moves [[:a]])
+          (critical-hit)
+          (do-nothing 100)
+          (scroll-text))))
 
 (defn-memo finish-rival-text
   ([] (finish-rival-text
@@ -207,11 +153,6 @@
           (scroll-text 9)
           (end-text))))
 
-(defn do-nothing [n script]
-  (->> script
-       (play-moves
-        (repeat n []))))
-
 (defn-memo pikachu-comes-out
   ([] (pikachu-comes-out
        (finish-rival-text)))
@@ -239,33 +180,6 @@
                  ↑ ↑ ↑ ↑ ↑ ↑
                  → ↑]))))
 
-(defn move-thru-grass
-  [direction script]
-  (loop [blanks 0]
-    (let [new-script
-          (->> script
-               (play-moves (repeat blanks []))
-               (move direction))
-
-          future-state
-          (run-moves (second new-script)
-                     (repeat 600 []))
-          
-          result (search-string (memory future-state)
-                                "Wild")]
-      (if (nil? result)
-        (do
-          (if (< 0 blanks)
-            (do(println "avoided pokemon with" blanks "blank frames")))
-             new-script)
-        (recur (inc blanks))))))
-
-(defn walk-thru-grass
-  [directions script]
-  (reduce (fn [script direction]
-            (move-thru-grass direction script))
-          script directions))
-
 (defn-memo pallet-edge->viridian-mart
   ([] (pallet-edge->viridian-mart true
        (oaks-lab->pallet-town-edge)))
@@ -281,11 +195,12 @@
           ;; leave straight grass
           (walk-thru-grass
            [↑ ↑ ↑ ↑ ↑])
-          
+
           (walk [↑ ↑ ↑ ↑])
-          
+
           (walk-thru-grass
            [← ← ↑])
+
           (walk [↑ ↑ ↑ ↑ → → → ])
 
           (walk-thru-grass
@@ -583,8 +498,6 @@
           (advance [] [:a])
           (advance [:a] [:a :start]))))
 
-(def menu walk)
-
 (defn-memo corrupt-item-list
   ([] (corrupt-item-list
        (do-save-corruption)))
@@ -598,16 +511,6 @@
                  ↓ ↓ ↓ [:a]])           ; switch with 9th "pokemon"
                  
           (do-nothing 1))))
-
-
-(defn slowly
-  [delay moves script]
-  (reduce
-   (fn [script move]
-     (->> script
-          (do-nothing delay)
-          (play-moves (vector move))))
-   script moves))
                      
 (defn-memo get-burn-heals
   ([] (get-burn-heals
@@ -649,18 +552,6 @@
                       
           (do-nothing 10))))
 
-(defn save-game-properly
-  [number-down script]
-  (->> 
-   (reduce (fn [script _]
-             (->> script
-                  (advance [] [:d])))
-           script
-           (range number-down))
-   (play-moves [[] [] [:a]])
-   (scroll-text)
-   (do-nothing 300)))
-
 (defn-memo corrupt-item-list-again
   ([] (corrupt-item-list-again (get-burn-heals)))
   ([script]
@@ -678,8 +569,6 @@
                                         ; switching it to
           )))                           ; tenth place.
           
-          
-
 (defn-memo viridian-store->viridian-poke-center
   ([] (viridian-store->viridian-poke-center
        (corrupt-item-list-again)))
@@ -723,16 +612,6 @@
           (menu [[:d] [:a]])
           (do-nothing 40))))
 
-
-(defn multiple-times
-  ([n command args script]
-     (reduce (fn [script _]
-               (apply command (concat args [script])))
-             script
-             (range n)))
-  ([n command script]
-     (multiple-times n command [] script)))
-
 (defn deposit-n-items
   [n script]
   (->> script
diff -r 2060219691fa -r 363b650a77cc clojure/com/aurellem/run/save_corruption.clj
--- a/clojure/com/aurellem/run/save_corruption.clj	Sun Apr 01 21:47:04 2012 -0500
+++ b/clojure/com/aurellem/run/save_corruption.clj	Mon Apr 02 20:30:28 2012 -0500
@@ -2,17 +2,12 @@
   (:use (com.aurellem.gb gb-driver vbm))
   (:use (com.aurellem.run title)))
 
-(use 'clojure.repl)
-
 (defn-memo start-walking
   ([script] 
      (->> script
           (advance [:b] [:b :r])))
   ([] (start-walking (finish-title))))
-
-(def move
-  (partial advance []))
-
+  
 (defn-memo walk-to-stairs
   ([] (walk-to-stairs (start-walking)))
   ([script]
diff -r 2060219691fa -r 363b650a77cc clojure/com/aurellem/run/title.clj
--- a/clojure/com/aurellem/run/title.clj	Sun Apr 01 21:47:04 2012 -0500
+++ b/clojure/com/aurellem/run/title.clj	Mon Apr 02 20:30:28 2012 -0500
@@ -1,34 +1,6 @@
 (ns com.aurellem.run.title
   (:use (com.aurellem.gb gb-driver vbm)))
 
-(defn first-difference [base alt summary root]
-  (loop [branch-point root
-         actions []]
-    (let [base-branch (step branch-point base)
-          base-val (summary base-branch)
-          alt-branch (step branch-point alt)
-          alt-val (summary alt-branch)]
-      (if (not= base-val alt-val)
-        [(conj actions alt) alt-branch]
-        (recur base-branch (conj actions base))))))
-
-(defn advance
-  ([base alt summary [commands state]]
-     (let [[c s] (first-difference base alt summary state)]
-       [(concat commands c) s]))
-  ([base alt [commands state]]
-     (advance base alt AF [commands state]))
-  ([alt [commands state]]
-     (advance [] alt [commands state])))
-
-(defn scroll-text
-  ([script]
-     (advance [:b] [:a :b] script))
-  ([n script]
-     (reduce (fn [script _]
-               (scroll-text script))
-             script
-             (range n))))
 
 (defn start [] [[] (root)])
 
diff -r 2060219691fa -r 363b650a77cc clojure/com/aurellem/run/util.clj
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/clojure/com/aurellem/run/util.clj	Mon Apr 02 20:30:28 2012 -0500
@@ -0,0 +1,232 @@
+(ns com.aurellem.run.util
+  (:use (com.aurellem.gb util gb-driver vbm characters saves))
+  (:import [com.aurellem.gb.gb_driver SaveState]))
+
+(def ↑ [:u])
+(def ↓ [:d])
+(def ← [:l])
+(def → [:r])
+
+(defn first-difference
+  [base alt difference-metric [moves root :as script]]
+  (loop [branch-point root
+         actions moves]
+    (let [base-branch (step branch-point base)
+          base-val (difference-metric base-branch)
+          alt-branch (step branch-point alt)
+          alt-val (difference-metric alt-branch)]
+      (if (not= base-val alt-val)
+        [(conj actions alt) alt-branch]
+        (recur base-branch (conj actions base))))))
+
+(defn repeat-until-different
+  [buttons metric [moves root :as script]]
+  (let [baseline (metric root)]
+    (loop [actions (vec moves)
+           state root]
+      (let [new-state (step state buttons)
+            new-actions (conj actions buttons)]
+        (if (not= (metric new-state) baseline)
+          [new-actions new-state]
+          (recur new-actions new-state))))))
+
+(defn delayed-difference
+  [base alt delay difference-metric [moves root :as script]]
+  (loop [branch-point root
+         actions moves]
+    (let [base-branch (step branch-point base)
+          base-val
+          (difference-metric
+           (run-moves base-branch
+                      (repeat delay base)))
+          alt-branch (step branch-point alt)
+          alt-val
+          (difference-metric
+           (run-moves alt-branch
+                      (repeat delay base)))]
+      (if (not= base-val alt-val)
+        [(conj actions alt) alt-branch]
+        (recur base-branch (conj actions base))))))
+
+
+  
+;; (defn advance
+;;   ([base alt difference-metric [commands state]]
+;;      (let [[c s]
+;;            (first-difference base alt difference-metric state)]
+;;        [(concat commands c) s]))
+;;   ([base alt [commands state]]
+;;      (advance base alt AF [commands state]))
+;;   ([alt [commands state]]
+;;      (advance [] alt [commands state])))
+
+
+(def x-position-address 0xD361)
+(def y-position-address 0xD362)
+
+(defn x-position
+  ([^SaveState state]
+     (aget (memory state) x-position-address))
+  ([] (x-position @current-state)))
+
+(defn y-position
+  ([^SaveState state]
+     (aget (memory state) y-position-address))
+  ([] (y-position @current-state)))
+
+(defn move
+  [dir script]
+  (let [current-position-fn
+        (cond (#{← →} dir) x-position
+              (#{↑ ↓} dir) y-position)]
+    (repeat-until-different dir current-position-fn script)))
+  
+(defn walk 
+  "Move the character along the given directions."
+  [directions script]
+  (reduce (fn [script dir]
+            (move dir script)) script directions))
+
+(defn menu
+  [directions script]
+  (reduce (fn [script direction]
+            (move direction script))
+          script directions))
+
+
+(defn search-string
+  [^SaveState state string]
+  (let [codes
+        (str->character-codes string)
+        codes-length (count codes)
+        mem (vec (memory state))
+        mem-length (count mem)]
+    (loop [idx 0]
+      (if (< (- mem-length idx) codes-length)
+        nil
+        (if (= (subvec mem idx (+ idx codes-length))
+               codes)
+          idx
+          (recur (inc idx)))))))
+
+(def text-address 0x9DC1)
+
+(defn displayed-text
+  ([^SaveState state]
+     (character-codes->str
+      (subvec (vec (memory state))
+              text-address
+              (+ text-address 82))))
+  ([] (displayed-text @current-state)))
+
+;; (defn scroll-text
+;;   ([script]
+;;      (first-difference [:b] [:a :b] AF script))
+;;   ([n script]
+;;      (reduce (fn [script _]
+;;                (scroll-text script))
+;;              script
+;;              (range n))))
+
+(defn scroll-text
+  ([script]
+     (delayed-difference
+      [:b] [:a :b] 25 displayed-text script))
+  ([n script]
+     (reduce (fn [script _]
+               (scroll-text script))
+             script
+             (range n))))
+
+
+(defn end-text [script]
+  (->> script
+       (scroll-text)
+       (play-moves [[] [:a]])))
+
+
+
+(common-differences
+ (vec (memory (step (talk-to-oak) [:a])))
+ (vec (memory (step (talk-to-oak) []))))
+ 
+
+
+
+
+(defn do-nothing [n script]
+  (->> script
+       (play-moves
+        (repeat n []))))
+
+
+(defn critical-hit
+  "Put the cursor over the desired attack. This program will
+   determine the appropriate amount of blank frames to
+   insert before pressing [:a] to ensure that the attack is
+   a critical hit."
+  [script]
+  (loop [blanks 6]
+    (let [new-script
+          (->> script
+               (play-moves
+                (concat (repeat blanks [])
+                        [[:a][]])))]
+      (if (let [future-state
+                (run-moves (second new-script)
+                           (repeat 400 []))
+
+                result (search-string (memory future-state)
+                                      "Critical")]
+            (if result
+              (println "critical hit with" blanks "blank frames"))
+            result) 
+        new-script
+        (recur (inc blanks))))))  
+
+(defn move-thru-grass
+  [direction script]
+  (loop [blanks 0]
+    (let [new-script
+          (->> script
+               (play-moves (repeat blanks []))
+               (move direction))
+
+          future-state
+          (run-moves (second new-script)
+                     (repeat 600 []))
+          
+          result (search-string (memory future-state)
+                                "Wild")]
+      (if (nil? result)
+        (do
+          (if (< 0 blanks)
+            (do
+              (println "avoided pokemon with"
+                       blanks "blank frames")))
+             new-script)
+        (recur (inc blanks))))))
+
+(defn walk-thru-grass
+  [directions script]
+  (reduce (fn [script direction]
+            (move-thru-grass direction script))
+          script directions))
+
+(defn slowly
+  [delay moves script]
+  (reduce
+   (fn [script move]
+     (->> script
+          (do-nothing delay)
+          (play-moves (vector move))))
+   script moves))
+
+(defn multiple-times
+  ([n command args script]
+     (reduce (fn [script _]
+               (apply command (concat args [script])))
+             script
+             (range n)))
+  ([n command script]
+     (multiple-times n command [] script)))
diff -r 2060219691fa -r 363b650a77cc save-states/normal-conversation.sav
Binary file save-states/normal-conversation.sav has changed
diff -r 2060219691fa -r 363b650a77cc save-states/talk-to-oak.sav
Binary file save-states/talk-to-oak.sav has changed