1.1 --- a/clojure/com/aurellem/exp/item_bridge.clj	Sat Mar 31 00:41:28 2012 -0500
     1.2 +++ b/clojure/com/aurellem/exp/item_bridge.clj	Mon Apr 02 10:58:16 2012 -0500
     1.3 @@ -10,12 +10,16 @@
     1.4  (defn corrupt-item-state []
     1.5    (read-state "corrupt-items"))
     1.6  
     1.7 -(defn view-memory-range [state start end]
     1.8 -  (dorun
     1.9 -   (map (fn [loc val]
    1.10 -          (println (format "%04X : %02X" loc val)))
    1.11 -        (range start end) (subvec (vec (memory state)) start end)))
    1.12 -  state)
    1.13 +(defn view-memory-range
    1.14 +  ([start end]
    1.15 +     (view-memory-range
    1.16 +      @current-state start end))
    1.17 +  ([state start end]
    1.18 +     (dorun
    1.19 +      (map (fn [loc val]
    1.20 +             (println (format "%04X : %02X" loc val)))
    1.21 +           (range start end) (subvec (vec (memory state)) start end)))
    1.22 +     state))
    1.23  
    1.24  (defn almost-broken
    1.25    "if one more memory location is turned into 0x03, the game crashes."

     2.1 --- a/clojure/com/aurellem/run/bootstrap_0.clj	Sat Mar 31 00:41:28 2012 -0500
     2.2 +++ b/clojure/com/aurellem/run/bootstrap_0.clj	Mon Apr 02 10:58:16 2012 -0500
     2.3 @@ -28,30 +28,18 @@
     2.4           (advance [] [:r] DE)
     2.5           (play-moves
     2.6            [[]
     2.7 -           [:r] [] [:r] [] [:r] [] [:r] []
     2.8 -           [:r] [] [:r] [] [:r] [] [:d] []
     2.9 -           [:d] [:a]                         ;; space
    2.10 -           [:l] [] [:d] [:a]                 ;; [PK]
    2.11 -           [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
    2.12 -           [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
    2.13 -           [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
    2.14 -           [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
    2.15 -
    2.16 -           [:d] [] [:r] [:a]                 ;; finish
    2.17 +           [] [] [:r] [] [:d] [:a]           ;; L
    2.18 +           [:r] [] [:r] [] [:r] [] [:r] [] 
    2.19 +           [:r] [] [:d] [] [:d] [:a]         ;; [PK]
    2.20 +           [:u] [] [:l] [] [:l] []
    2.21 +           [:l] [] [:l] [] [:l] [:a]         ;; U
    2.22 +           [:r] [] [:r] [] [:r] []
    2.23 +           [:r] [] [:r] [] [:d] [:a]         ;; [PK]
    2.24 +           [] [:a]                           ;; [PK]
    2.25 +           [] [:a]                           ;; [PK]
    2.26 +           [:r] [] [:d] [:a]                 ;; END
    2.27             ]))))
    2.28  
    2.29 -(defn walk
    2.30 -  "Move the character along the given directions."
    2.31 -  [directions script]
    2.32 -  (reduce (fn [script direction]
    2.33 -            (move direction script))
    2.34 -          script directions))
    2.35 -
    2.36 -(def ↑ [:u])
    2.37 -(def ↓ [:d])
    2.38 -(def ← [:l])
    2.39 -(def → [:r])
    2.40 -
    2.41  (defn-memo leave-house
    2.42    ([] (leave-house (name-rival-bootstrap)))
    2.43    ([script]
    2.44 @@ -70,11 +58,6 @@
    2.45            (walk [→ → → → →
    2.46                   ↑ ↑ ↑ ↑ ↑ ↑]))))
    2.47  
    2.48 -(defn end-text [script]
    2.49 -  (->> script
    2.50 -       (scroll-text)
    2.51 -       (play-moves [[] [:a]])))
    2.52 -
    2.53  (defn-memo start-pikachu-battle
    2.54    ([] (start-pikachu-battle
    2.55         (to-pallet-town-edge)))
    2.56 @@ -126,8 +109,8 @@
    2.57  
    2.58            (play-moves
    2.59             (concat
    2.60 -            (repeat 42 [])
    2.61 -                   [[:b] [:b] [:b] [:b]])))))
    2.62 +            (repeat 50 [])
    2.63 +                   [[:b] [] []])))))
    2.64  
    2.65  (defn-memo begin-battle-with-rival
    2.66    ([] (begin-battle-with-rival
    2.67 @@ -139,63 +122,26 @@
    2.68            (end-text)
    2.69            (scroll-text))))
    2.70  
    2.71 -(defn search-string
    2.72 -  [array string]
    2.73 -  (let [codes
    2.74 -        (str->character-codes string)
    2.75 -        codes-length (count codes)
    2.76 -        mem (vec array)
    2.77 -        mem-length (count mem)]
    2.78 -    (loop [idx 0]
    2.79 -      (if (< (- mem-length idx) codes-length)
    2.80 -        nil
    2.81 -        (if (= (subvec mem idx (+ idx codes-length))
    2.82 -               codes)
    2.83 -          idx
    2.84 -          (recur (inc idx)))))))
    2.85 -        
    2.86 -(defn critical-hit
    2.87 -  "Put the cursor over the desired attack. This program will
    2.88 -   determine the appropriate amount of blank frames to
    2.89 -   insert before pressing [:a] to ensure that the attack is
    2.90 -   a critical hit."
    2.91 -  [script]
    2.92 -  (loop [blanks 6]
    2.93 -    (let [new-script
    2.94 -          (->> script
    2.95 -               (play-moves
    2.96 -                (concat (repeat blanks [])
    2.97 -                        [[:a][]])))]
    2.98 -      (if (let [future-state
    2.99 -                (run-moves (second new-script)
   2.100 -                           (repeat 400 []))
   2.101 -
   2.102 -                result (search-string (memory future-state)
   2.103 -                                      "Critical")]
   2.104 -            (if result
   2.105 -              (println "critical hit with" blanks "blank frames"))
   2.106 -            result) 
   2.107 -        new-script
   2.108 -        (recur (inc blanks))))))  
   2.109 -
   2.110  (defn-memo battle-with-rival
   2.111    ([] (battle-with-rival
   2.112          (begin-battle-with-rival)))
   2.113    ([script]
   2.114       (->> script
   2.115 -          (play-moves (repeat 381 []))
   2.116 +          (do-nothing 400)
   2.117            (play-moves [[:a]])
   2.118            (critical-hit)
   2.119 -          (play-moves (repeat 100 []))
   2.120 +          (do-nothing 100)
   2.121            (scroll-text)
   2.122 -          (play-moves
   2.123 -           (concat (repeat 275 []) [[:a]]))
   2.124 +          (do-nothing 275)
   2.125 +          (play-moves [[:a]])
   2.126            (critical-hit)
   2.127 -          (play-moves (repeat 100 []))
   2.128 +          (do-nothing 100)
   2.129            (scroll-text)
   2.130 -          (play-moves
   2.131 -           (concat (repeat 270 []) [[:a]]))
   2.132 -          (play-moves [[][][][][][][][][:a]]))))
   2.133 +          (do-nothing 270)
   2.134 +          (play-moves [[:a]])
   2.135 +          (critical-hit)
   2.136 +          (do-nothing 100)
   2.137 +          (scroll-text))))
   2.138  
   2.139  (defn-memo finish-rival-text
   2.140    ([] (finish-rival-text
   2.141 @@ -207,11 +153,6 @@
   2.142            (scroll-text 9)
   2.143            (end-text))))
   2.144  
   2.145 -(defn do-nothing [n script]
   2.146 -  (->> script
   2.147 -       (play-moves
   2.148 -        (repeat n []))))
   2.149 -
   2.150  (defn-memo pikachu-comes-out
   2.151    ([] (pikachu-comes-out
   2.152         (finish-rival-text)))
   2.153 @@ -239,33 +180,6 @@
   2.154                   ↑ ↑ ↑ ↑ ↑ ↑
   2.155                   → ↑]))))
   2.156  
   2.157 -(defn move-thru-grass
   2.158 -  [direction script]
   2.159 -  (loop [blanks 0]
   2.160 -    (let [new-script
   2.161 -          (->> script
   2.162 -               (play-moves (repeat blanks []))
   2.163 -               (move direction))
   2.164 -
   2.165 -          future-state
   2.166 -          (run-moves (second new-script)
   2.167 -                     (repeat 600 []))
   2.168 -          
   2.169 -          result (search-string (memory future-state)
   2.170 -                                "Wild")]
   2.171 -      (if (nil? result)
   2.172 -        (do
   2.173 -          (if (< 0 blanks)
   2.174 -            (do(println "avoided pokemon with" blanks "blank frames")))
   2.175 -             new-script)
   2.176 -        (recur (inc blanks))))))
   2.177 -
   2.178 -(defn walk-thru-grass
   2.179 -  [directions script]
   2.180 -  (reduce (fn [script direction]
   2.181 -            (move-thru-grass direction script))
   2.182 -          script directions))
   2.183 -
   2.184  (defn-memo pallet-edge->viridian-mart
   2.185    ([] (pallet-edge->viridian-mart true
   2.186         (oaks-lab->pallet-town-edge)))
   2.187 @@ -281,11 +195,12 @@
   2.188            ;; leave straight grass
   2.189            (walk-thru-grass
   2.190             [↑ ↑ ↑ ↑ ↑])
   2.191 -          
   2.192 +
   2.193            (walk [↑ ↑ ↑ ↑])
   2.194 -          
   2.195 +
   2.196            (walk-thru-grass
   2.197             [← ← ↑])
   2.198 +
   2.199            (walk [↑ ↑ ↑ ↑ → → → ])
   2.200  
   2.201            (walk-thru-grass
   2.202 @@ -583,8 +498,6 @@
   2.203            (advance [] [:a])
   2.204            (advance [:a] [:a :start]))))
   2.205  
   2.206 -(def menu walk)
   2.207 -
   2.208  (defn-memo corrupt-item-list
   2.209    ([] (corrupt-item-list
   2.210         (do-save-corruption)))
   2.211 @@ -598,16 +511,6 @@
   2.212                   ↓ ↓ ↓ [:a]])           ; switch with 9th "pokemon"
   2.213                   
   2.214            (do-nothing 1))))
   2.215 -
   2.216 -
   2.217 -(defn slowly
   2.218 -  [delay moves script]
   2.219 -  (reduce
   2.220 -   (fn [script move]
   2.221 -     (->> script
   2.222 -          (do-nothing delay)
   2.223 -          (play-moves (vector move))))
   2.224 -   script moves))
   2.225                       
   2.226  (defn-memo get-burn-heals
   2.227    ([] (get-burn-heals
   2.228 @@ -649,18 +552,6 @@
   2.229                        
   2.230            (do-nothing 10))))
   2.231  
   2.232 -(defn save-game-properly
   2.233 -  [number-down script]
   2.234 -  (->> 
   2.235 -   (reduce (fn [script _]
   2.236 -             (->> script
   2.237 -                  (advance [] [:d])))
   2.238 -           script
   2.239 -           (range number-down))
   2.240 -   (play-moves [[] [] [:a]])
   2.241 -   (scroll-text)
   2.242 -   (do-nothing 300)))
   2.243 -
   2.244  (defn-memo corrupt-item-list-again
   2.245    ([] (corrupt-item-list-again (get-burn-heals)))
   2.246    ([script]
   2.247 @@ -678,8 +569,6 @@
   2.248                                          ; switching it to
   2.249            )))                           ; tenth place.
   2.250            
   2.251 -          
   2.252 -
   2.253  (defn-memo viridian-store->viridian-poke-center
   2.254    ([] (viridian-store->viridian-poke-center
   2.255         (corrupt-item-list-again)))
   2.256 @@ -723,16 +612,6 @@
   2.257            (menu [[:d] [:a]])
   2.258            (do-nothing 40))))
   2.259  
   2.260 -
   2.261 -(defn multiple-times
   2.262 -  ([n command args script]
   2.263 -     (reduce (fn [script _]
   2.264 -               (apply command (concat args [script])))
   2.265 -             script
   2.266 -             (range n)))
   2.267 -  ([n command script]
   2.268 -     (multiple-times n command [] script)))
   2.269 -
   2.270  (defn deposit-n-items
   2.271    [n script]
   2.272    (->> script

     3.1 --- a/clojure/com/aurellem/run/save_corruption.clj	Sat Mar 31 00:41:28 2012 -0500
     3.2 +++ b/clojure/com/aurellem/run/save_corruption.clj	Mon Apr 02 10:58:16 2012 -0500
     3.3 @@ -2,17 +2,12 @@
     3.4    (:use (com.aurellem.gb gb-driver vbm))
     3.5    (:use (com.aurellem.run title)))
     3.6  
     3.7 -(use 'clojure.repl)
     3.8 -
     3.9  (defn-memo start-walking
    3.10    ([script] 
    3.11       (->> script
    3.12            (advance [:b] [:b :r])))
    3.13    ([] (start-walking (finish-title))))
    3.14 -
    3.15 -(def move
    3.16 -  (partial advance []))
    3.17 -
    3.18 +  
    3.19  (defn-memo walk-to-stairs
    3.20    ([] (walk-to-stairs (start-walking)))
    3.21    ([script]

     4.1 --- a/clojure/com/aurellem/run/title.clj	Sat Mar 31 00:41:28 2012 -0500
     4.2 +++ b/clojure/com/aurellem/run/title.clj	Mon Apr 02 10:58:16 2012 -0500
     4.3 @@ -1,34 +1,6 @@
     4.4  (ns com.aurellem.run.title
     4.5    (:use (com.aurellem.gb gb-driver vbm)))
     4.6  
     4.7 -(defn first-difference [base alt summary root]
     4.8 -  (loop [branch-point root
     4.9 -         actions []]
    4.10 -    (let [base-branch (step branch-point base)
    4.11 -          base-val (summary base-branch)
    4.12 -          alt-branch (step branch-point alt)
    4.13 -          alt-val (summary alt-branch)]
    4.14 -      (if (not= base-val alt-val)
    4.15 -        [(conj actions alt) alt-branch]
    4.16 -        (recur base-branch (conj actions base))))))
    4.17 -
    4.18 -(defn advance
    4.19 -  ([base alt summary [commands state]]
    4.20 -     (let [[c s] (first-difference base alt summary state)]
    4.21 -       [(concat commands c) s]))
    4.22 -  ([base alt [commands state]]
    4.23 -     (advance base alt AF [commands state]))
    4.24 -  ([alt [commands state]]
    4.25 -     (advance [] alt [commands state])))
    4.26 -
    4.27 -(defn scroll-text
    4.28 -  ([script]
    4.29 -     (advance [:b] [:a :b] script))
    4.30 -  ([n script]
    4.31 -     (reduce (fn [script _]
    4.32 -               (scroll-text script))
    4.33 -             script
    4.34 -             (range n))))
    4.35  
    4.36  (defn start [] [[] (root)])
    4.37  

     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/clojure/com/aurellem/run/util.clj	Mon Apr 02 10:58:16 2012 -0500
     5.3 @@ -0,0 +1,184 @@
     5.4 +(ns com.aurellem.run.util
     5.5 +  (:use (com.aurellem.gb util gb-driver vbm characters))
     5.6 +  (:import [com.aurellem.gb.gb_driver SaveState]))
     5.7 +
     5.8 +(def ↑ [:u])
     5.9 +(def ↓ [:d])
    5.10 +(def ← [:l])
    5.11 +(def → [:r])
    5.12 +
    5.13 +(defn first-difference
    5.14 +  [base alt difference-metric [moves root :as script]]
    5.15 +  (loop [branch-point root
    5.16 +         actions moves]
    5.17 +    (let [base-branch (step branch-point base)
    5.18 +          base-val (difference-metric base-branch)
    5.19 +          alt-branch (step branch-point alt)
    5.20 +          alt-val (difference-metric alt-branch)]
    5.21 +      (if (not= base-val alt-val)
    5.22 +        [(conj actions alt) alt-branch]
    5.23 +        (recur base-branch (conj actions base))))))
    5.24 +
    5.25 +
    5.26 +(defn repeat-until-different
    5.27 +  [buttons metric [moves root]]
    5.28 +  (let [baseline (metric root)]
    5.29 +    (loop [actions (vec moves)
    5.30 +           state root]
    5.31 +      (let [new-state (step state buttons)
    5.32 +            new-actions (conj actions buttons)]
    5.33 +        (if (not= (metric new-state) baseline)
    5.34 +          [new-actions new-state]
    5.35 +          (recur new-actions new-state))))))
    5.36 +
    5.37 +
    5.38 +
    5.39 +;; (defn advance
    5.40 +;;   ([base alt difference-metric [commands state]]
    5.41 +;;      (let [[c s]
    5.42 +;;            (first-difference base alt difference-metric state)]
    5.43 +;;        [(concat commands c) s]))
    5.44 +;;   ([base alt [commands state]]
    5.45 +;;      (advance base alt AF [commands state]))
    5.46 +;;   ([alt [commands state]]
    5.47 +;;      (advance [] alt [commands state])))
    5.48 +
    5.49 +
    5.50 +(def x-position-address 0xD361)
    5.51 +(def y-position-address 0xD362)
    5.52 +
    5.53 +(defn x-position
    5.54 +  ([^SaveState state]
    5.55 +     (aget (memory state) x-position-address))
    5.56 +  ([] (x-position @current-state)))
    5.57 +
    5.58 +(defn y-position
    5.59 +  ([^SaveState state]
    5.60 +     (aget (memory state) y-position-address))
    5.61 +  ([] (y-position @current-state)))
    5.62 +
    5.63 +(defn move
    5.64 +  [dir script]
    5.65 +  (let [current-position-fn
    5.66 +        (cond (#{← →} dir) x-position
    5.67 +              (#{↑ ↓} dir) y-position)]
    5.68 +    (repeat-until-different dir current-position-fn script)))
    5.69 +  
    5.70 +(defn walk 
    5.71 +  "Move the character along the given directions."
    5.72 +  [directions script]
    5.73 +  (reduce (fn [script dir]
    5.74 +            (move dir script)) script directions))
    5.75 +
    5.76 +(defn scroll-text
    5.77 +  ([script]
    5.78 +     (advance [:b] [:a :b] script))
    5.79 +  ([n script]
    5.80 +     (reduce (fn [script _]
    5.81 +               (scroll-text script))
    5.82 +             script
    5.83 +             (range n))))
    5.84 +
    5.85 +(defn menu
    5.86 +  [directions script]
    5.87 +  (reduce (fn [script direction]
    5.88 +            (move direction script))
    5.89 +          script directions))
    5.90 +
    5.91 +(defn end-text [script]
    5.92 +  (->> script
    5.93 +       (scroll-text)
    5.94 +       (play-moves [[] [:a]])))
    5.95 +
    5.96 +(defn search-string
    5.97 +  [array string]
    5.98 +  (let [codes
    5.99 +        (str->character-codes string)
   5.100 +        codes-length (count codes)
   5.101 +        mem (vec array)
   5.102 +        mem-length (count mem)]
   5.103 +    (loop [idx 0]
   5.104 +      (if (< (- mem-length idx) codes-length)
   5.105 +        nil
   5.106 +        (if (= (subvec mem idx (+ idx codes-length))
   5.107 +               codes)
   5.108 +          idx
   5.109 +          (recur (inc idx)))))))
   5.110 +
   5.111 +
   5.112 +(defn do-nothing [n script]
   5.113 +  (->> script
   5.114 +       (play-moves
   5.115 +        (repeat n []))))
   5.116 +
   5.117 +
   5.118 +(defn critical-hit
   5.119 +  "Put the cursor over the desired attack. This program will
   5.120 +   determine the appropriate amount of blank frames to
   5.121 +   insert before pressing [:a] to ensure that the attack is
   5.122 +   a critical hit."
   5.123 +  [script]
   5.124 +  (loop [blanks 6]
   5.125 +    (let [new-script
   5.126 +          (->> script
   5.127 +               (play-moves
   5.128 +                (concat (repeat blanks [])
   5.129 +                        [[:a][]])))]
   5.130 +      (if (let [future-state
   5.131 +                (run-moves (second new-script)
   5.132 +                           (repeat 400 []))
   5.133 +
   5.134 +                result (search-string (memory future-state)
   5.135 +                                      "Critical")]
   5.136 +            (if result
   5.137 +              (println "critical hit with" blanks "blank frames"))
   5.138 +            result) 
   5.139 +        new-script
   5.140 +        (recur (inc blanks))))))  
   5.141 +
   5.142 +(defn move-thru-grass
   5.143 +  [direction script]
   5.144 +  (loop [blanks 0]
   5.145 +    (let [new-script
   5.146 +          (->> script
   5.147 +               (play-moves (repeat blanks []))
   5.148 +               (move direction))
   5.149 +
   5.150 +          future-state
   5.151 +          (run-moves (second new-script)
   5.152 +                     (repeat 600 []))
   5.153 +          
   5.154 +          result (search-string (memory future-state)
   5.155 +                                "Wild")]
   5.156 +      (if (nil? result)
   5.157 +        (do
   5.158 +          (if (< 0 blanks)
   5.159 +            (do
   5.160 +              (println "avoided pokemon with"
   5.161 +                       blanks "blank frames")))
   5.162 +             new-script)
   5.163 +        (recur (inc blanks))))))
   5.164 +
   5.165 +(defn walk-thru-grass
   5.166 +  [directions script]
   5.167 +  (reduce (fn [script direction]
   5.168 +            (move-thru-grass direction script))
   5.169 +          script directions))
   5.170 +
   5.171 +(defn slowly
   5.172 +  [delay moves script]
   5.173 +  (reduce
   5.174 +   (fn [script move]
   5.175 +     (->> script
   5.176 +          (do-nothing delay)
   5.177 +          (play-moves (vector move))))
   5.178 +   script moves))
   5.179 +
   5.180 +(defn multiple-times
   5.181 +  ([n command args script]
   5.182 +     (reduce (fn [script _]
   5.183 +               (apply command (concat args [script])))
   5.184 +             script
   5.185 +             (range n)))
   5.186 +  ([n command script]
   5.187 +     (multiple-times n command [] script)))