view clojure/com/aurellem/run/bootstrap_0.clj @ 322:d604bd3c122c

added function to determine wuantity of items currently selected
author Robert McIntyre <rlm@mit.edu>
date Wed, 04 Apr 2012 00:35:44 -0500
parents af86b5ba622b
children 92ee94945327
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"]))))
341 (def item-cursor-offset-address 52262)
342 (def item-screen-offset-address 52278)
344 (defn item-offset
345 ([^SaveState state]
346 (let [mem (memory state)]
347 (+ (aget mem item-screen-offset-address)
348 (aget mem item-cursor-offset-address))))
349 ([] (item-offset @current-state)))
352 (defn exp-item-selection []
353 (clojure.pprint/pprint
354 (apply memory-compare
355 (map read-state
356 ["1-item"
357 "2-items"
358 "3-items"
359 "4-items"
360 ]))))
362 (def item-quantity-selected-address 65432)
364 (defn item-quantity-selected
365 ([^SaveState state]
366 (aget (memory state) item-quantity-selected-address))
367 ([] (item-quantity-selected @current-state)))
370 (defn buy-item
371 "Assumes that the main item-screen is up, and buys
372 quantity of the nth item in the list, assuming that you
373 have enough money."
374 [n quantity script]
375 (if (= 0 quantity)
376 script
377 (let [after-initial-pause
378 (do-nothing 20 script)
379 move-to-item
380 (reduce (fn [script _]
381 (->> script
382 (play-moves [[:d]])
383 (do-nothing 3)))
384 after-initial-pause
385 (range n))
386 select-item
387 (play-moves [[:a]] move-to-item)
388 request-items
389 (reduce (fn [script _]
390 (->> script
391 (play-moves [[:u]])
392 (do-nothing 1)))
393 select-item
394 (range (dec quantity)))
395 buy-items
396 (->> request-items
397 (do-nothing 10)
398 (play-moves [[:a]])
399 (scroll-text)
400 (scroll-text)
401 (do-nothing 10)
402 (play-moves [[:a]])
403 (scroll-text))]
404 buy-items)))
407 (defn buy-items
408 "Given a list of [item-no quantity], buys the quantity
409 from the shop's list. Assumes that the item list is
410 already up."
411 [item-pairs script]
412 (let [item-lookup (into {0 0 1 0 2 0 3 0 4 0} item-pairs)
413 initial-purchase
414 (->> script
415 (buy-item 0 (item-lookup 0))
416 (buy-item 1 (item-lookup 1))
417 (buy-item 2 (item-lookup 2)))]
418 (cond
419 (and
420 (not= 0 (item-lookup 3))
421 (not= 0 (item-lookup 4)))
422 (->> initial-purchase
423 (do-nothing 20)
424 (play-moves [[:d]])
425 (do-nothing 3)
426 (play-moves [[:d]])
427 (do-nothing 3)
428 (play-moves [[:d]])
429 (do-nothing 10)
430 (buy-item 0 (item-lookup 3))
431 (do-nothing 20)
432 (play-moves [[:d]])
433 (do-nothing 3)
434 (play-moves [[:d]])
435 (do-nothing 3)
436 (play-moves [[:d]])
437 (do-nothing 10)
438 (buy-item 0 (item-lookup 4)))
439 (and (= 0 (item-lookup 3))
440 (not= 0 (item-lookup 4)))
441 (->> initial-purchase
442 (do-nothing 20)
443 (play-moves [[:d]])
444 (do-nothing 3)
445 (play-moves [[:d]])
446 (do-nothing 3)
447 (play-moves [[:d]])
448 (do-nothing 10)
449 (play-moves [[:d]])
450 (do-nothing 10)
451 (buy-item 0 (item-lookup 4)))
452 (and (not= 0 (item-lookup 3))
453 (= 0 (item-lookup 4)))
454 (->> initial-purchase
455 (do-nothing 20)
456 (play-moves [[:d]])
457 (do-nothing 3)
458 (play-moves [[:d]])
459 (do-nothing 3)
460 (play-moves [[:d]])
461 (do-nothing 10)
462 (buy-item 0 (item-lookup 3)))
463 (and (= 0 (item-lookup 3))
464 (= 0 (item-lookup 4)))
465 initial-purchase)))
468 (defn test-buy-items
469 ([] (test-buy-items
470 (walk-to-counter)))
471 ([script]
472 (->> [(first script) (set-money (second script)
473 999999)]
474 (play-moves
475 [[] [:a] []])
476 (scroll-text)
477 (do-nothing 100)
478 (play-moves [[:a]])
479 (do-nothing 100)
480 (buy-items
481 [[0 1]
482 [1 15]
483 [2 1]
484 [3 20]
485 [4 95]
486 ]))))
488 (defn-memo buy-initial-items
489 ([] (buy-initial-items
490 (walk-to-counter)))
491 ([script]
492 (->> script
493 (play-moves
494 [[] [:a] []])
495 (scroll-text)
496 (do-nothing 100)
497 (play-moves [[:a]])
498 (do-nothing 100)
499 (buy-items
500 [[0 1]
501 [1 1]
502 [2 1]
503 [3 1]
504 [4 1]])
505 (do-nothing 100)
506 (play-moves [[:b]])
507 (do-nothing 100)
508 (play-moves [[:b]])
509 (do-nothing 100)
510 (play-moves [[:b] []])
511 (first-difference [:b] [:b :start] AF))))
514 (defn-memo do-save-corruption
515 ([] (do-save-corruption
516 (buy-initial-items)))
517 ([script]
518 (->> script
519 (first-difference [] [:d] AF)
520 (play-moves [[] [] [] [:d]
521 [] [] [] [:d]
522 [] [] [] [:d]
523 [] [] [:a]])
524 scroll-text
525 (play-moves
526 ;; this section is copied from speedrun-2942 and corrupts
527 ;; the save so that the total number of pokemon is set to
528 ;; 0xFF, allowing manipulation of non-pokemon data in RAM
529 ;; via the pokemon interface.
530 [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
531 [] [] [] [] [] [] [] [] [] [] [] [:select] [:restart]])
532 (title)
533 (first-difference [] [:start] AF)
534 (first-difference [] [:a] AF)
535 (first-difference [:a] [:a :start] AF))))
537 (def menu do-nothing )
539 (defn-memo corrupt-item-list
540 ([] (corrupt-item-list
541 (do-save-corruption)))
542 ([script]
543 (->> script
544 (do-nothing 200)
545 (menu [↓ [:a]]) ; select "POKEMON" from
546 ; from main menu
547 (menu [↓ ↓ ↓ ↓ ↓ ↓ ; go to 6th pokemon
548 [:a] ↓ [:a] ; select "switch"
549 ↓ ↓ ↓ [:a]]) ; switch with 9th "pokemon"
551 (do-nothing 1))))
553 (defn-memo get-burn-heals
554 ([] (get-burn-heals
555 (corrupt-item-list)))
556 ([script]
557 (->> script
558 (menu [[:b] [:b]])
559 (menu [[:a]])
560 (do-nothing 100)
561 (menu [↓ [:a]])
562 (do-nothing 100)
563 (menu [[:a] ↓ [:a]])
564 (scroll-text)
565 (menu [[:b][:b]])
566 (menu [[:a]])
568 (do-nothing 50)
569 (buy-items [[0 1]])
570 (do-nothing 60)
571 (menu [[:a]])
572 (scroll-text)
574 (do-nothing 50)
575 (buy-items [[0 1]])
576 (do-nothing 60)
577 ;;(menu [[:a]])
578 ;;(scroll-text)
580 ;;(do-nothing 300)
581 ;;(menu [[:b] [:b]])
582 ;;(do-nothing 300)
584 (buy-items [[0 1]
585 [1 1]
586 [1 1]
587 [2 1]
588 [3 1]
589 [4 97]])
591 (do-nothing 10))))
593 (defn-memo corrupt-item-list-again
594 ([] (corrupt-item-list-again (get-burn-heals)))
595 ([script]
596 (->> script
597 (do-nothing 10)
598 (play-moves [[:b]])
599 (do-nothing 100)
600 (play-moves [[:b]])
601 (do-nothing 40)
602 (play-moves [[:b]])
603 (first-difference [:b] [:start :b] AF)
604 (menu [[:a] ↑ ↑ ↑ ↑ ↑ ; get fifth pokemon
605 [:a] ↓ [:a] ; and corrupt the
606 ↓ ↓ ↓ ↓ ↓ [:a]]) ; item list again by
607 ; switching it to
608 ))) ; tenth place.
610 (defn-memo viridian-store->viridian-poke-center
611 ([] (viridian-store->viridian-poke-center
612 (corrupt-item-list-again)))
613 ([script]
614 (->> script
615 (do-nothing 100)
616 (play-moves [[:b]])
617 (do-nothing 100)
618 (play-moves [[:b]])
619 (do-nothing 40)
620 ;; leave store
621 (walk [↓ ↓
622 → ↓ ↓])
623 (walk [← ← ← ←
624 ↓ ↓ ↓ ↓ ↓ ↓
625 ← ← ← ↑]))))
627 (defn-memo to-poke-center-computer
628 ([] (to-poke-center-computer
629 (viridian-store->viridian-poke-center)))
630 ([script]
631 (->> script
632 (walk [→ →
633 ↑ ↑ ↑
634 → → → → → → → → → ↑])
635 (do-nothing 1))))
637 (defn-memo begin-deposits
638 ([] (begin-deposits
639 (to-poke-center-computer)))
640 ([script]
641 (->> script
642 ;; access PC
643 (scroll-text 2)
645 ;; access item storage
646 (menu [[:a] [:d] [:a]])
647 (scroll-text 2)
649 ;; begin deposit
650 (menu [[:d] [:a]])
651 (do-nothing 40))))
653 (defn deposit-n-items
654 [n script]
655 (->> script
656 (do-nothing 100)
657 (play-moves [[:a]])
658 (do-nothing 80)
659 (multiple-times
660 (dec n)
661 (fn [script]
662 (->> script
663 (play-moves [[:u]])
664 (do-nothing 1))))
665 (play-moves [[:a]])
666 (scroll-text)))
668 (defn deposit-one-item
669 [script]
670 (->> script
671 (do-nothing 100)
672 (play-moves [[:a]])
673 (do-nothing 80)
674 (play-moves [[:a]])
675 (scroll-text)))
677 (defn-memo create-header
678 ([] (create-header (begin-deposits)))
679 ([script]
680 (->> script
681 (multiple-times 33 deposit-one-item)
682 (do-nothing 1))))
684 (defn bootstrap-init []
685 [(read-moves "bootstrap-init")
686 (read-state "bootstrap-init")])
688 (defn create-bootstrap-program
689 ([] (create-bootstrap-program
690 (create-header)))
691 ([script]
692 (->> script
693 (do-nothing 120)
694 (menu [↓ ↓ ↓ ↓ ↓ ↓ ↓])
695 ;;(deposit-n-items 33)
697 (menu (repeat 17 ↓))
701 (do-nothing 1))))
704 (defn test-pc-item-program []
705 (-> (read-state "bootstrap-init")
706 (set-memory pc-item-list-start 50)
707 (set-memory-range
708 map-function-address-start [0x8B 0xD5])
709 (set-memory-range
710 (inc pc-item-list-start)
711 (flatten
712 [(repeat
713 28
714 [0xFF 0x01])
715 [;; second part of item manipulation program
716 0x00 ;; this starts at address 0xD56C
717 0x2A ;; save (HL)=(target) to A, increment HL
719 0x00
720 0x47 ;; save A to B
722 0x00
723 0x3A ;; save (target+1) to A, decrement HL
725 0x00
726 0x22 ;; A -> target, increment HL [(target+1) -> target]
728 0x00
729 0x70 ;; load B into target+1 [(target) -> target+1]
731 0x00
732 0xC3 ;; first part of absolute jump
734 0x0C ;; return control to pokemon kernel
735 0x5F]
736 (repeat
737 5
738 [0xFF 0x01])
740 [;; first part of item manipulation program
741 0x00
742 0x21 ;; load target into HL
744 0x94 ;; this is the target address
745 0xD5
747 0x00 ;; relative jump back to first part
748 0x18
750 0xE1 ;; of program
751 0x01
753 0xFF ;; spacer
754 0x01
756 0x04 ;; target ID (pokeball)
757 0x3E ;; target Quantity (lemonade)
758 ]]))))