view clojure/com/aurellem/run/bootstrap_0.clj @ 279:aa9b8d9d5b76

script: save corruption
author Robert McIntyre <rlm@mit.edu>
date Tue, 27 Mar 2012 13:33:44 -0500
parents 7ecea582ec9d
children d5e5c73af7e6
line wrap: on
line source
1 (ns com.aurellem.run.bootstrap-0
2 (:use (com.aurellem.gb gb-driver vbm characters money))
3 (:use (com.aurellem.run title save-corruption))
4 (:use (com.aurellem.exp item-bridge))
5 (:import [com.aurellem.gb.gb_driver SaveState]))
7 (defn-memo boot-root []
8 [ [] (root)])
10 (defn-memo to-rival-name
11 ([] (to-rival-name (boot-root)))
12 ([script]
13 (-> script
14 title
15 oak
16 name-entry-rlm
17 scroll-text
18 scroll-text
19 scroll-text
20 scroll-text
21 scroll-text)))
23 (defn-memo name-rival-bootstrap
24 ([] (name-rival-bootstrap (to-rival-name)))
25 ([script]
26 (->> script
27 (advance [] [:a])
28 (advance [] [:r] DE)
29 (play-moves
30 [[]
31 [:r] [] [:r] [] [:r] [] [:r] []
32 [:r] [] [:r] [] [:r] [] [:d] []
33 [:d] [:a] ;; space
34 [:l] [] [:d] [:a] ;; [PK]
35 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
36 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
37 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
38 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
40 [:d] [] [:r] [:a] ;; finish
41 ]))))
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))
50 (def ↑ [:u])
51 (def ↓ [:d])
52 (def ← [:l])
53 (def → [:r])
55 (defn-memo leave-house
56 ([] (leave-house (name-rival-bootstrap)))
57 ([script]
58 (->> script
59 finish-title
60 start-walking
61 walk-to-stairs
62 walk-to-door
63 (walk [↓ ↓]))))
65 (defn-memo to-pallet-town-edge
66 ([] (to-pallet-town-edge (leave-house)))
67 ([script]
68 (->> script
69 start-walking
70 (walk [→ → → → →
71 ↑ ↑ ↑ ↑ ↑ ↑]))))
73 (defn end-text [script]
74 (->> script
75 (scroll-text)
76 (play-moves [[] [:a]])))
78 (defn-memo start-pikachu-battle
79 ([] (start-pikachu-battle
80 (to-pallet-town-edge)))
81 ([script]
82 (->> script
83 (advance [:b] [:b :a] DE)
84 (scroll-text)
85 (play-moves [[:b]])
86 (scroll-text)
87 (end-text) ;; battle begins
88 (scroll-text))))
90 (defn-memo capture-pikachu
91 ([] (capture-pikachu (start-pikachu-battle)))
92 ([script]
93 (->> script
94 (scroll-text 2)
95 (end-text))))
97 (defn-memo go-to-lab
98 ([] (go-to-lab (capture-pikachu)))
99 ([script]
100 (->> script
101 (scroll-text 5)
102 (end-text)
103 (scroll-text)
104 (end-text)
105 (scroll-text 8)
106 (end-text)
107 (scroll-text)
108 (end-text))))
110 (defn-memo obtain-pikachu
111 ([] (obtain-pikachu (go-to-lab)))
112 ([script]
113 (->> script
114 (scroll-text)
115 (play-moves
116 (concat
117 (repeat 51 [])
118 [[:a] []]))
119 (walk [↓ ↓ → → ↑])
120 (play-moves
121 (concat [[] [:a]]
122 (repeat 100 [])))
123 (scroll-text 9)
124 (end-text)
125 (scroll-text 7)
127 (play-moves
128 (concat
129 (repeat 42 [])
130 [[:b] [:b] [:b] [:b]])))))
132 (defn-memo begin-battle-with-rival
133 ([] (begin-battle-with-rival
134 (obtain-pikachu)))
135 ([script]
136 (->> script
137 (walk [↓ ↓ ↓ ↓])
138 (scroll-text 3)
139 (end-text)
140 (scroll-text))))
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)))))))
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 []))
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))))))
181 (defn-memo battle-with-rival
182 ([] (battle-with-rival
183 (begin-battle-with-rival)))
184 ([script]
185 (->> script
186 (play-moves (repeat 381 []))
187 (play-moves [[:a]])
188 (critical-hit)
189 (play-moves (repeat 100 []))
190 (scroll-text)
191 (play-moves
192 (concat (repeat 275 []) [[:a]]))
193 (critical-hit)
194 (play-moves (repeat 100 []))
195 (scroll-text)
196 (play-moves
197 (concat (repeat 270 []) [[:a]]))
198 (play-moves [[][][][][][][][][:a]]))))
200 (defn-memo finish-rival-text
201 ([] (finish-rival-text
202 (battle-with-rival)))
203 ([script]
204 (->> script
205 (scroll-text 2)
206 (end-text)
207 (scroll-text 9)
208 (end-text))))
210 (defn do-nothing [n script]
211 (->> script
212 (play-moves
213 (repeat n []))))
215 (defn-memo pikachu-comes-out
216 ([] (pikachu-comes-out
217 (finish-rival-text)))
218 ([script]
219 (->> script
220 (do-nothing 177)
221 (end-text)
222 (scroll-text 7)
223 (end-text))))
225 (defn-memo leave-oaks-lab
226 ([] (leave-oaks-lab
227 (pikachu-comes-out)))
228 ([script]
229 (->> script
230 (walk [← ← ↓ ↓ ↓ ↓ ↓ ↓]))))
232 (defn-memo oaks-lab->pallet-town-edge
233 ([] (oaks-lab->pallet-town-edge
234 (leave-oaks-lab)))
235 ([script]
236 (->> script
237 (walk [← ← ← ←
238 ↑ ↑ ↑ ↑
239 ↑ ↑ ↑ ↑ ↑ ↑
240 → ↑]))))
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))
250 future-state
251 (run-moves (second new-script)
252 (repeat 600 []))
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))))))
263 (defn walk-thru-grass
264 [directions script]
265 (reduce (fn [script direction]
266 (move-thru-grass direction script))
267 script directions))
269 (defn-memo pallet-edge->viridian-mart
270 ([] (pallet-edge->viridian-mart true
271 (oaks-lab->pallet-town-edge)))
272 ([dodge-stupid-guy? script]
273 (let [dodge-1 (if dodge-stupid-guy?
274 [→ →]
275 [→])
276 dodge-2 (if dodge-stupid-guy?
277 [↑ ↑ ←]
278 [↑ ↑ ←])]
280 (->> script
281 ;; leave straight grass
282 (walk-thru-grass
283 [↑ ↑ ↑ ↑ ↑])
285 (walk [↑ ↑ ↑ ↑])
287 (walk-thru-grass
288 [← ← ↑])
289 (walk [↑ ↑ ↑ ↑ → → → ])
291 (walk-thru-grass
292 [→ ↑ ↑ ←])
294 (walk
295 [← ←
296 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
297 → → → → ])
299 ;; this part is dependent on that
300 ;; stupid NPC in the grass patch
301 (walk-thru-grass
302 (concat dodge-1
303 [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ]))
305 (walk
306 (concat
307 dodge-2
308 [← ← ←
309 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
310 ← ←
311 ↑ ↑ ↑ ↑
312 → → → → → → → → → →
313 ↑ ↑ ↑ ↑ ↑ ↑ ↑]))))))
315 (defn-memo get-oaks-parcel
316 ([] (get-oaks-parcel
317 (pallet-edge->viridian-mart)))
318 ([script]
319 (->> script
320 (end-text)
321 (scroll-text 3)
322 (do-nothing 197)
323 (play-moves [[:a] []])
324 (walk [↓ ↓ → ↓]))))
326 (defn-memo viridian-store->oaks-lab
327 ([] (viridian-store->oaks-lab
328 (get-oaks-parcel)))
329 ([script]
330 (->> script
331 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
332 ← ← ← ← ← ← ← ← ← ←
333 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
334 ← ←
335 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
336 ↓ ↓ ↓ ↓ ↓ ↓ ↓
337 → → → → → → → →
338 ↓ ↓ ↓ ↓
339 ← ← ← ← ←
340 ↓ ↓ ↓ ↓])
342 (walk-thru-grass
343 [↓ ↓ ↓ ↓ ↓ ↓ ↓])
345 (walk [↓ ↓ ← ↓ ↓ ↓ ←
346 ↓ ↓ ↓ ↓ ↓
347 → → → ↑]))))
349 (defn-memo viridian-store->oaks-lab-like-a-boss
350 ([] (viridian-store->oaks-lab-like-a-boss
351 (get-oaks-parcel)))
352 ([script]
353 (->> script
354 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
355 ← ← ← ← ← ← ← ← ← ←
356 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])
358 (walk-thru-grass
359 [↓ ↓ ↓ ↓ ↓])
361 (walk
362 [↓ ↓ ← ↓
363 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
364 → →])
366 (walk-thru-grass
367 [→ ↓ ↓ ↓])
369 (walk [↓ ← ← ↓ ↓ ↓ ↓ ↓ ↓])
371 (walk-thru-grass
372 [↓ ↓ ↓ ↓ ↓ ↓ ↓])
374 (walk [↓ ↓ ← ↓ ↓ ↓ ←
375 ↓ ↓ ↓ ↓ ↓
376 → → → ↑]))))
378 (defn-memo deliver-oaks-parcel
379 ([] (deliver-oaks-parcel
380 (viridian-store->oaks-lab-like-a-boss)))
381 ([script]
382 (->> script
383 (walk [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
384 (play-moves [[:a]])
385 (scroll-text 11)
386 (end-text)
387 (end-text)
388 (do-nothing 200)
389 (end-text)
390 (scroll-text 3)
391 (end-text)
392 (scroll-text 2)
393 (end-text)
394 (scroll-text 5)
395 (end-text)
396 (scroll-text 2)
397 (end-text)
398 (scroll-text 9)
399 (end-text)
400 (scroll-text 7)
401 (end-text)
402 (walk [← ← ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓]))))
404 (defn-memo return-to-viridian-mart
405 ([] (return-to-viridian-mart
406 (deliver-oaks-parcel)))
407 ([script]
408 (->> script
409 oaks-lab->pallet-town-edge
410 (pallet-edge->viridian-mart false))))
412 (defn-memo walk-to-counter
413 ([] (walk-to-counter
414 (return-to-viridian-mart)))
415 ([script]
416 (->> script
417 (walk [↑ ↑ ← ←]))))
419 (defn buy-item
420 "Assumes that the main item-screen is up, and buys
421 quantity of the nth item in the list, assuming that you
422 have enough money."
423 [n quantity script]
424 (if (= 0 quantity)
425 script
426 (let [after-initial-pause
427 (do-nothing 20 script)
428 move-to-item
429 (reduce (fn [script _]
430 (->> script
431 (play-moves [[:d]])
432 (do-nothing 3)))
433 after-initial-pause
434 (range n))
435 select-item
436 (play-moves [[:a]] move-to-item)
437 request-items
438 (reduce (fn [script _]
439 (->> script
440 (play-moves [[:u]])
441 (do-nothing 1)))
442 select-item
443 (range (dec quantity)))
444 buy-items
445 (->> request-items
446 (do-nothing 3)
447 (play-moves [[:a]])
448 (scroll-text)
449 (scroll-text)
450 (play-moves [[:a]])
451 (scroll-text))]
452 buy-items)))
455 (defn buy-items
456 "Given a list of [item-no quantity], buys the quantity
457 from the shop's list. Assumes that the item list is
458 already up."
459 [item-pairs script]
460 (let [item-lookup (into {0 0 1 0 2 0 3 0 4 0} item-pairs)
461 initial-purchase
462 (->> script
463 (buy-item 0 (item-lookup 0))
464 (buy-item 1 (item-lookup 1))
465 (buy-item 2 (item-lookup 2)))]
466 (cond
467 (and
468 (not= 0 (item-lookup 3))
469 (not= 0 (item-lookup 4)))
470 (->> initial-purchase
471 (do-nothing 20)
472 (play-moves [[:d]])
473 (do-nothing 3)
474 (play-moves [[:d]])
475 (do-nothing 3)
476 (play-moves [[:d]])
477 (do-nothing 10)
478 (buy-item 0 (item-lookup 3))
479 (do-nothing 20)
480 (play-moves [[:d]])
481 (do-nothing 3)
482 (play-moves [[:d]])
483 (do-nothing 3)
484 (play-moves [[:d]])
485 (do-nothing 10)
486 (buy-item 0 (item-lookup 4)))
487 (and (= 0 (item-lookup 3))
488 (not= 0 (item-lookup 4)))
489 (->> initial-purchase
490 (do-nothing 20)
491 (play-moves [[:d]])
492 (do-nothing 3)
493 (play-moves [[:d]])
494 (do-nothing 3)
495 (play-moves [[:d]])
496 (do-nothing 10)
497 (play-moves [[:d]])
498 (do-nothing 10)
499 (buy-item 0 (item-lookup 4)))
500 (and (not= 0 (item-lookup 3))
501 (= 0 (item-lookup 4)))
502 (->> initial-purchase
503 (do-nothing 20)
504 (play-moves [[:d]])
505 (do-nothing 3)
506 (play-moves [[:d]])
507 (do-nothing 3)
508 (play-moves [[:d]])
509 (do-nothing 10)
510 (buy-item 0 (item-lookup 3))))))
513 (defn test-buy-items
514 ([] (test-buy-items
515 (walk-to-counter)))
516 ([script]
517 (->> [(first script) (set-money (second script)
518 999999)]
519 (play-moves
520 [[] [:a] []])
521 (scroll-text)
522 (do-nothing 100)
523 (play-moves [[:a]])
524 (do-nothing 100)
525 (buy-items
526 [[0 1]
527 [1 15]
528 [2 1]
529 [3 20]
530 [4 95]
531 ]))))
533 (defn-memo buy-initial-items
534 ([] (buy-initial-items
535 (walk-to-counter)))
536 ([script]
537 (->> script
538 (play-moves
539 [[] [:a] []])
540 (scroll-text)
541 (do-nothing 100)
542 (play-moves [[:a]])
543 (do-nothing 100)
544 (buy-items
545 [[0 1]
546 [1 1]
547 [2 1]
548 [3 1]
549 [4 1]])
550 (do-nothing 100)
551 (play-moves [[:b]])
552 (do-nothing 100)
553 (play-moves [[:b]])
554 (do-nothing 100)
555 (play-moves [[:b] []]))))
558 (defn do-save-corruption
559 ([] (do-save-corruption
560 (buy-initial-items)))
561 ([script]
562 (->> script
563 (do-nothing 100)
565 (play-moves
566 [[:start]])
567 (do-nothing 500)
568 (play-moves [[:d]])
569 (do-nothing 100)
571 (play-moves
572 [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
573 [][] [] [] [] [] [] [] [] [] [] [] [] [] []
574 [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:d] [] [] [] [:d]
575 [] [] [:a] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b]
576 [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b]
577 [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b]
578 [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b]
579 [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b]
580 [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b]
581 [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b]
582 [:a :b] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
583 [] [] [] [] [] [] [] [] [] [] [] [] [] [:select] [:restart]
584 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
585 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
586 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
587 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
588 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
589 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
590 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
591 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
592 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
593 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
594 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
595 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
596 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
597 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
598 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
599 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
600 [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
601 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
602 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
603 [] [] [] [:start] [] [] [] [] [] [] [] [] [] [] [] [] [] []
604 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
605 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
606 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
607 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
608 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
609 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
610 [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] []
611 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
612 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
613 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
614 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
615 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
616 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
617 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
618 [:start] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
619 [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
620 [] [] [] [] [] [] [] [] [] [] [] [] [] [:start] [:a] [:a]
621 [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a]
622 [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a]
623 [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a]
624 [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a]
625 [:a] [:a :start] []]))))