diff clojure/com/aurellem/run/bootstrap_0.clj @ 313:8e63b0bb8ea3

major refactoring; made (walk) more robust
author Robert McIntyre <rlm@mit.edu>
date Mon, 02 Apr 2012 10:58:16 -0500
parents 7998b1cf18cf
children 92c47a9cdaea
line wrap: on
line diff
     1.1 --- a/clojure/com/aurellem/run/bootstrap_0.clj	Sat Mar 31 00:41:28 2012 -0500
     1.2 +++ b/clojure/com/aurellem/run/bootstrap_0.clj	Mon Apr 02 10:58:16 2012 -0500
     1.3 @@ -28,30 +28,18 @@
     1.4           (advance [] [:r] DE)
     1.5           (play-moves
     1.6            [[]
     1.7 -           [:r] [] [:r] [] [:r] [] [:r] []
     1.8 -           [:r] [] [:r] [] [:r] [] [:d] []
     1.9 -           [:d] [:a]                         ;; space
    1.10 -           [:l] [] [:d] [:a]                 ;; [PK]
    1.11 -           [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
    1.12 -           [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
    1.13 -           [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
    1.14 -           [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
    1.15 -
    1.16 -           [:d] [] [:r] [:a]                 ;; finish
    1.17 +           [] [] [:r] [] [:d] [:a]           ;; L
    1.18 +           [:r] [] [:r] [] [:r] [] [:r] [] 
    1.19 +           [:r] [] [:d] [] [:d] [:a]         ;; [PK]
    1.20 +           [:u] [] [:l] [] [:l] []
    1.21 +           [:l] [] [:l] [] [:l] [:a]         ;; U
    1.22 +           [:r] [] [:r] [] [:r] []
    1.23 +           [:r] [] [:r] [] [:d] [:a]         ;; [PK]
    1.24 +           [] [:a]                           ;; [PK]
    1.25 +           [] [:a]                           ;; [PK]
    1.26 +           [:r] [] [:d] [:a]                 ;; END
    1.27             ]))))
    1.28  
    1.29 -(defn walk
    1.30 -  "Move the character along the given directions."
    1.31 -  [directions script]
    1.32 -  (reduce (fn [script direction]
    1.33 -            (move direction script))
    1.34 -          script directions))
    1.35 -
    1.36 -(def ↑ [:u])
    1.37 -(def ↓ [:d])
    1.38 -(def ← [:l])
    1.39 -(def → [:r])
    1.40 -
    1.41  (defn-memo leave-house
    1.42    ([] (leave-house (name-rival-bootstrap)))
    1.43    ([script]
    1.44 @@ -70,11 +58,6 @@
    1.45            (walk [→ → → → →
    1.46                   ↑ ↑ ↑ ↑ ↑ ↑]))))
    1.47  
    1.48 -(defn end-text [script]
    1.49 -  (->> script
    1.50 -       (scroll-text)
    1.51 -       (play-moves [[] [:a]])))
    1.52 -
    1.53  (defn-memo start-pikachu-battle
    1.54    ([] (start-pikachu-battle
    1.55         (to-pallet-town-edge)))
    1.56 @@ -126,8 +109,8 @@
    1.57  
    1.58            (play-moves
    1.59             (concat
    1.60 -            (repeat 42 [])
    1.61 -                   [[:b] [:b] [:b] [:b]])))))
    1.62 +            (repeat 50 [])
    1.63 +                   [[:b] [] []])))))
    1.64  
    1.65  (defn-memo begin-battle-with-rival
    1.66    ([] (begin-battle-with-rival
    1.67 @@ -139,63 +122,26 @@
    1.68            (end-text)
    1.69            (scroll-text))))
    1.70  
    1.71 -(defn search-string
    1.72 -  [array string]
    1.73 -  (let [codes
    1.74 -        (str->character-codes string)
    1.75 -        codes-length (count codes)
    1.76 -        mem (vec array)
    1.77 -        mem-length (count mem)]
    1.78 -    (loop [idx 0]
    1.79 -      (if (< (- mem-length idx) codes-length)
    1.80 -        nil
    1.81 -        (if (= (subvec mem idx (+ idx codes-length))
    1.82 -               codes)
    1.83 -          idx
    1.84 -          (recur (inc idx)))))))
    1.85 -        
    1.86 -(defn critical-hit
    1.87 -  "Put the cursor over the desired attack. This program will
    1.88 -   determine the appropriate amount of blank frames to
    1.89 -   insert before pressing [:a] to ensure that the attack is
    1.90 -   a critical hit."
    1.91 -  [script]
    1.92 -  (loop [blanks 6]
    1.93 -    (let [new-script
    1.94 -          (->> script
    1.95 -               (play-moves
    1.96 -                (concat (repeat blanks [])
    1.97 -                        [[:a][]])))]
    1.98 -      (if (let [future-state
    1.99 -                (run-moves (second new-script)
   1.100 -                           (repeat 400 []))
   1.101 -
   1.102 -                result (search-string (memory future-state)
   1.103 -                                      "Critical")]
   1.104 -            (if result
   1.105 -              (println "critical hit with" blanks "blank frames"))
   1.106 -            result) 
   1.107 -        new-script
   1.108 -        (recur (inc blanks))))))  
   1.109 -
   1.110  (defn-memo battle-with-rival
   1.111    ([] (battle-with-rival
   1.112          (begin-battle-with-rival)))
   1.113    ([script]
   1.114       (->> script
   1.115 -          (play-moves (repeat 381 []))
   1.116 +          (do-nothing 400)
   1.117            (play-moves [[:a]])
   1.118            (critical-hit)
   1.119 -          (play-moves (repeat 100 []))
   1.120 +          (do-nothing 100)
   1.121            (scroll-text)
   1.122 -          (play-moves
   1.123 -           (concat (repeat 275 []) [[:a]]))
   1.124 +          (do-nothing 275)
   1.125 +          (play-moves [[:a]])
   1.126            (critical-hit)
   1.127 -          (play-moves (repeat 100 []))
   1.128 +          (do-nothing 100)
   1.129            (scroll-text)
   1.130 -          (play-moves
   1.131 -           (concat (repeat 270 []) [[:a]]))
   1.132 -          (play-moves [[][][][][][][][][:a]]))))
   1.133 +          (do-nothing 270)
   1.134 +          (play-moves [[:a]])
   1.135 +          (critical-hit)
   1.136 +          (do-nothing 100)
   1.137 +          (scroll-text))))
   1.138  
   1.139  (defn-memo finish-rival-text
   1.140    ([] (finish-rival-text
   1.141 @@ -207,11 +153,6 @@
   1.142            (scroll-text 9)
   1.143            (end-text))))
   1.144  
   1.145 -(defn do-nothing [n script]
   1.146 -  (->> script
   1.147 -       (play-moves
   1.148 -        (repeat n []))))
   1.149 -
   1.150  (defn-memo pikachu-comes-out
   1.151    ([] (pikachu-comes-out
   1.152         (finish-rival-text)))
   1.153 @@ -239,33 +180,6 @@
   1.154                   ↑ ↑ ↑ ↑ ↑ ↑
   1.155                   → ↑]))))
   1.156  
   1.157 -(defn move-thru-grass
   1.158 -  [direction script]
   1.159 -  (loop [blanks 0]
   1.160 -    (let [new-script
   1.161 -          (->> script
   1.162 -               (play-moves (repeat blanks []))
   1.163 -               (move direction))
   1.164 -
   1.165 -          future-state
   1.166 -          (run-moves (second new-script)
   1.167 -                     (repeat 600 []))
   1.168 -          
   1.169 -          result (search-string (memory future-state)
   1.170 -                                "Wild")]
   1.171 -      (if (nil? result)
   1.172 -        (do
   1.173 -          (if (< 0 blanks)
   1.174 -            (do(println "avoided pokemon with" blanks "blank frames")))
   1.175 -             new-script)
   1.176 -        (recur (inc blanks))))))
   1.177 -
   1.178 -(defn walk-thru-grass
   1.179 -  [directions script]
   1.180 -  (reduce (fn [script direction]
   1.181 -            (move-thru-grass direction script))
   1.182 -          script directions))
   1.183 -
   1.184  (defn-memo pallet-edge->viridian-mart
   1.185    ([] (pallet-edge->viridian-mart true
   1.186         (oaks-lab->pallet-town-edge)))
   1.187 @@ -281,11 +195,12 @@
   1.188            ;; leave straight grass
   1.189            (walk-thru-grass
   1.190             [↑ ↑ ↑ ↑ ↑])
   1.191 -          
   1.192 +
   1.193            (walk [↑ ↑ ↑ ↑])
   1.194 -          
   1.195 +
   1.196            (walk-thru-grass
   1.197             [← ← ↑])
   1.198 +
   1.199            (walk [↑ ↑ ↑ ↑ → → → ])
   1.200  
   1.201            (walk-thru-grass
   1.202 @@ -583,8 +498,6 @@
   1.203            (advance [] [:a])
   1.204            (advance [:a] [:a :start]))))
   1.205  
   1.206 -(def menu walk)
   1.207 -
   1.208  (defn-memo corrupt-item-list
   1.209    ([] (corrupt-item-list
   1.210         (do-save-corruption)))
   1.211 @@ -598,16 +511,6 @@
   1.212                   ↓ ↓ ↓ [:a]])           ; switch with 9th "pokemon"
   1.213                   
   1.214            (do-nothing 1))))
   1.215 -
   1.216 -
   1.217 -(defn slowly
   1.218 -  [delay moves script]
   1.219 -  (reduce
   1.220 -   (fn [script move]
   1.221 -     (->> script
   1.222 -          (do-nothing delay)
   1.223 -          (play-moves (vector move))))
   1.224 -   script moves))
   1.225                       
   1.226  (defn-memo get-burn-heals
   1.227    ([] (get-burn-heals
   1.228 @@ -649,18 +552,6 @@
   1.229                        
   1.230            (do-nothing 10))))
   1.231  
   1.232 -(defn save-game-properly
   1.233 -  [number-down script]
   1.234 -  (->> 
   1.235 -   (reduce (fn [script _]
   1.236 -             (->> script
   1.237 -                  (advance [] [:d])))
   1.238 -           script
   1.239 -           (range number-down))
   1.240 -   (play-moves [[] [] [:a]])
   1.241 -   (scroll-text)
   1.242 -   (do-nothing 300)))
   1.243 -
   1.244  (defn-memo corrupt-item-list-again
   1.245    ([] (corrupt-item-list-again (get-burn-heals)))
   1.246    ([script]
   1.247 @@ -678,8 +569,6 @@
   1.248                                          ; switching it to
   1.249            )))                           ; tenth place.
   1.250            
   1.251 -          
   1.252 -
   1.253  (defn-memo viridian-store->viridian-poke-center
   1.254    ([] (viridian-store->viridian-poke-center
   1.255         (corrupt-item-list-again)))
   1.256 @@ -723,16 +612,6 @@
   1.257            (menu [[:d] [:a]])
   1.258            (do-nothing 40))))
   1.259  
   1.260 -
   1.261 -(defn multiple-times
   1.262 -  ([n command args script]
   1.263 -     (reduce (fn [script _]
   1.264 -               (apply command (concat args [script])))
   1.265 -             script
   1.266 -             (range n)))
   1.267 -  ([n command script]
   1.268 -     (multiple-times n command [] script)))
   1.269 -
   1.270  (defn deposit-n-items
   1.271    [n script]
   1.272    (->> script