Mercurial > vba-clojure

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
305:7998b1cf18cf 313:8e63b0bb8ea3
26 (->> script 26 (->> script
27 (advance [] [:a]) 27 (advance [] [:a])
28 (advance [] [:r] DE) 28 (advance [] [:r] DE)
29 (play-moves 29 (play-moves
30 [[] 30 [[]
31 [:r] [] [:r] [] [:r] [] [:r] [] 31 [] [] [:r] [] [:d] [:a] ;; L
32 [:r] [] [:r] [] [:r] [] [:d] [] 32 [:r] [] [:r] [] [:r] [] [:r] []
33 [:d] [:a] ;; space 33 [:r] [] [:d] [] [:d] [:a] ;; [PK]
34 [:l] [] [:d] [:a] ;; [PK] 34 [:u] [] [:l] [] [:l] []
35 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G 35 [:l] [] [:l] [] [:l] [:a] ;; U
36 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK] 36 [:r] [] [:r] [] [:r] []
37 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G 37 [:r] [] [:r] [] [:d] [:a] ;; [PK]
38 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK] 38 [] [:a] ;; [PK]
39 39 [] [:a] ;; [PK]
40 [:d] [] [:r] [:a] ;; finish 40 [:r] [] [:d] [:a] ;; END
41 ])))) 41 ]))))
42
43 (defn walk
44 "Move the character along the given directions."
45 [directions script]
46 (reduce (fn [script direction]
47 (move direction script))
48 script directions))
49
50 (def ↑ [:u])
51 (def ↓ [:d])
52 (def ← [:l])
53 (def → [:r])
54 42
55 (defn-memo leave-house 43 (defn-memo leave-house
56 ([] (leave-house (name-rival-bootstrap))) 44 ([] (leave-house (name-rival-bootstrap)))
57 ([script] 45 ([script]
58 (->> script 46 (->> script
67 ([script] 55 ([script]
68 (->> script 56 (->> script
69 start-walking 57 start-walking
70 (walk [→ → → → → 58 (walk [→ → → → →
71 ↑ ↑ ↑ ↑ ↑ ↑])))) 59 ↑ ↑ ↑ ↑ ↑ ↑]))))
72
73 (defn end-text [script]
74 (->> script
75 (scroll-text)
76 (play-moves [[] [:a]])))
77 60
78 (defn-memo start-pikachu-battle 61 (defn-memo start-pikachu-battle
79 ([] (start-pikachu-battle 62 ([] (start-pikachu-battle
80 (to-pallet-town-edge))) 63 (to-pallet-town-edge)))
81 ([script] 64 ([script]
124 (end-text) 107 (end-text)
125 (scroll-text 7) 108 (scroll-text 7)
126 109
127 (play-moves 110 (play-moves
128 (concat 111 (concat
129 (repeat 42 []) 112 (repeat 50 [])
130 [[:b] [:b] [:b] [:b]]))))) 113 [[:b] [] []])))))
131 114
132 (defn-memo begin-battle-with-rival 115 (defn-memo begin-battle-with-rival
133 ([] (begin-battle-with-rival 116 ([] (begin-battle-with-rival
134 (obtain-pikachu))) 117 (obtain-pikachu)))
135 ([script] 118 ([script]
137 (walk [↓ ↓ ↓ ↓]) 120 (walk [↓ ↓ ↓ ↓])
138 (scroll-text 3) 121 (scroll-text 3)
139 (end-text) 122 (end-text)
140 (scroll-text)))) 123 (scroll-text))))
141 124
142 (defn search-string
143 [array string]
144 (let [codes
145 (str->character-codes string)
146 codes-length (count codes)
147 mem (vec array)
148 mem-length (count mem)]
149 (loop [idx 0]
150 (if (< (- mem-length idx) codes-length)
151 nil
152 (if (= (subvec mem idx (+ idx codes-length))
153 codes)
154 idx
155 (recur (inc idx)))))))
156
157 (defn critical-hit
158 "Put the cursor over the desired attack. This program will
159 determine the appropriate amount of blank frames to
160 insert before pressing [:a] to ensure that the attack is
161 a critical hit."
162 [script]
163 (loop [blanks 6]
164 (let [new-script
165 (->> script
166 (play-moves
167 (concat (repeat blanks [])
168 [[:a][]])))]
169 (if (let [future-state
170 (run-moves (second new-script)
171 (repeat 400 []))
172
173 result (search-string (memory future-state)
174 "Critical")]
175 (if result
176 (println "critical hit with" blanks "blank frames"))
177 result)
178 new-script
179 (recur (inc blanks))))))
180
181 (defn-memo battle-with-rival 125 (defn-memo battle-with-rival
182 ([] (battle-with-rival 126 ([] (battle-with-rival
183 (begin-battle-with-rival))) 127 (begin-battle-with-rival)))
184 ([script] 128 ([script]
185 (->> script 129 (->> script
186 (play-moves (repeat 381 [])) 130 (do-nothing 400)
187 (play-moves [[:a]]) 131 (play-moves [[:a]])
188 (critical-hit) 132 (critical-hit)
189 (play-moves (repeat 100 [])) 133 (do-nothing 100)
190 (scroll-text) 134 (scroll-text)
191 (play-moves 135 (do-nothing 275)
192 (concat (repeat 275 []) [[:a]])) 136 (play-moves [[:a]])
193 (critical-hit) 137 (critical-hit)
194 (play-moves (repeat 100 [])) 138 (do-nothing 100)
195 (scroll-text) 139 (scroll-text)
196 (play-moves 140 (do-nothing 270)
197 (concat (repeat 270 []) [[:a]])) 141 (play-moves [[:a]])
198 (play-moves [[][][][][][][][][:a]])))) 142 (critical-hit)
143 (do-nothing 100)
144 (scroll-text))))
199 145
200 (defn-memo finish-rival-text 146 (defn-memo finish-rival-text
201 ([] (finish-rival-text 147 ([] (finish-rival-text
202 (battle-with-rival))) 148 (battle-with-rival)))
203 ([script] 149 ([script]
204 (->> script 150 (->> script
205 (scroll-text 2) 151 (scroll-text 2)
206 (end-text) 152 (end-text)
207 (scroll-text 9) 153 (scroll-text 9)
208 (end-text)))) 154 (end-text))))
209
210 (defn do-nothing [n script]
211 (->> script
212 (play-moves
213 (repeat n []))))
214 155
215 (defn-memo pikachu-comes-out 156 (defn-memo pikachu-comes-out
216 ([] (pikachu-comes-out 157 ([] (pikachu-comes-out
217 (finish-rival-text))) 158 (finish-rival-text)))
218 ([script] 159 ([script]
236 (->> script 177 (->> script
237 (walk [← ← ← ← 178 (walk [← ← ← ←
238 ↑ ↑ ↑ ↑ 179 ↑ ↑ ↑ ↑
239 ↑ ↑ ↑ ↑ ↑ ↑ 180 ↑ ↑ ↑ ↑ ↑ ↑
240 → ↑])))) 181 → ↑]))))
241
242 (defn move-thru-grass
243 [direction script]
244 (loop [blanks 0]
245 (let [new-script
246 (->> script
247 (play-moves (repeat blanks []))
248 (move direction))
249
250 future-state
251 (run-moves (second new-script)
252 (repeat 600 []))
253
254 result (search-string (memory future-state)
255 "Wild")]
256 (if (nil? result)
257 (do
258 (if (< 0 blanks)
259 (do(println "avoided pokemon with" blanks "blank frames")))
260 new-script)
261 (recur (inc blanks))))))
262
263 (defn walk-thru-grass
264 [directions script]
265 (reduce (fn [script direction]
266 (move-thru-grass direction script))
267 script directions))
268 182
269 (defn-memo pallet-edge->viridian-mart 183 (defn-memo pallet-edge->viridian-mart
270 ([] (pallet-edge->viridian-mart true 184 ([] (pallet-edge->viridian-mart true
271 (oaks-lab->pallet-town-edge))) 185 (oaks-lab->pallet-town-edge)))
272 ([dodge-stupid-guy? script] 186 ([dodge-stupid-guy? script]
279 193
280 (->> script 194 (->> script
281 ;; leave straight grass 195 ;; leave straight grass
282 (walk-thru-grass 196 (walk-thru-grass
283 [↑ ↑ ↑ ↑ ↑]) 197 [↑ ↑ ↑ ↑ ↑])
284 198
285 (walk [↑ ↑ ↑ ↑]) 199 (walk [↑ ↑ ↑ ↑])
286 200
287 (walk-thru-grass 201 (walk-thru-grass
288 [← ← ↑]) 202 [← ← ↑])
203
289 (walk [↑ ↑ ↑ ↑ → → → ]) 204 (walk [↑ ↑ ↑ ↑ → → → ])
290 205
291 (walk-thru-grass 206 (walk-thru-grass
292 [→ ↑ ↑ ←]) 207 [→ ↑ ↑ ←])
293 208
581 (title) 496 (title)
582 (advance [] [:start]) 497 (advance [] [:start])
583 (advance [] [:a]) 498 (advance [] [:a])
584 (advance [:a] [:a :start])))) 499 (advance [:a] [:a :start]))))
585 500
586 (def menu walk)
587
588 (defn-memo corrupt-item-list 501 (defn-memo corrupt-item-list
589 ([] (corrupt-item-list 502 ([] (corrupt-item-list
590 (do-save-corruption))) 503 (do-save-corruption)))
591 ([script] 504 ([script]
592 (->> script 505 (->> script
596 (menu [↓ ↓ ↓ ↓ ↓ ↓ ; go to 6th pokemon 509 (menu [↓ ↓ ↓ ↓ ↓ ↓ ; go to 6th pokemon
597 [:a] ↓ [:a] ; select "switch" 510 [:a] ↓ [:a] ; select "switch"
598 ↓ ↓ ↓ [:a]]) ; switch with 9th "pokemon" 511 ↓ ↓ ↓ [:a]]) ; switch with 9th "pokemon"
599 512
600 (do-nothing 1)))) 513 (do-nothing 1))))
601
602
603 (defn slowly
604 [delay moves script]
605 (reduce
606 (fn [script move]
607 (->> script
608 (do-nothing delay)
609 (play-moves (vector move))))
610 script moves))
611 514
612 (defn-memo get-burn-heals 515 (defn-memo get-burn-heals
613 ([] (get-burn-heals 516 ([] (get-burn-heals
614 (corrupt-item-list))) 517 (corrupt-item-list)))
615 ([script] 518 ([script]
647 [3 1] 550 [3 1]
648 [4 97]]) 551 [4 97]])
649 552
650 (do-nothing 10)))) 553 (do-nothing 10))))
651 554
652 (defn save-game-properly
653 [number-down script]
654 (->>
655 (reduce (fn [script _]
656 (->> script
657 (advance [] [:d])))
658 script
659 (range number-down))
660 (play-moves [[] [] [:a]])
661 (scroll-text)
662 (do-nothing 300)))
663
664 (defn-memo corrupt-item-list-again 555 (defn-memo corrupt-item-list-again
665 ([] (corrupt-item-list-again (get-burn-heals))) 556 ([] (corrupt-item-list-again (get-burn-heals)))
666 ([script] 557 ([script]
667 (->> script 558 (->> script
668 (do-nothing 10) 559 (do-nothing 10)
676 [:a] ↓ [:a] ; and corrupt the 567 [:a] ↓ [:a] ; and corrupt the
677 ↓ ↓ ↓ ↓ ↓ [:a]]) ; item list again by 568 ↓ ↓ ↓ ↓ ↓ [:a]]) ; item list again by
678 ; switching it to 569 ; switching it to
679 ))) ; tenth place. 570 ))) ; tenth place.
680 571
681
682
683 (defn-memo viridian-store->viridian-poke-center 572 (defn-memo viridian-store->viridian-poke-center
684 ([] (viridian-store->viridian-poke-center 573 ([] (viridian-store->viridian-poke-center
685 (corrupt-item-list-again))) 574 (corrupt-item-list-again)))
686 ([script] 575 ([script]
687 (->> script 576 (->> script
720 (scroll-text 2) 609 (scroll-text 2)
721 610
722 ;; begin deposit 611 ;; begin deposit
723 (menu [[:d] [:a]]) 612 (menu [[:d] [:a]])
724 (do-nothing 40)))) 613 (do-nothing 40))))
725
726
727 (defn multiple-times
728 ([n command args script]
729 (reduce (fn [script _]
730 (apply command (concat args [script])))
731 script
732 (range n)))
733 ([n command script]
734 (multiple-times n command [] script)))
735 614
736 (defn deposit-n-items 615 (defn deposit-n-items
737 [n script] 616 [n script]
738 (->> script 617 (->> script
739 (do-nothing 100) 618 (do-nothing 100)