Mercurial > vba-clojure
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