view clojure/com/aurellem/run/bootstrap_0.clj @ 293:4a0dbaed7078

preliminary idea for a better pre-bootstrapping program.
author Robert McIntyre <rlm@mit.edu>
date Fri, 30 Mar 2012 18:14:14 -0500
parents c8b0db518de3
children 659a9c84c785
line wrap: on
line source
1 (ns com.aurellem.run.bootstrap-0
2 (:use (com.aurellem.gb gb-driver util items 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 10)
447 (play-moves [[:a]])
448 (scroll-text)
449 (scroll-text)
450 (do-nothing 10)
451 (play-moves [[:a]])
452 (scroll-text))]
453 buy-items)))
456 (defn buy-items
457 "Given a list of [item-no quantity], buys the quantity
458 from the shop's list. Assumes that the item list is
459 already up."
460 [item-pairs script]
461 (let [item-lookup (into {0 0 1 0 2 0 3 0 4 0} item-pairs)
462 initial-purchase
463 (->> script
464 (buy-item 0 (item-lookup 0))
465 (buy-item 1 (item-lookup 1))
466 (buy-item 2 (item-lookup 2)))]
467 (cond
468 (and
469 (not= 0 (item-lookup 3))
470 (not= 0 (item-lookup 4)))
471 (->> initial-purchase
472 (do-nothing 20)
473 (play-moves [[:d]])
474 (do-nothing 3)
475 (play-moves [[:d]])
476 (do-nothing 3)
477 (play-moves [[:d]])
478 (do-nothing 10)
479 (buy-item 0 (item-lookup 3))
480 (do-nothing 20)
481 (play-moves [[:d]])
482 (do-nothing 3)
483 (play-moves [[:d]])
484 (do-nothing 3)
485 (play-moves [[:d]])
486 (do-nothing 10)
487 (buy-item 0 (item-lookup 4)))
488 (and (= 0 (item-lookup 3))
489 (not= 0 (item-lookup 4)))
490 (->> initial-purchase
491 (do-nothing 20)
492 (play-moves [[:d]])
493 (do-nothing 3)
494 (play-moves [[:d]])
495 (do-nothing 3)
496 (play-moves [[:d]])
497 (do-nothing 10)
498 (play-moves [[:d]])
499 (do-nothing 10)
500 (buy-item 0 (item-lookup 4)))
501 (and (not= 0 (item-lookup 3))
502 (= 0 (item-lookup 4)))
503 (->> initial-purchase
504 (do-nothing 20)
505 (play-moves [[:d]])
506 (do-nothing 3)
507 (play-moves [[:d]])
508 (do-nothing 3)
509 (play-moves [[:d]])
510 (do-nothing 10)
511 (buy-item 0 (item-lookup 3)))
512 (and (= 0 (item-lookup 3))
513 (= 0 (item-lookup 4)))
514 initial-purchase)))
517 (defn test-buy-items
518 ([] (test-buy-items
519 (walk-to-counter)))
520 ([script]
521 (->> [(first script) (set-money (second script)
522 999999)]
523 (play-moves
524 [[] [:a] []])
525 (scroll-text)
526 (do-nothing 100)
527 (play-moves [[:a]])
528 (do-nothing 100)
529 (buy-items
530 [[0 1]
531 [1 15]
532 [2 1]
533 [3 20]
534 [4 95]
535 ]))))
537 (defn-memo buy-initial-items
538 ([] (buy-initial-items
539 (walk-to-counter)))
540 ([script]
541 (->> script
542 (play-moves
543 [[] [:a] []])
544 (scroll-text)
545 (do-nothing 100)
546 (play-moves [[:a]])
547 (do-nothing 100)
548 (buy-items
549 [[0 1]
550 [1 1]
551 [2 1]
552 [3 1]
553 [4 1]])
554 (do-nothing 100)
555 (play-moves [[:b]])
556 (do-nothing 100)
557 (play-moves [[:b]])
558 (do-nothing 100)
559 (play-moves [[:b] []])
560 (advance [:b] [:b :start]))))
563 (defn-memo do-save-corruption
564 ([] (do-save-corruption
565 (buy-initial-items)))
566 ([script]
567 (->> script
568 (advance [] [:d])
569 (play-moves [[] [] [] [:d]
570 [] [] [] [:d]
571 [] [] [] [:d]
572 [] [] [:a]])
573 scroll-text
574 (play-moves
575 ;; this section is copied from speedrun-2942 and corrupts
576 ;; the save so that the total number of pokemon is set to
577 ;; 0xFF, allowing manipulation of non-pokemon data in RAM
578 ;; via the pokemon interface.
579 [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
580 [] [] [] [] [] [] [] [] [] [] [] [:select] [:restart]])
581 (title)
582 (advance [] [:start])
583 (advance [] [:a])
584 (advance [:a] [:a :start]))))
586 (def menu walk)
588 (defn-memo corrupt-item-list
589 ([] (corrupt-item-list
590 (do-save-corruption)))
591 ([script]
592 (->> script
593 (do-nothing 200)
594 (menu [↓ [:a]]) ; select "POKEMON" from
595 ; from main menu
596 (menu [↓ ↓ ↓ ↓ ↓ ↓ ; go to 6th pokemon
597 [:a] ↓ [:a] ; select "switch"
598 ↓ ↓ ↓ [:a]]) ; switch with 9th "pokemon"
600 (do-nothing 1))))
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))
612 (defn-memo get-burn-heals
613 ([] (get-burn-heals
614 (corrupt-item-list)))
615 ([script]
616 (->> script
617 (menu [[:b] [:b]])
618 (menu [[:a]])
619 (do-nothing 100)
620 (menu [↓ [:a]])
621 (do-nothing 100)
622 (menu [[:a] ↓ [:a]])
623 (scroll-text)
624 (menu [[:b][:b]])
625 (menu [[:a]])
627 (do-nothing 50)
628 (buy-items [[0 1]])
629 (do-nothing 60)
630 (menu [[:a]])
631 (scroll-text)
633 (do-nothing 50)
634 (buy-items [[0 1]])
635 (do-nothing 60)
636 ;;(menu [[:a]])
637 ;;(scroll-text)
639 ;;(do-nothing 300)
640 ;;(menu [[:b] [:b]])
641 ;;(do-nothing 300)
643 (buy-items [[0 1]
644 [1 1]
645 [1 1]
646 [2 1]
647 [3 1]
648 [4 97]])
650 (do-nothing 10))))
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)))
664 (defn-memo corrupt-item-list-again
665 ([] (corrupt-item-list-again (get-burn-heals)))
666 ([script]
667 (->> script
668 (do-nothing 10)
669 (play-moves [[:b]])
670 (do-nothing 100)
671 (play-moves [[:b]])
672 (do-nothing 40)
673 (play-moves [[:b]])
674 (advance [:b] [:start :b])
675 (menu [[:a] ↑ ↑ ↑ ↑ ↑ ; get fifth pokemon
676 [:a] ↓ [:a] ; and corrupt the
677 ↓ ↓ ↓ ↓ ↓ [:a]]) ; item list again by
678 ; switching it to
679 ))) ; tenth place.
683 (defn-memo viridian-store->viridian-poke-center
684 ([] (viridian-store->viridian-poke-center
685 (corrupt-item-list-again)))
686 ([script]
687 (->> script
688 (do-nothing 100)
689 (play-moves [[:b]])
690 (do-nothing 100)
691 (play-moves [[:b]])
692 (do-nothing 40)
693 ;; leave store
694 (walk [↓ ↓
695 → ↓ ↓])
696 (walk [← ← ← ←
697 ↓ ↓ ↓ ↓ ↓ ↓
698 ← ← ← ↑]))))
700 (defn-memo to-poke-center-computer
701 ([] (to-poke-center-computer
702 (viridian-store->viridian-poke-center)))
703 ([script]
704 (->> script
705 (walk [→ →
706 ↑ ↑ ↑
707 → → → → → → → → → ↑])
708 (do-nothing 1))))
710 (defn-memo begin-deposits
711 ([] (begin-deposits
712 (to-poke-center-computer)))
713 ([script]
714 (->> script
715 ;; access PC
716 (scroll-text 2)
718 ;; access item storage
719 (menu [[:a] [:d] [:a]])
720 (scroll-text 2)
722 ;; begin deposit
723 (menu [[:d] [:a]])
724 (do-nothing 40))))
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)))
736 (defn deposit-n-items
737 [n script]
738 (->> script
739 (do-nothing 100)
740 (play-moves [[:a]])
741 (do-nothing 80)
742 (multiple-times
743 (dec n)
744 (fn [script]
745 (->> script
746 (play-moves [[:u]])
747 (do-nothing 1))))
748 (play-moves [[:a]])
749 (scroll-text)))
752 (defn-memo create-header
753 ([] (create-header (begin-deposits)))
754 ([script]
755 (->> script
756 (multiple-times 33 deposit-one-item)
757 (do-nothing 1))))