view clojure/com/aurellem/run/bootstrap_0.clj @ 334:57f4c57d2897

saving progress.
author Robert McIntyre <rlm@mit.edu>
date Fri, 06 Apr 2012 14:54:39 -0500
parents 61a096a53330
children 25b7bb7da3b1
line wrap: on
line source
1 (ns com.aurellem.run.bootstrap-0
2 (:use (com.aurellem.gb saves gb-driver util
3 items vbm characters money))
4 (:use (com.aurellem.run util title save-corruption))
5 (:use (com.aurellem.exp item-bridge))
6 (:import [com.aurellem.gb.gb_driver SaveState]))
8 (defn-memo boot-root []
9 [ [] (root)])
11 (defn-memo to-rival-name
12 ([] (to-rival-name (boot-root)))
13 ([script]
14 (->> script
15 title
16 oak
17 name-entry-rlm
18 (scroll-text 5))))
20 (defn-memo name-rival-bootstrap
21 ([] (name-rival-bootstrap (to-rival-name)))
22 ([script]
23 (->> script
24 (first-difference [] [:a] AF)
25 (first-difference [] [:r] DE)
26 (play-moves
27 [[]
28 [] [] [:r] [] [:d] [:a] ;; L
29 [:r] [] [:r] [] [:r] [] [:r] []
30 [:r] [] [:d] [] [:d] [:a] ;; [PK]
31 [:u] [] [:l] [] [:l] []
32 [:l] [] [:l] [] [:l] [:a] ;; U
33 [:r] [] [:r] [] [:r] []
34 [:r] [] [:r] [] [:d] [:a] ;; [PK]
35 [] [:a] ;; [PK]
36 [] [:a] ;; [PK]
37 [:r] [] [:d] [:a] ;; END
38 ]))))
40 (defn-memo leave-house
41 ([] (leave-house (name-rival-bootstrap)))
42 ([script]
43 (->> script
44 finish-title
45 walk-to-stairs
46 walk-to-door
47 (walk [↓ ↓]))))
49 (defn-memo to-pallet-town-edge
50 ([] (to-pallet-town-edge (leave-house)))
51 ([script]
52 (->> script
53 (walk [→ → → → →
54 ↑ ↑ ↑ ↑ ↑ ↑]))))
56 (defn-memo start-pikachu-battle
57 ([] (start-pikachu-battle
58 (to-pallet-town-edge)))
59 ([script]
60 (->> script
61 (first-difference [:b] [:b :a] DE)
62 scroll-text
63 (do-nothing 200)
64 (play-moves [[:b]]))))
66 (defn-memo capture-pikachu
67 ([] (capture-pikachu (start-pikachu-battle)))
68 ([script]
69 (->> script
70 (scroll-text 3))))
72 (defn-memo go-to-lab
73 ([] (go-to-lab (capture-pikachu)))
74 ([script]
75 (->> script
76 end-text
77 (scroll-text 5)
78 end-text
79 ;; oak walks you to his lab; no input required.
80 (do-nothing 400))))
82 (defn-memo talk-to-oak-in-lab
83 ([] (talk-to-oak-in-lab (go-to-lab)))
84 ([script]
85 (->> script
86 (scroll-text 14)
87 end-text)))
89 (defn-memo try-to-get-eevee
90 ([] (try-to-get-eevee (talk-to-oak-in-lab)))
91 ([script]
92 (->> script
93 ;; walk to pokeball
94 (walk [↓ → →])
95 ;; and try to grab it
96 (play-moves
97 (concat [↑ ↑ [:a]]
98 (repeat 100 [])))
99 (scroll-text 10)
100 (end-text))))
102 (defn-memo obtain-pikachu
103 ([] (obtain-pikachu (try-to-get-eevee)))
104 ([script]
105 (->> script
106 (scroll-text 6)
107 (end-text))))
110 (defn-memo begin-battle-with-rival
111 ([] (begin-battle-with-rival
112 (obtain-pikachu)))
113 ([script]
114 (->> script
115 (walk [↓ ↓ ↓])
116 (scroll-text 3)
117 (end-text)
118 (scroll-text))))
120 (defn-memo defeat-eevee
121 ([] (defeat-eevee
122 (begin-battle-with-rival)))
123 ([script]
124 (->> script
125 (do-nothing 400)
126 (play-moves [[:a]])
127 (critical-hit)
128 (do-nothing 200)
129 (scroll-text 2) ;; for eevee's tail-whip
130 (do-nothing 10)
131 (play-moves [[:a]])
132 (critical-hit)
133 (do-nothing 200)
134 (scroll-text 2) ;; tail whip again
135 (do-nothing 10)
136 (play-moves [[:a]])
137 (critical-hit)
138 (do-nothing 200))))
140 (defn-memo finish-rival-text
141 ([] (finish-rival-text
142 (defeat-eevee)))
143 ([script]
144 (->> script
145 (scroll-text 12)
146 (end-text))))
148 (defn-memo pikachu-comes-out
149 ([] (pikachu-comes-out
150 (finish-rival-text)))
151 ([script]
152 (->> script
153 (scroll-text 8)
154 (end-text))))
156 (defn-memo leave-oaks-lab
157 ([] (leave-oaks-lab
158 (pikachu-comes-out)))
159 ([script]
160 (->> script
161 (walk [↓ ↓ ↓ ↓ ↓ ↓]))))
163 (defn-memo oaks-lab->pallet-town-edge
164 ([] (oaks-lab->pallet-town-edge
165 (leave-oaks-lab)))
166 ([script]
167 (->> script
168 (walk [← ← ←
169 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ →]))))
171 (defn-memo pallet-edge->viridian-mart
172 ([] (pallet-edge->viridian-mart true
173 (oaks-lab->pallet-town-edge)))
174 ([dodge-stupid-guy? script]
175 (let [dodge-1 (if dodge-stupid-guy?
176 [→ →]
177 [→])
178 dodge-2 (if dodge-stupid-guy?
179 [↑ ↑ ←]
180 [↑ ↑])]
182 (->> script
183 ;; leave straight grass
184 (walk-thru-grass
185 [↑ ↑ ↑ ↑ ↑])
187 (walk [↑ ↑ ↑ ↑])
189 (walk-thru-grass
190 [← ← ↑])
192 (walk [↑ ↑ ↑ ↑ → → → ])
194 (walk-thru-grass
195 [→ ↑ ↑ ←])
197 (walk
198 [← ←
199 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
200 → → → → ])
202 ;; this part is dependent on that
203 ;; stupid NPC in the grass patch
204 (walk-thru-grass
205 (concat dodge-1
206 [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ]))
208 (walk
209 (concat
210 dodge-2
211 [← ← ←
212 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
213 ← ←
214 ↑ ↑ ↑ ↑
215 → → → → → → → → → →
216 ↑ ↑ ↑ ↑ ↑ ↑ ↑]))))))
218 (defn-memo get-oaks-parcel
219 ([] (get-oaks-parcel
220 (pallet-edge->viridian-mart)))
221 ([script]
222 (->> script
223 (do-nothing 50)
224 (end-text)
225 (scroll-text 3)
226 (do-nothing 197)
227 (play-moves [[:a] []])
228 (walk [↓ ↓ → ↓]))))
230 (defn-memo viridian-store->oaks-lab
231 ([] (viridian-store->oaks-lab
232 (get-oaks-parcel)))
233 ([script]
234 (->> script
235 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
236 ← ← ← ← ← ← ← ← ←
237 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
238 ← ←
239 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
240 ↓ ↓ ↓ ↓ ↓ ↓ ↓
241 → → → → → → → →
242 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
243 ← ← ← ← ←
244 ↓ ↓ ↓ ↓
245 ])
246 (walk-thru-grass
247 [↓ ↓ ↓ ↓ ↓ ↓ ↓])
248 (walk [↓ ↓ ← ↓ ↓ ↓ ←
249 ↓ ↓ ↓ ↓ ↓ ↓
250 → → → ↑])
252 (do-nothing 1))))
255 (defn-memo viridian-store->oaks-lab-like-a-boss
256 ([] (viridian-store->oaks-lab-like-a-boss
257 (get-oaks-parcel)))
258 ([script]
259 (->> script
260 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
261 ← ← ← ← ← ← ← ← ←
262 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])
264 (walk-thru-grass
265 [↓ ↓ ↓ ↓ ↓])
267 (walk
268 [↓ ↓ ← ↓
269 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
270 → → → ↓])
272 (walk-thru-grass
273 [↓ ↓ ↓])
275 (walk [↓ ← ← ↓ ↓ ↓ ↓ ↓ ↓])
277 (walk-thru-grass
278 [↓ ↓ ↓ ↓ ↓ ↓])
280 (walk [↓ ↓ ↓ ← ↓ ↓ ↓
281 ↓ ↓ ↓ ↓ ↓
282 → → → ↑]))))
284 (defn-memo deliver-oaks-parcel
285 ([] (deliver-oaks-parcel
286 (viridian-store->oaks-lab-like-a-boss)))
287 ([script]
288 (->> script
289 (walk [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
290 (play-moves [[] [:a]])
291 (scroll-text 13)
292 (end-text)
293 (do-nothing 200)
294 (scroll-text 2)
295 (end-text)
296 (scroll-text 2)
297 (end-text)
298 (scroll-text 8)
299 (end-text)
300 (scroll-text 9)
301 (end-text)
302 (scroll-text 7)
303 (end-text)
304 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓]))))
306 (defn-memo return-to-viridian-mart
307 ([] (return-to-viridian-mart
308 (deliver-oaks-parcel)))
309 ([script]
310 (->> script
311 oaks-lab->pallet-town-edge
312 (pallet-edge->viridian-mart false))))
314 (defn-memo walk-to-counter
315 ([] (walk-to-counter
316 (return-to-viridian-mart)))
317 ([script]
318 (->> script
319 (walk [↑ ↑ ←]))))
323 ;; useful addresses
324 52262 ;; --- current-cursor-offset
325 52278 ;; --- current screen-offset
328 (defn exp-item-list []
329 (clojure.pprint/pprint
330 (apply harmonic-compare
331 (map read-state
332 ["up-1" "down-1"
333 "up-2" "down-2"
334 "up-3" "down-3"
335 "up-4" "down-4"
336 "up-5" "down-5"
337 "up-6"]))))
340 ;; turns out that these addresses are the cursor position
341 ;; for all lists in the game (start list, pokemon list, shop
342 ;; lists, inventory lists, battle list, basically
343 ;; everything!)
345 (def list-cursor-offset-address 52262)
346 (def list-screen-offset-address 52278)
348 (defn list-offset
349 ([^SaveState state]
350 (let [mem (memory state)]
351 (+ (aget mem list-screen-offset-address)
352 (aget mem list-cursor-offset-address))))
353 ([] (list-offset @current-state)))
357 (defn exp-item-selection []
358 (clojure.pprint/pprint
359 (apply memory-compare
360 (map read-state
361 ["1-item"
362 "2-items"
363 "3-items"
364 "4-items"
365 ]))))
367 (def item-quantity-selected-address 65432)
369 (defn item-quantity-selected
370 ([^SaveState state]
371 (println "items:" (aget (memory state) item-quantity-selected-address))
372 (aget (memory state) item-quantity-selected-address))
373 ([] (item-quantity-selected @current-state)))
375 (defn set-cursor-relative
376 "Assumes the arrow keys currently control the cursor.
377 Moves the cursor n steps relative to its current
378 position."
379 [n script]
380 (let [key (if (< 0 n) ↓ ↑)]
381 (multiple-times
382 (Math/abs n)
383 (partial first-difference
384 [] key list-offset)
385 script)))
387 (defn set-cursor
388 "Assumes the arrow keys currently control the cursor. Sets
389 the cursor to the desired position. Works for any menu
390 that uses a cursor including the start menu, item menu,
391 pokemon menu, and battle menu."
392 [n [moves state :as script]]
393 (let [current-position (list-offset state)
394 difference (- n current-position)]
395 (println difference)
396 (set-cursor-relative difference script)))
398 (defn set-quantity
399 "Set the quantity of an item to buy or sell to the desired value
400 using the fewest possible button presses."
401 ([total-quantity desired-quantity [moves state :as script]]
402 (let [current-quantity (item-quantity-selected state)
403 loop-point (if (> total-quantity 99) 0xFF 99)
404 distance (- desired-quantity current-quantity)
405 loop-distance (int(* -1 (Math/signum (float distance))
406 (- loop-point (Math/abs distance))))
407 best-path (first (sort-by #(Math/abs %)
408 [distance loop-distance]))
409 direction (if (< 0 best-path) ↑ ↓)]
410 (println "best-path" best-path)
411 (reduce
412 (fn [script _]
413 (delayed-difference [] direction 5 item-quantity-selected
414 script))
416 script
417 (range (Math/abs best-path)))))
418 ([desired-quantity [moves state :as script]]
419 (set-quantity 99 desired-quantity script)))
421 (defn activate-start-menu [script]
422 (first-difference [:b] [:b :start] AF script))
424 (defn wait-until [script-fn script]
425 (let [wait-time
426 (- (dec (count (first (script-fn script))))
427 (count (first script)))]
428 (println "wait-time" wait-time)
429 (do-nothing wait-time script)))
431 (defn select-menu-entry [script]
432 (->> script
433 (wait-until (partial set-cursor-relative 1))
434 (play-moves [[:a] []])))
436 (defn-memo do-save-corruption
437 ([] (do-save-corruption
438 (walk-to-counter)))
439 ([script]
440 (->> script
441 activate-start-menu
442 (set-cursor 4)
443 select-menu-entry
444 select-menu-entry
445 (play-moves
446 ;; this section is copied from speedrun-2942 and corrupts
447 ;; the save so that the total number of pokemon is set to
448 ;; 0xFF, allowing manipulation of non-pokemon data in RAM
449 ;; via the pokemon interface.
450 [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
451 [] [] [] [] [] [] [] [] [] [] [] [:select] [:restart]])
452 (title)
453 (first-difference [] [:start] AF)
454 (first-difference [] [:a] AF))))
456 (defn gen-corrupted-checkpoint! []
457 (let [[cor-moves cor-save] (do-save-corruption)]
458 (write-moves! cor-moves "cor-checkpoint")
459 (write-state! cor-save "cor-checkpoint")))
461 (defn corrupted-checkpoint []
462 [(read-moves "cor-checkpoint")
463 (read-state "cor-checkpoint")])
465 (def menu do-nothing )
467 (defn close-menu [script]
468 (first-difference [] [:b] AF script))
470 (defn purchase-item
471 "Assumes that the cursor is over the desired item, and purchases
472 quantity of that item."
473 [n script]
474 (->> script
475 select-menu-entry
476 (set-quantity n)
477 (first-difference [] [:a] AF)
478 scroll-text
479 select-menu-entry
480 scroll-text))
482 (defn-memo corrupt-item-list
483 "Corrupt the num-of-items variable by switching a corrupted pokemon
484 into out-of-bounds memory."
485 ([] (corrupt-item-list
486 (corrupted-checkpoint)
487 ;;(do-save-corruption)
488 ))
489 ([script]
490 (->> script
491 activate-start-menu
492 (set-cursor 1) ; select "POKEMON" from
493 select-menu-entry ; from main menu.
494 (set-cursor 5) ; select 6th pokemon
495 select-menu-entry
496 (set-cursor 1)
497 select-menu-entry
498 (repeat-until-different [] list-offset)
499 (set-cursor 9)
500 select-menu-entry ; switch 6th with 10th
501 close-menu
502 close-menu)))
504 (defn-memo get-lots-of-money
505 "Sell 0xFE cancel buttons to make a tremendous amount of money."
506 ([] (get-lots-of-money (corrupt-item-list)))
507 ([script]
508 (->> script
509 (first-difference [] [:a] AF) ; talk to shopkeep
510 (repeat-until-different [] list-offset)
511 (set-cursor 1)
512 select-menu-entry
513 (repeat-until-different [] list-offset)
514 select-menu-entry
515 (set-quantity 0xFF 0xF7)
516 (first-difference [] [:a] AF)
517 select-menu-entry
518 close-menu)))
520 (defn note [str script]
521 (println str) script)
523 (defn-memo buy-bootstrapping-items
524 "Buy items that will become part of the bootstrapping
525 program."
526 ([] (buy-bootstrapping-items (get-lots-of-money)))
527 ([script]
528 (->> script
529 close-menu
530 select-menu-entry
531 (purchase-item 1) ; buying a pokeball overflows
532 ; the item-counter from 0xFF to 0x00
533 ; repairing the item-list.
534 (set-cursor 1)
535 (purchase-item 1) ; these other items are here to
536 ; protect the burn heals when the
537 (set-cursor 2) ; item list is corrupted again.
538 (purchase-item 1)
540 (set-cursor 3)
541 (purchase-item 1)
543 (set-cursor 4) ; 95 burn-heals spells out the
544 (purchase-item 96) ; return address to the pokemon
545 ; kernel. 96 so that they can be
546 ; deposited without causing a shift.
548 close-menu ; stop talking to shopkeep
549 (wait-until select-menu-entry)
550 (play-moves [[:b]])
551 end-text)))
553 (defn-memo corrupt-item-list-again
554 ([] (corrupt-item-list-again (buy-bootstrapping-items)))
555 ([script]
556 (->> script
557 activate-start-menu
558 (set-cursor-relative 0)
559 select-menu-entry
561 ;; repair list-offset for pokemon-list
562 (set-cursor-relative -1)
564 (set-cursor 4) ; switching it to
565 select-menu-entry ; tenth place.
566 (set-cursor 1)
567 select-menu-entry ; select "switch" on 5th
569 (repeat-until-different [] list-offset)
570 (set-cursor 9) ; goto 10th pokemon
571 select-menu-entry ; do switch
572 close-menu
573 close-menu)))
575 (defn leave-viridian-store
576 ([] (leave-viridian-store (corrupt-item-list-again)))
577 ([script]
578 (->> script
579 ;; leave store
580 (walk [↓ ↓ → ↓])
581 (do-nothing 1))))
583 (defn force-encounter [direction script]
584 (delayed-improbability-search
585 600
586 #(search-string % "Wild")
587 (partial move direction) script))
589 (defn-memo fight-wild-pokemon
590 ([] (fight-wild-pokemon (leave-viridian-store)))
591 ([script]
592 (->> script
593 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
594 ← ← ← ← ← ← ← ←
595 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])
596 (force-encounter →))))
598 (defn-memo run-from-pokemon
599 ([] (run-from-pokemon (fight-wild-pokemon)))
600 ([script]
601 (->> script
602 (scroll-text)
603 (wait-until select-menu-entry)
604 (set-cursor 1)
605 (first-difference [] → AF)
606 (scroll-text)
607 (scroll-text))))
609 (defn-memo to-poke-center-computer
610 ([] (to-poke-center-computer
611 (run-from-pokemon)))
612 ([script]
613 (->> script
614 (walk-thru-grass [→ ↑])
615 (walk [↑ ← ← ←
616 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
617 ← ←
618 ↑ ↑ ↑ ↑
619 → → → → ↑])
620 (walk [→ →
621 ↑ ↑ ↑
622 → → → → → → → → →])
623 (first-difference [] ↑ AF))))
625 (defn-memo begin-deposits
626 ([] (begin-deposits
627 (to-poke-center-computer)))
628 ([script]
629 (->> script
630 ;; access PC
631 (scroll-text 2)
633 ;; access item storage
634 (menu [[:a] [:d] [:a]])
635 (scroll-text 2)
637 ;; begin deposit
638 (menu [[:d] [:a]])
639 (do-nothing 40))))
641 (defn deposit-n-items
642 [n script]
643 (->> script
644 (do-nothing 100)
645 (play-moves [[:a]])
646 (do-nothing 80)
647 (multiple-times
648 (dec n)
649 (fn [script]
650 (->> script
651 (play-moves [[:u]])
652 (do-nothing 1))))
653 (play-moves [[:a]])
654 (scroll-text)))
656 (defn deposit-one-item
657 [script]
658 (->> script
659 (do-nothing 100)
660 (play-moves [[:a]])
661 (do-nothing 80)
662 (play-moves [[:a]])
663 (scroll-text)))
665 (defn-memo create-header
666 ([] (create-header (begin-deposits)))
667 ([script]
668 (->> script
669 (multiple-times 33 deposit-one-item)
670 (do-nothing 1))))
672 (defn bootstrap-init []
673 [(read-moves "bootstrap-init")
674 (read-state "bootstrap-init")])
676 (defn create-bootstrap-program
677 ([] (create-bootstrap-program
678 (create-header)))
679 ([script]
680 (->> script
681 (do-nothing 120)
682 (menu [↓ ↓ ↓ ↓ ↓ ↓ ↓])
683 ;;(deposit-n-items 33)
685 (menu (repeat 17 ↓))
689 (do-nothing 1))))
692 (defn test-pc-item-program []
693 (-> (read-state "bootstrap-init")
694 (set-memory pc-item-list-start 50)
695 (set-memory-range
696 map-function-address-start [0x8B 0xD5])
697 (set-memory-range
698 (inc pc-item-list-start)
699 (flatten
700 [(repeat
701 28
702 [0xFF 0x01])
703 [;; second part of item manipulation program
704 0x00 ;; this starts at address 0xD56C
705 0x2A ;; save (HL)=(target) to A, increment HL
707 0x00
708 0x47 ;; save A to B
710 0x00
711 0x3A ;; save (target+1) to A, decrement HL
713 0x00
714 0x22 ;; A -> target, increment HL [(target+1) -> target]
716 0x00
717 0x70 ;; load B into target+1 [(target) -> target+1]
719 0x00
720 0xC3 ;; first part of absolute jump
722 0x0C ;; return control to pokemon kernel
723 0x5F]
724 (repeat
725 5
726 [0xFF 0x01])
728 [;; first part of item manipulation program
729 0x00
730 0x21 ;; load target into HL
732 0x94 ;; this is the target address
733 0xD5
735 0x00 ;; relative jump back to first part
736 0x18
738 0xE1 ;; of program
739 0x01
741 0xFF ;; spacer
742 0x01
744 0x04 ;; target ID (pokeball)
745 0x3E ;; target Quantity (lemonade)
746 ]]))))