view clojure/com/aurellem/run/bootstrap_1.clj @ 595:96ee9d72aeb9

saving progress.... sleepy time :)
author Robert McIntyre <rlm@mit.edu>
date Sat, 01 Sep 2012 13:32:19 -0500
parents ea448eecb615
children 747d47d96d2f
line wrap: on
line source
1 (ns com.aurellem.run.bootstrap-1
2 (:use (com.aurellem.gb saves gb-driver util constants
3 items vbm characters money
4 rlm-assembly))
5 (:use (com.aurellem.run util title save-corruption bootstrap-0))
6 (:use (com.aurellem.exp item-bridge))
7 (:import [com.aurellem.gb.gb_driver SaveState]))
9 (def hex #(printf "0x%02X\n" %))
11 (defn print-desired-item-layout []
12 (clojure.pprint/pprint
13 (raw-inventory->inventory (pc-item-writer-program))))
15 (defn pc-item-writer-state []
16 (-> (read-state "bootstrap-init")
17 (set-memory pc-item-list-start 50)
18 (set-memory-range
19 map-function-address-start
20 [0x8B 0xD5])
21 (set-memory-range
22 (inc pc-item-list-start)
23 (pc-item-writer-program))))
25 (defn test-pc-item-writer []
26 (let [orig (read-state "pc-item-writer")]
27 (-> orig
28 (print-listing 0xD162 (+ 0xD162 20))
29 (run-moves (reduce concat
30 (repeat 10 [[:a :b :start :select] []])))
31 ((fn [_] (println "===========") _))
32 (print-listing 0xD162 (+ 0xD162 20)))))
34 (defn close-all-menus [[moves state :as script]]
35 (loop [s script]
36 (let [depth (current-depth (second (do-nothing 50 s)))]
37 (println "depth" depth)
38 (if (= depth 1)
39 s
40 (recur (close-menu s))))))
42 (defn-memo name-rival
43 ([] (name-rival (to-rival-name)))
44 ([script]
45 (->> script
46 (first-difference [] [:a] AF)
47 (first-difference [] [:r] DE)
48 (play-moves
49 [[]
50 [] [] [:r] [] [:d] [:a] ;; L
51 [:r] [] [:r] [] [:r] [] [:r] []
52 [:r] [] [:d] [] [:d] [:a] ;; [PK]
53 [:d] [] [:r] [:a]
54 ]))))
56 (defn-memo to-room-pc
57 ([] (to-room-pc (name-rival)))
58 ([script]
59 (->> script
60 finish-title
61 (walk [← ← ↑ ← ↑ ↑ ↑]))))
63 ;; (defn wait-for-quantity
64 ;; [[moves state :as script]]
65 ;; (if (not= (item-quantity-selected state) 1)
66 ;; (repeat-until-different [] item-quantity-selected script)
67 ;; script))
69 ;; TODO use this:
70 ;;(wait-until (partial set-cursor-relative 1))
72 ;; (defn wait-for-cursor
73 ;; [[moves state :as script]]
74 ;; (if (not= (list-offset state) 0)
75 ;; (repeat-until-different [] list-offset script)
76 ;; script))
78 (defn deposit-held-item [n quantity [moves state :as script]]
79 (let [total-quantity (second (nth-item state n))]
80 (println "total-quantity" total-quantity)
81 (->> script
82 (set-cursor n)
83 (select-menu-entry 1)
84 ;;(wait-for-quantity)
85 (set-quantity total-quantity quantity)
86 (delayed-difference [] [:a] 100 #(search-string % "stored"))
87 (scroll-text))))
89 (defn sell-held-item [n quantity [moves state :as script]]
90 (let [total-quantity (second (nth-item state n))]
91 (->> script
92 ;;(wait-for-cursor) ;; when selling, the cursor always
93 (set-cursor n) ;; returns to the top of the list.
94 (select-menu-entry 1)
95 ;;(wait-for-quantity)
96 (set-quantity total-quantity quantity)
97 (delayed-difference [] [:a] 100 current-depth)
98 (play-moves (repeat 20 [:b]))
99 (delayed-difference [] [:a] 100 #(search-string % "What"))
100 )))
102 (defn widthdraw-pc-item [n quantity [moves state :as script]]
103 (let [total-quantity (second (nth-pc-item state n))]
104 (->> script
105 (set-cursor n)
106 (select-menu-entry 1)
107 ;;(wait-for-quantity)
108 (set-quantity total-quantity quantity)
109 (delayed-difference [] [:a] 100 #(search-string % "Withdrew"))
110 (scroll-text))))
112 (defn toss-held-item [n quantity [moves state :as script]]
113 (let [total-quantity (second (nth-item state n))]
114 (->> script
115 (set-cursor n)
116 (select-menu-entry 1)
117 (set-cursor-relative 1)
118 (select-menu-entry -1)
119 ;;(wait-for-quantity)
120 (set-quantity total-quantity quantity)
121 (play-moves [[:a]])
122 (scroll-text)
123 (delayed-difference [] [:a] 100 #(search-string % "Threw"))
124 (scroll-text)
125 )))
127 (defn buy-item [n quantity [moves state :as script]]
128 (->> script
129 (set-cursor n)
130 (purchase-item quantity)))
132 (defn switch-items [item-fn idx-1 idx-2 script]
133 (->> script
134 (wait-until select-menu-entry)
135 (set-cursor idx-1)
136 (wait-until select-menu-entry)
137 (play-moves [[][:select][]])
138 (set-cursor idx-2)
139 (delayed-difference [] [:select] 100
140 #(item-fn % (list-offset %)))))
142 (def switch-pc-items (partial switch-items nth-pc-item))
143 (def switch-held-items (partial switch-items nth-item))
145 (defn combine-pc-items [idx-1 script]
146 (->> script
147 (switch-pc-items idx-1 (inc idx-1))))
149 (def desired-zero-quantities
150 (map second (filter (comp (partial = 0) first)
151 (partition 2 (pc-item-writer-program)))))
153 (defn bootstrap-corrupt-save
154 ([] (bootstrap-corrupt-save (to-room-pc)))
155 ([script]
156 (->> script
157 (do-save-corruption 3)
158 (corrupt-item-list 0)
159 close-all-menus)))
161 (defn-memo prepare-celadon-warp
162 ([] (prepare-celadon-warp (bootstrap-corrupt-save)))
163 ([script]
164 (->> script
165 (activate-start-menu)
166 (set-cursor-relative 1)
167 (select-menu-entry)
168 ;; vastly increase text speed while we're here.
169 (switch-held-items 21 27)
170 (toss-held-item 35 0xFA)
171 (close-all-menus))))
173 (defn-memo begin-initial-deposits
174 ([] (begin-initial-deposits
175 (prepare-celadon-warp)))
176 ([script]
177 (->> script
178 (first-difference [] [:a] AF)
179 (scroll-text)
180 (set-cursor 1)
181 select-menu-entry)))
183 (defn-memo initial-deposits
184 ([] (initial-deposits (begin-initial-deposits)))
185 ([script]
186 (->> script
187 (deposit-held-item 0 0x1)
188 ((fn [script]
189 (reduce
190 (fn [script item] (deposit-held-item item 0xFF script))
191 script
192 (range 3 (+ 13 3)))))
193 close-all-menus)))
196 ;;0 -- 256
197 ;;1 -- 254
198 ;;2 -- 254
199 ;;3 -- 255
201 (defn activate-home-pc
202 [script]
203 (->> script
204 (delayed-difference [] [:a]
205 200 first-character)
206 (scroll-text)))
208 (defn-memo restore-items
209 ([] (restore-items (initial-deposits)))
210 ([script]
211 (->> script
212 activate-home-pc
213 (select-menu-entry)
214 (widthdraw-pc-item 0 1)
215 ;;(widthdraw-pc-item 0 99)
216 ;;(widthdraw-pc-item 1 1)
217 (widthdraw-pc-item 13 255)
218 (close-all-menus))))
220 (defn-memo to-celadon
221 ([] (to-celadon (restore-items)))
222 ([script]
223 (->> script
224 (walk [→ → → → → → → ↑
225 ↓ ↓ ↓ ↓ ↓ ← ← ← ←
226 ↓ ↓]))))
229 ;; celadon store inventory
231 ;; Floor 2
232 ;;=====================================
233 ;; Great Ball TM32 (double-team)
234 ;; Super Potion TM33 (reflect)
235 ;; Revive TM02 (razor-wind)
236 ;; Super Repel TM07 (horn-drill)
237 ;; Antidote TM37 (egg-bomb)
238 ;; Burn Heal TM01 (mega-punch)
239 ;; Ice Heal TM05 (mega-kick)
240 ;; Awakening TM09 (take-down)
241 ;; Parlyz Heal TM17 (submission)
244 ;; Floor 3
245 ;;=====================================
246 ;; TM18 (counter)
249 ;; Floor 4
250 ;;=====================================
251 ;; Poke Doll
252 ;; Fire Stone
253 ;; Thunder Stone
254 ;; Water Stone
255 ;; Leaf Stone
257 ;; Floor 5
258 ;;=====================================
259 ;; X Accuracy HP UP
260 ;; Guard Spec. Protein
261 ;; Dire Hit Iron
262 ;; X Attack Carbos
263 ;; X Defend Calcium
264 ;; X Speed
265 ;; X Special
267 ;; Roof
268 ;;=====================================
269 ;; Fresh Water TM13 (ice-beam)
270 ;; Soda Pop TM48 (rock-slide)
271 ;; Lemonade :) TM49 (tri-attack)
274 (defn-memo go-to-floor-two
275 ([] (go-to-floor-two (to-celadon)))
276 ([script]
277 (->> script
278 (walk [→ → ↑
279 ↑ ↑ ↑ ↑
280 ← ← ← ←
281 ↑ ↑
282 ← ← ← ←
283 ↓ ↓ ↓
284 ← ←])
285 (first-difference [] ↑ AF))))
287 (defn talk
288 "Assumes that you are facing something that initiates text and
289 causes it to do so."
290 [script]
291 (->> script
292 (delayed-difference [] [:a] 100
293 first-character)))
295 (defn-memo get-money-floor-two
296 ([] (get-money-floor-two (go-to-floor-two)))
297 ([script]
298 (->> script
299 talk
300 (set-cursor 1)
301 (select-menu-entry)
303 ;; These glitch items have to be sold one at a time
304 ;; because the game will only award up to 500000 at
305 ;; a time for selling them.
306 (sell-held-item 0 1)
307 (sell-held-item 0 1)
309 (close-menu))))
311 (defn-memo floor-two-TMs
312 ([] (floor-two-TMs (get-money-floor-two)))
313 ([script]
314 (->> script
315 (set-cursor 0)
316 (select-menu-entry)
317 (buy-item 2 98) ;; TM02 (razor-wind)
318 (buy-item 4 71) ;; TM37 (doubleteam)
319 (buy-item 5 63) ;; TM01 (mega-punch)
320 (buy-item 6 1) ;; TM05 (mega-kick)
321 (buy-item 7 56) ;; TM09 (take-down)
322 (close-menu))))
324 (defn end-shop-conversation
325 [script]
326 (->> script
327 (wait-until scroll-text [:b])
328 (play-moves [[] [:b]])
329 close-menu))
331 (defn-memo floor-two-more-money
332 ([] (floor-two-more-money (floor-two-TMs)))
333 ([script]
334 (->> script
335 (set-cursor 1)
336 (select-menu-entry)
337 (sell-held-item 0 1)
338 (sell-held-item 0 1)
339 close-menu
340 end-shop-conversation)))
342 (defn turn [direction script]
343 (->> script
344 (first-difference [] direction AF)))
346 (defn-memo floor-two-items
347 ([] (floor-two-items (floor-two-more-money)))
348 ([script]
349 (->> script
350 (walk [←])
351 (turn ↑)
352 talk
353 select-menu-entry
354 (buy-item 5 12) ;; burn heal
355 (buy-item 6 55) ;; ice heal
356 (buy-item 7 4) ;; awakening
357 (buy-item 8 99) ;; parlyz heal
358 (buy-item 8 55) ;; parlyz heal
359 close-menu
360 end-shop-conversation)))
362 (defn-memo go-to-floor-three
363 ([] (go-to-floor-three (floor-two-items)))
364 ([script]
365 (->> script
366 (walk [→ → → → → → → → → → ↑ ↑ ↑
367 → ↑]))))
368 (defn-memo get-TM18
369 ([] (get-TM18 (go-to-floor-three)))
370 ([script]
371 (->> script
372 (walk [↓ ↓])
373 talk
374 (scroll-text 3)
375 end-text)))
377 (defn-memo go-to-floor-four
378 ([] (go-to-floor-four (get-TM18)))
379 ([script]
380 (->> script
381 (walk [← ← ← ← ↑ ↑
382 ↓ ← ← ↓ ↓ ↓
383 ← ← ← ← ←])
384 (turn ↓))))
386 (defn-memo floor-four-items
387 ([] (floor-four-items (go-to-floor-four)))
388 ([script]
389 (->> script
390 talk
391 select-menu-entry
392 (buy-item 1 23) ;; Fire Stone
393 (buy-item 2 98) ;; Thunder Stone
394 (buy-item 3 29) ;; Water Stone
395 close-menu
396 end-shop-conversation)))
398 (defn-memo go-to-floor-five
399 ([] (go-to-floor-five (floor-four-items)))
400 ([script]
401 (->> script
402 (walk [→ → → → → →
403 ↑ ↑ ↑
404 → → → → → ↑ ;; leave floor four
405 ↓ ← ← ← ← ← ← ← ←
406 ↓ ↓ ↓ ← ← ← ]);; go to five's clerk
407 (turn ↑))))
409 (defn-memo floor-five-items
410 ([] (floor-five-items (go-to-floor-five)))
411 ([script]
412 (->> script
413 talk
414 select-menu-entry
415 (buy-item 0 58) ;; X-Accuracy
416 (buy-item 1 99) ;; Guard Spec.
417 (buy-item 1 24) ;; Guard Spec.
418 close-menu
419 end-shop-conversation)))
421 (defn-memo go-to-roof
422 ([] (go-to-roof (floor-five-items)))
423 ([script]
424 (->> script
425 (walk [→ → → → ↑ ↑ ↑ → → → ↑ ;; leave floor five
426 ↓ ← ← ←]) ;; walk to vending machine
427 (turn ↑))))
429 (defn buy-drink
430 "Assumes you're in front of the vending machine. Buys the indicated
431 drink."
432 [n script]
433 (->> script
434 (do-nothing 20)
435 (play-moves [[:a][:a]])
436 scroll-text
437 (set-cursor n)
438 select-menu-entry
439 close-menu))
441 (defn-memo roof-drinks
442 ([] (roof-drinks (go-to-roof)))
443 ([script]
444 (->> script
445 (buy-drink 0) ;; fresh water (for TM13)
446 ;; buy 16 lemonades
447 ;; LEMONADE is the best item <3 :)
448 (multiple-times 16 (partial buy-drink 2)))))
450 (defn-memo get-TM13
451 ([] (get-TM13 (roof-drinks)))
452 ([script]
453 (->> script
454 ;; alternate route depending on girl's motions
455 ;;(walk [← ← ← ← ← ← ↓])
456 (walk [↓ ↓ ↓ ← ← ← ← ← ←])
457 (play-moves [[][][][][:a][:a][]])
458 (scroll-text 3)
459 select-menu-entry
460 select-menu-entry
461 (scroll-text 6)
462 close-menu)))
464 (defn-memo to-celadon-poke-center
465 ([] (to-celadon-poke-center (get-TM13)))
466 ([script]
467 (->> script
468 ;; alternate route depending on girl's motions
469 ;;(walk [↑ → → → → → → → → → ↑]) ; leave roof
470 (walk [→ → → → → → → → → ↑ ↑ ↑ ↑])
471 (walk [↓ ← ← ← ← ↓ ↓ ↓ ← ← ← ← ←
472 ↑ ↑ ↑ ← ← ↑]) ; to elevator
474 (walk [→ → ↑ ↑]) ; to controls
475 talk
476 select-menu-entry ; to floor 1
477 (walk [↓ ↓ ←])
478 (walk [↓ → ↓ ↓ ↓ ↓ ↓ ↓]) ; leave store
479 (walk [→ → → → → → → → → → ↑])
480 (walk (repeat 23 →))
481 (walk [↑ ↑ ↑ ↑]) ; enter poke center
482 (walk [↑ ↑ ↑ → → → → → → → → → →]) ; to computer
483 (turn ↑))))
485 (defn activate-rlm-pc [script]
486 (->> script
487 talk
488 scroll-text
489 ;;wait-for-cursor
490 (set-cursor 1)
491 select-menu-entry
492 (scroll-text 2)))
494 (defn begin-deposit [script]
495 (->> script
496 (set-cursor 1)
497 select-menu-entry))
499 (defn begin-withdraw [script]
500 (->> script
501 (set-cursor 0)
502 (select-menu-entry)))
504 (defn deposit-held-item-named
505 [item-name quantity [moves state :as script]]
506 (let [index (count
507 (take-while
508 (fn [[name quant]]
509 (or (not= name item-name)
510 (< quant quantity)))
511 (inventory state)))]
512 (println "index" index)
513 (deposit-held-item index quantity script)))
515 (defn open-held-items
516 [script]
517 (->> script
518 select-menu-entry))
520 (defn close-celadon-computer-menu
521 [script]
522 ;; this part was determined via manual binary search
523 ;; because for some reason the current-depth RAM value
524 ;; is the same for both the final menu being either on
525 ;; or off.
526 (->> script
527 (play-moves
528 (concat (repeat 4 []) [[:b]]))))
530 (defn to-held-items
531 [script]
532 (->> script
533 close-menu
534 close-menu
535 close-celadon-computer-menu
536 activate-start-menu
537 open-held-items))
539 (defn toss-pc-item [n quantity [moves state :as script]]
540 (let [total-quantity (second (nth-pc-item state n))]
541 (->> script
542 (set-cursor n)
543 (select-menu-entry 1)
544 (set-quantity total-quantity quantity)
545 (delayed-difference [] [:a] 100 #(search-string % "Is"))
546 (scroll-text)
547 select-menu-entry
548 (scroll-text))))
550 (defn-memo hacking-1
551 ([] (hacking-1 (to-celadon-poke-center)))
552 ([script]
553 (->> script
554 activate-rlm-pc
555 begin-deposit
556 (deposit-held-item-named 0x00 30)
557 (deposit-held-item-named :TM01 63)
558 (deposit-held-item-named :awakening 4)
559 (deposit-held-item-named :thunderstone 98)
560 (deposit-held-item-named :TM09 55)
561 (deposit-held-item-named 0x00 55))))
563 (defn hacking-2
564 ([] (hacking-2 (hacking-1)))
565 ([script]
566 (->> script
567 (to-held-items)
568 (toss-held-item 0 166) ;; discard cruft
569 close-menu
570 close-menu)))
572 (defn-memo hacking-3
573 ([] (hacking-3 (hacking-2)))
574 ([script]
575 (->> script
576 activate-rlm-pc
577 begin-withdraw
578 (widthdraw-pc-item 0 99)
579 (widthdraw-pc-item 0 1)
580 (widthdraw-pc-item 2 0xFE)
581 (widthdraw-pc-item 3 0xFE)
582 close-menu)))
584 (defn-memo hacking-4
585 ([] (hacking-4 (hacking-3)))
586 ([script]
587 (->> script
588 begin-deposit
589 (deposit-held-item 19 243)
590 (deposit-held-item-named :lemonade 16)
591 (deposit-held-item 18 224))))
593 (defn-memo hacking-5
594 "clean out the held-item list again"
595 ([] (hacking-5 (hacking-4)))
596 ([script]
597 (->> script
598 (to-held-items)
599 (toss-held-item 18 30)
600 (toss-held-item 17 1)
601 close-menu
602 close-menu)))
604 (defn-memo hacking-6
605 ([] (hacking-6 (hacking-5)))
606 ([script]
607 (->> script
608 activate-rlm-pc
609 begin-withdraw
610 (widthdraw-pc-item 4 0xFE)
611 (widthdraw-pc-item 5 0xFE)
612 (widthdraw-pc-item 6 0xFE)
613 close-menu)))
615 (defn-memo hacking-7
616 ([] (hacking-7 (hacking-6)))
617 ([script]
618 (->> script
619 begin-deposit
620 (deposit-held-item 19 240)
621 (deposit-held-item 18 230)
622 (deposit-held-item-named :parlyz-heal 55)
623 (deposit-held-item 17 184)
624 (deposit-held-item 17 40)
625 (deposit-held-item-named :TM37 71)
626 (deposit-held-item-named :ice-heal 55)
627 (deposit-held-item-named :fire-stone 23)
628 (deposit-held-item-named :burn-heal 12)
629 ;; as a special case, /don't/ close the menu.
630 )))
632 (defn-memo hacking-8
633 "Clear cruft away from held item list."
634 ([] (hacking-8 (hacking-7)))
635 ([script]
636 (->> script
637 to-held-items
638 (toss-held-item 15 1)
639 (toss-held-item 14 1)
640 (toss-held-item 13 1)
641 close-menu
642 close-menu)))
644 (defn-memo hacking-9
645 ([] (hacking-9 (hacking-8)))
646 ([script]
647 (->> script
648 activate-rlm-pc
649 begin-withdraw
650 (widthdraw-pc-item 7 0xFE)
651 (widthdraw-pc-item 8 0xFC)
652 (widthdraw-pc-item 8 1)
653 (widthdraw-pc-item 8 1)
654 (widthdraw-pc-item 9 0xFE)
655 (multiple-times
656 7
657 (partial combine-pc-items 2))
658 close-menu)))
660 (defn-memo hacking-10
661 ([] (hacking-10 (hacking-9)))
662 ([script]
663 (->> script
664 begin-deposit
665 (deposit-held-item 17 230)
666 (deposit-held-item-named :parlyz-heal 55)
667 (deposit-held-item 14 178)
668 (deposit-held-item-named :water-stone 29)
669 (deposit-held-item 14 32)
670 (deposit-held-item-named :TM18 1)
671 (deposit-held-item 13 1)
672 (deposit-held-item 13 191)
673 (deposit-held-item-named :TM02 98)
674 (deposit-held-item-named :TM09 1)
675 close-menu)))
677 (defn-memo hacking-11
678 ([] (hacking-11 (hacking-10)))
679 ([script]
680 (->> script
681 begin-withdraw
682 (widthdraw-pc-item 3 0xFE)
683 (widthdraw-pc-item 4 0xFE)
684 (widthdraw-pc-item 5 1)
685 (widthdraw-pc-item 5 1)
686 (widthdraw-pc-item 5 1)
687 (widthdraw-pc-item 5 0xFB)
688 (multiple-times
689 3
690 (partial combine-pc-items 2))
691 close-menu)))
693 (defn-memo hacking-12
694 ([] (hacking-12 (hacking-11)))
695 ([script]
696 (->> script
697 begin-deposit
698 (deposit-held-item 18 203)
699 (deposit-held-item-named :guard-spec 87)
700 (deposit-held-item-named :guard-spec 24)
701 (deposit-held-item-named :TM05 1)
702 (multiple-times
703 8
704 (partial deposit-held-item 14 1))
705 (deposit-held-item 14 55)
706 (deposit-held-item-named :x-accuracy 58)
707 (deposit-held-item 14 38)
708 (deposit-held-item-named :TM13 1)
709 (deposit-held-item 13 1)
710 (deposit-held-item 13 233)
711 close-menu)))
713 (defn-memo hacking-13
714 ([] (hacking-13 (hacking-12)))
715 ([script]
716 (->> script
717 (set-cursor-relative 1)
718 (select-menu-entry)
719 (toss-pc-item 1 1)
720 (toss-pc-item 0 156)
721 (toss-pc-item 0 11))))
723 (defn confirm-pattern []
724 (let [start-address (inc pc-item-list-start)
725 target-pattern (pc-item-writer-program)
726 actual-pattern
727 (subvec (vec (memory (second (hacking-13))))
728 start-address
729 (+ start-address (count target-pattern)))]
730 (println target-pattern)
731 (println actual-pattern)
732 (= target-pattern actual-pattern)))
734 (defn-memo go-to-mansion-for-the-lulz
735 ([] (go-to-mansion-for-the-lulz (hacking-13)))
736 ([script]
737 (let [lulz-delay 50]
738 (->> script
739 close-menu
740 close-menu
741 close-celadon-computer-menu
742 (walk [← ← ← ← ← ← ← ← ← ↓ ↓ ↓ ↓])
743 (walk (repeat 17 ←))
744 (walk [↑ → → → → ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
745 (walk [↓ ← ↑])
746 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓
747 ← ← ← ← ↑ ↑ ↑ ← ↑])
748 (talk)
749 (do-nothing lulz-delay)
750 (play-moves [[:a]])
751 (do-nothing lulz-delay)
752 (play-moves [[:a]])
753 close-menu))))
755 (defn-memo launch-bootstrap-program
756 ([] (launch-bootstrap-program
757 (go-to-mansion-for-the-lulz)))
758 ([script]
759 (->> script
760 ;; must corrupt item list again by switching pokemon
761 activate-start-menu ;; \
762 (set-cursor 0) ;; |
763 select-menu-entry ;; |
764 select-menu-entry ;; |
765 (set-cursor 1) ;; | -- switch 9th pokemon
766 select-menu-entry ;; | with 4th pokemon
767 (set-cursor 3) ;; |
768 select-menu-entry ;; |
769 close-menu ;; /
770 ;; now, open items and set map-function to
771 ;; the program inside the item-computer.
772 (set-cursor 1)
773 (select-menu-entry)
774 (toss-held-item 22 12)
775 (switch-held-items 22 40)
776 close-all-menus)))
778 (defn regen-control-checkpoint!
779 [] (write-script! (launch-bootstrap-program) "control-checkpoint"))
781 (defn control-checkpoint []
782 (read-script "control-checkpoint"))
784 (def increasing-pattern [0x01 0x23 0x45 0x67 0x89 0xAB 0xCD 0xEF])
786 (defn test-pattern-writing
787 ([] (test-pattern-writing increasing-pattern))
788 ([pattern]
789 (let [moves (bootstrap-pattern pattern)
790 pattern-insertion
791 (->> (launch-bootstrap-program)
792 (play-moves
793 (take 100 moves)))]
794 (println "Input Pattern:")
795 (apply println (map #(format "0x%02X" %) pattern))
796 (println "\nMemory Listing:")
797 (print-listing (second pattern-insertion)
798 0xD162 (+ 0xD162 (count pattern)))
799 (= (subvec (vec (memory (second pattern-insertion)))
800 0xD162 (+ 0xD162 (count pattern)))
801 pattern))))
803 (defn-memo launch-main-bootstrap-program
804 ([] (launch-main-bootstrap-program
805 ;;(control-checkpoint)
806 (launch-bootstrap-program)
807 ))
808 ([script]
809 (->> script
810 (play-moves
811 (bootstrap-pattern (main-bootstrap-program)))
812 (play-moves
813 (take 253 (interleave (repeat 1000 [:b])
814 (repeat 1000 [])))))))
815 (def bootstrap-start pokemon-list-start)
817 (defn test-main-bootstrap-integrety
818 []
819 (assert
820 (= (main-bootstrap-program)
821 (subvec
822 (vec (memory (second (launch-main-bootstrap-program))))
823 pokemon-list-start
824 (+ pokemon-list-start (count (main-bootstrap-program)))))))
826 (defn set-target-address
827 "Assumes that the game is under control of the main-bootstrap
828 program in MODE-SELECT mode, and sets the target address to which
829 jumps/writes will occur."
830 [target-address script]
831 (let [[target-high target-low] (disect-bytes-2 target-address)]
832 (->> script
833 (play-moves
834 (map buttons
835 [set-H-mode target-high 0x00
836 set-L-mode target-low 0x00])))))
838 (defn write-RAM-segment
839 "Assumes that the game is under control of the main-bootstrap
840 program in MODE-SELECT mode and that target-address has been
841 appropriately set, and writes 255 bytes or less to RAM."
842 [segment script]
843 (->> script
844 (play-moves
845 (map buttons
846 [write-mode (count segment)]))
847 (play-moves (map buttons segment))
848 (play-moves [[]])))
850 (defn write-RAM
851 "Assumes that the game is under control of the main-bootstrap
852 program in MODE-SELECT mode, and rewrites RAM starting at
853 'start-address with 'new-ram."
854 [start-address new-ram script]
855 (loop [s (set-target-address start-address script)
856 to-write new-ram]
857 (if (< (count to-write) 0x100)
858 (write-RAM-segment to-write s)
859 (recur
860 (write-RAM-segment (take 0xFF to-write) s)
861 (drop 0xFF to-write)))))
863 (defn transfer-control
864 "Assumes that the game is under control of the main-bootstrap
865 program in MODE-SELECT mode, and jumps to the target-address."
866 [target-address script]
867 (->> script
868 (set-target-address target-address)
869 (play-moves [(buttons jump-mode)])))
872 (def relocated-bootstrap-start
873 (+ 90 pokemon-box-1-address))
875 (defn-memo relocate-main-bootstrap
876 ([] (relocate-main-bootstrap (launch-main-bootstrap-program)))
877 ([script]
878 (->> script
879 (do-nothing 2)
880 (write-RAM
881 relocated-bootstrap-start
882 (main-bootstrap-program
883 relocated-bootstrap-start))
884 (do-nothing 1)
885 (transfer-control relocated-bootstrap-start)
886 (do-nothing 1))))
888 (defn gen-new-kernel-checkpoint! []
889 (write-script! (do-nothing 10 (relocate-main-bootstrap))
890 "new-kernel"))
892 (defn new-kernel [] (read-script "new-kernel"))
894 (def mid-game-data
895 (subvec (vec (memory (mid-game)))
896 pokemon-list-start
897 (+ pokemon-list-start 697)))
899 (def mid-game-map-address 0x46BC)
901 (defn-memo set-mid-game-data
902 ([] (set-mid-game-data (relocate-main-bootstrap)))
903 ([script]
904 (->> script
905 (do-nothing 10)
906 (write-RAM pokemon-list-start
907 mid-game-data))))
908 (defn test-set-data
909 ([] (test-set-data (relocate-main-bootstrap)))
910 ([script]
911 (->> script
912 (do-nothing 10)
913 (write-RAM pokemon-list-start
914 (repeat 500 0xCC)))))
916 (defn test-mid-game-transfer []
917 (= (subvec (vec (memory (second (set-mid-game-data))))
918 pokemon-list-start
919 (+ pokemon-list-start 500))
920 (subvec (vec (memory (mid-game)))
921 pokemon-list-start
922 (+ pokemon-list-start 500))))
924 (defn-memo return-to-pokemon-kernel
925 ([] (return-to-pokemon-kernel (set-mid-game-data)))
926 ([script]
927 (let [scratch (+ 200 pokemon-box-1-address)
928 return-program
929 (flatten
930 [0xFB
931 0xC3
932 (reverse (disect-bytes-2 mid-game-map-address))])]
933 (->> script
934 (write-RAM scratch return-program)
935 (transfer-control scratch)
936 (do-nothing 1)))))