view clojure/com/aurellem/run/bootstrap_1.clj @ 414:0162dd315814

moved asseitem-writer assembly to rlm-assembly.
author Robert McIntyre <rlm@mit.edu>
date Sat, 14 Apr 2012 03:22:10 -0500
parents 1f14c1b8af7e
children f2f1e0b8c1c7
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]))
10 (defn print-desired-item-layout []
11 (clojure.pprint/pprint
12 (raw-inventory->inventory (pc-item-writer-program))))
14 (defn pc-item-writer-state []
15 (-> (read-state "bootstrap-init")
16 (set-memory pc-item-list-start 50)
17 (set-memory-range
18 map-function-address-start
19 [0x8B 0xD5])
20 (set-memory-range
21 (inc pc-item-list-start)
22 (pc-item-writer-program))))
24 (defn test-pc-item-writer []
25 (let [orig (read-state "pc-item-writer")]
26 (-> orig
27 (print-listing 0xD162 (+ 0xD162 20))
28 (run-moves (reduce concat
29 (repeat 10 [[:a :b :start :select] []])))
30 ((fn [_] (println "===========") _))
31 (print-listing 0xD162 (+ 0xD162 20)))))
33 (defn close-all-menus [[moves state :as script]]
34 (loop [s script]
35 (let [depth (current-depth (second (do-nothing 50 s)))]
36 (println "depth" depth)
37 (if (= depth 1)
38 s
39 (recur (close-menu s))))))
41 (defn-memo name-rival
42 ([] (name-rival (to-rival-name)))
43 ([script]
44 (->> script
45 (first-difference [] [:a] AF)
46 (first-difference [] [:r] DE)
47 (play-moves
48 [[]
49 [] [] [:r] [] [:d] [:a] ;; L
50 [:r] [] [:r] [] [:r] [] [:r] []
51 [:r] [] [:d] [] [:d] [:a] ;; [PK]
52 [:d] [] [:r] [:a]
53 ]))))
55 (defn-memo to-room-pc
56 ([] (to-room-pc (name-rival)))
57 ([script]
58 (->> script
59 finish-title
60 (walk [← ← ↑ ← ↑ ↑ ↑]))))
62 ;; (defn wait-for-quantity
63 ;; [[moves state :as script]]
64 ;; (if (not= (item-quantity-selected state) 1)
65 ;; (repeat-until-different [] item-quantity-selected script)
66 ;; script))
68 ;; TODO use this:
69 ;;(wait-until (partial set-cursor-relative 1))
71 ;; (defn wait-for-cursor
72 ;; [[moves state :as script]]
73 ;; (if (not= (list-offset state) 0)
74 ;; (repeat-until-different [] list-offset script)
75 ;; script))
77 (defn deposit-held-item [n quantity [moves state :as script]]
78 (let [total-quantity (second (nth-item state n))]
79 (println "total-quantity" total-quantity)
80 (->> script
81 (set-cursor n)
82 (select-menu-entry 1)
83 ;;(wait-for-quantity)
84 (set-quantity total-quantity quantity)
85 (delayed-difference [] [:a] 100 #(search-string % "stored"))
86 (scroll-text))))
88 (defn sell-held-item [n quantity [moves state :as script]]
89 (let [total-quantity (second (nth-item state n))]
90 (->> script
91 ;;(wait-for-cursor) ;; when selling, the cursor always
92 (set-cursor n) ;; returns to the top of the list.
93 (select-menu-entry 1)
94 ;;(wait-for-quantity)
95 (set-quantity total-quantity quantity)
96 (delayed-difference [] [:a] 100 current-depth)
97 (play-moves (repeat 20 [:b]))
98 (delayed-difference [] [:a] 100 #(search-string % "What"))
99 )))
101 (defn widthdraw-pc-item [n quantity [moves state :as script]]
102 (let [total-quantity (second (nth-pc-item state n))]
103 (->> script
104 (set-cursor n)
105 (select-menu-entry 1)
106 ;;(wait-for-quantity)
107 (set-quantity total-quantity quantity)
108 (delayed-difference [] [:a] 100 #(search-string % "Withdrew"))
109 (scroll-text))))
111 (defn toss-held-item [n quantity [moves state :as script]]
112 (let [total-quantity (second (nth-item state n))]
113 (->> script
114 (set-cursor n)
115 (select-menu-entry 1)
116 (set-cursor-relative 1)
117 (select-menu-entry -1)
118 ;;(wait-for-quantity)
119 (set-quantity total-quantity quantity)
120 (play-moves [[:a]])
121 (scroll-text)
122 (delayed-difference [] [:a] 100 #(search-string % "Threw"))
123 (scroll-text)
124 )))
126 (defn buy-item [n quantity [moves state :as script]]
127 (->> script
128 (set-cursor n)
129 (purchase-item quantity)))
131 (defn switch-items [item-fn idx-1 idx-2 script]
132 (->> script
133 (wait-until select-menu-entry)
134 (set-cursor idx-1)
135 (wait-until select-menu-entry)
136 (play-moves [[][:select][]])
137 (set-cursor idx-2)
138 (delayed-difference [] [:select] 100
139 #(item-fn % (list-offset %)))))
141 (def switch-pc-items (partial switch-items nth-pc-item))
142 (def switch-held-items (partial switch-items nth-item))
144 (defn combine-pc-items [idx-1 script]
145 (->> script
146 (switch-pc-items idx-1 (inc idx-1))))
148 (def desired-zero-quantities
149 (map second (filter (comp (partial = 0) first)
150 (partition 2 (pc-item-writer-program)))))
152 (defn-memo bootstrap-corrupt-save
153 ([] (bootstrap-corrupt-save (to-room-pc)))
154 ([script]
155 (->> script
156 (do-save-corruption 3)
157 (corrupt-item-list 0)
158 close-all-menus)))
160 (defn-memo prepare-celadon-warp
161 ([] (prepare-celadon-warp (bootstrap-corrupt-save)))
162 ([script]
163 (->> script
164 (activate-start-menu)
165 (set-cursor-relative 1)
166 (select-menu-entry)
167 ;; vastly increase text speed while we're here.
168 (switch-held-items 21 27)
169 (toss-held-item 35 0xFA)
170 (close-all-menus))))
172 (defn-memo begin-initial-deposits
173 ([] (begin-initial-deposits
174 (prepare-celadon-warp)))
175 ([script]
176 (->> script
177 (first-difference [] [:a] AF)
178 (scroll-text)
179 (set-cursor 1)
180 select-menu-entry)))
182 (defn-memo initial-deposits
183 ([] (initial-deposits (begin-initial-deposits)))
184 ([script]
185 (->> script
186 (deposit-held-item 0 0x1)
187 ((fn [script]
188 (reduce
189 (fn [script item] (deposit-held-item item 0xFF script))
190 script
191 (range 3 (+ 13 3)))))
192 close-all-menus)))
195 ;;0 -- 256
196 ;;1 -- 254
197 ;;2 -- 254
198 ;;3 -- 255
200 (defn activate-home-pc
201 [script]
202 (->> script
203 (delayed-difference [] [:a]
204 200 first-character)
205 (scroll-text)))
207 (defn-memo restore-items
208 ([] (restore-items (initial-deposits)))
209 ([script]
210 (->> script
211 activate-home-pc
212 (select-menu-entry)
213 (widthdraw-pc-item 0 1)
214 ;;(widthdraw-pc-item 0 99)
215 ;;(widthdraw-pc-item 1 1)
216 (widthdraw-pc-item 13 255)
217 (close-all-menus))))
219 (defn-memo to-celadon
220 ([] (to-celadon (restore-items)))
221 ([script]
222 (->> script
223 (walk [→ → → → → → → ↑
224 ↓ ↓ ↓ ↓ ↓ ← ← ← ←
225 ↓ ↓]))))
228 ;; celadon store inventory
230 ;; Floor 2
231 ;;=====================================
232 ;; Great Ball TM32 (double-team)
233 ;; Super Potion TM33 (reflect)
234 ;; Revive TM02 (razor-wind)
235 ;; Super Repel TM07 (horn-drill)
236 ;; Antidote TM37 (egg-bomb)
237 ;; Burn Heal TM01 (mega-punch)
238 ;; Ice Heal TM05 (mega-kick)
239 ;; Awakening TM09 (take-down)
240 ;; Parlyz Heal TM17 (submission)
243 ;; Floor 3
244 ;;=====================================
245 ;; TM18 (counter)
248 ;; Floor 4
249 ;;=====================================
250 ;; Poke Doll
251 ;; Fire Stone
252 ;; Thunder Stone
253 ;; Water Stone
254 ;; Leaf Stone
256 ;; Floor 5
257 ;;=====================================
258 ;; X Accuracy HP UP
259 ;; Guard Spec. Protein
260 ;; Dire Hit Iron
261 ;; X Attack Carbos
262 ;; X Defend Calcium
263 ;; X Speed
264 ;; X Special
266 ;; Roof
267 ;;=====================================
268 ;; Fresh Water TM13 (ice-beam)
269 ;; Soda Pop TM48 (rock-slide)
270 ;; Lemonade :) TM49 (tri-attack)
273 (defn-memo go-to-floor-two
274 ([] (go-to-floor-two (to-celadon)))
275 ([script]
276 (->> script
277 (walk [↑ → → → → → → → → → → →
278 ↑ ↑ ↑ ↑ ↑ ↑
279 ← ← ← ←
280 ↓ ↓ ↓
281 ← ←])
282 (first-difference [] ↑ AF))))
284 (defn talk
285 "Assumes that you are facing something that initiates text and
286 causes it to do so."
287 [script]
288 (->> script
289 (delayed-difference [] [:a] 100
290 first-character)))
292 (defn-memo get-money-floor-two
293 ([] (get-money-floor-two (go-to-floor-two)))
294 ([script]
295 (->> script
296 talk
297 (set-cursor 1)
298 (select-menu-entry)
299 (sell-held-item 0 1)
300 (sell-held-item 0 1)
301 (close-menu))))
303 (defn-memo floor-two-TMs
304 ([] (floor-two-TMs (get-money-floor-two)))
305 ([script]
306 (->> script
307 (set-cursor 0)
308 (select-menu-entry)
309 (buy-item 2 98) ;; TM02 (razor-wind)
310 (buy-item 4 71) ;; TM37 (doubleteam)
311 (buy-item 5 63) ;; TM01 (mega-punch)
312 (buy-item 6 1) ;; TM05 (mega-kick)
313 (buy-item 7 56) ;; TM09 (take-down)
314 (close-menu))))
316 (defn end-shop-conversation
317 [script]
318 (->> script
319 (wait-until scroll-text [:b])
320 (play-moves [[] [:b]])
321 close-menu))
323 (defn-memo floor-two-more-money
324 ([] (floor-two-more-money (floor-two-TMs)))
325 ([script]
326 (->> script
327 (set-cursor 1)
328 (select-menu-entry)
329 (sell-held-item 0 1)
330 (sell-held-item 0 1)
331 close-menu
332 end-shop-conversation)))
334 (defn turn [direction script]
335 (->> script
336 (first-difference [] direction AF)))
338 (defn-memo floor-two-items
339 ([] (floor-two-items (floor-two-more-money)))
340 ([script]
341 (->> script
342 (walk [←])
343 (turn ↑)
344 talk
345 select-menu-entry
346 (buy-item 5 12) ;; burn heal
347 (buy-item 6 55) ;; ice heal
348 (buy-item 7 4) ;; awakening
349 (buy-item 8 99) ;; parlyz heal
350 (buy-item 8 55) ;; parlyz heal
351 close-menu
352 end-shop-conversation)))
354 (defn-memo go-to-floor-three
355 ([] (go-to-floor-three (floor-two-items)))
356 ([script]
357 (->> script
358 (walk [→ → → → → → → → → → ↑ ↑ ↑
359 → ↑]))))
360 (defn-memo get-TM18
361 ([] (get-TM18 (go-to-floor-three)))
362 ([script]
363 (->> script
364 (walk [↓ ↓])
365 talk
366 (scroll-text 3)
367 end-text)))
369 (defn-memo go-to-floor-four
370 ([] (go-to-floor-four (get-TM18)))
371 ([script]
372 (->> script
373 (walk [← ← ← ← ↑ ↑
374 ↓ ← ← ↓ ↓ ↓
375 ← ← ← ← ←])
376 (turn ↓))))
378 (defn-memo floor-four-items
379 ([] (floor-four-items (go-to-floor-four)))
380 ([script]
381 (->> script
382 talk
383 select-menu-entry
384 (buy-item 1 23) ;; Fire Stone
385 (buy-item 2 98) ;; Thunder Stone
386 (buy-item 3 29) ;; Water Stone
387 close-menu
388 end-shop-conversation)))
390 (defn-memo go-to-floor-five
391 ([] (go-to-floor-five (floor-four-items)))
392 ([script]
393 (->> script
394 (walk [→ → → → → →
395 ↑ ↑ ↑
396 → → → → → ↑ ;; leave floor four
397 ↓ ← ← ← ← ← ← ← ←
398 ↓ ↓ ↓ ← ← ← ]);; go to five's clerk
399 (turn ↑))))
401 (defn-memo floor-five-items
402 ([] (floor-five-items (go-to-floor-five)))
403 ([script]
404 (->> script
405 talk
406 select-menu-entry
407 (buy-item 0 58) ;; X-Accuracy
408 (buy-item 1 99) ;; Guard Spec.
409 (buy-item 1 24) ;; Guard Spec.
410 close-menu
411 end-shop-conversation)))
413 (defn-memo go-to-roof
414 ([] (go-to-roof (floor-five-items)))
415 ([script]
416 (->> script
417 (walk [→ → → → ↑ ↑ ↑ → → → ↑ ;; leave floor five
418 ↓ ← ← ←]) ;; walk to vending machine
419 (turn ↑))))
421 (defn buy-drink
422 "Assumes you're in front of the vending machine. Buys the indicated
423 drink."
424 [n script]
425 (->> script
426 (do-nothing 20)
427 (play-moves [[:a][:a]])
428 scroll-text
429 (set-cursor n)
430 select-menu-entry
431 close-menu))
433 (defn-memo roof-drinks
434 ([] (roof-drinks (go-to-roof)))
435 ([script]
436 (->> script
437 (buy-drink 0) ;; fresh water (for TM13)
438 ;; buy 16 lemonades
439 ;; LEMONADE is the best item <3 :)
440 (multiple-times 16 (partial buy-drink 2)))))
442 (defn-memo get-TM13
443 ([] (get-TM13 (roof-drinks)))
444 ([script]
445 (->> script
446 ;;(walk [← ← ← ← ← ← ↓])
447 (walk [↓ ↓ ↓ ← ← ← ← ← ←])
448 (play-moves [[][][][][:a][:a][]])
449 (scroll-text 3)
450 select-menu-entry
451 select-menu-entry
452 (scroll-text 6)
453 close-menu)))
455 (defn-memo to-celadon-poke-center
456 ([] (to-celadon-poke-center (get-TM13)))
457 ([script]
458 (->> script
459 ;;(walk [↑ → → → → → → → → → ↑]) ; leave roof
460 (walk [→ → → → → → → → → ↑ ↑ ↑ ↑])
461 (walk [↓ ← ← ← ← ↓ ↓ ↓ ← ← ← ← ←
462 ↑ ↑ ↑ ← ← ↑]) ; to elevator
464 (walk [→ → ↑ ↑]) ; to controls
465 talk
466 select-menu-entry ; to floor 1
467 (walk [↓ ↓ ← ←])
468 (walk [↓ → ↓ ↓ ↓ ↓ ↓ ↓]) ; leave store
469 (walk [↓ → → → → → → → → → → ↑ ↑])
470 (walk (repeat 23 →))
471 (walk [↑ ↑ ↑ ↑]) ; enter poke center
472 (walk [↑ ↑ ↑ → → → → → → → → → →]) ; to computer
473 (turn ↑))))
475 (defn activate-rlm-pc [script]
476 (->> script
477 talk
478 scroll-text
479 ;;wait-for-cursor
480 (set-cursor 1)
481 select-menu-entry
482 (scroll-text 2)))
484 (defn begin-deposit [script]
485 (->> script
486 (set-cursor 1)
487 select-menu-entry))
489 (defn begin-withdraw [script]
490 (->> script
491 (set-cursor 0)
492 (select-menu-entry)))
494 (defn deposit-held-item-named
495 [item-name quantity [moves state :as script]]
496 (let [index (count
497 (take-while
498 (fn [[name quant]]
499 (or (not= name item-name)
500 (< quant quantity)))
501 (inventory state)))]
502 (println "index" index)
503 (deposit-held-item index quantity script)))
505 (defn open-held-items
506 [script]
507 (->> script
508 select-menu-entry))
510 (defn to-held-items
511 [script]
512 (->> script
513 close-menu
514 close-menu
515 end-text;;; grr
517 activate-start-menu
518 open-held-items))
520 (defn toss-pc-item [n quantity [moves state :as script]]
521 (let [total-quantity (second (nth-pc-item state n))]
522 (->> script
523 (set-cursor n)
524 (select-menu-entry 1)
525 (set-quantity total-quantity quantity)
526 (delayed-difference [] [:a] 100 #(search-string % "Is"))
527 (scroll-text)
528 select-menu-entry
529 (scroll-text))))
531 (defn-memo hacking-1
532 ([] (hacking-1 (to-celadon-poke-center)))
533 ([script]
534 (->> script
535 activate-rlm-pc
536 begin-deposit
537 (deposit-held-item-named 0x00 30)
538 (deposit-held-item-named :TM01 63)
539 (deposit-held-item-named :awakening 4)
540 (deposit-held-item-named :thunderstone 98)
541 (deposit-held-item-named :TM09 55)
542 (deposit-held-item-named 0x00 55))))
544 (defn-memo hacking-2
545 ([] (hacking-2 (hacking-1)))
546 ([script]
547 (->> script
548 (to-held-items)
549 (toss-held-item 0 166) ;; discard cruft
550 close-menu
551 close-menu)))
553 (defn-memo hacking-3
554 ([] (hacking-3 (hacking-2)))
555 ([script]
556 (->> script
557 activate-rlm-pc
558 begin-withdraw
559 (widthdraw-pc-item 0 99)
560 (widthdraw-pc-item 0 1)
561 (widthdraw-pc-item 2 0xFE)
562 (widthdraw-pc-item 3 0xFE)
563 close-menu)))
565 (defn-memo hacking-4
566 ([] (hacking-4 (hacking-3)))
567 ([script]
568 (->> script
569 begin-deposit
570 (deposit-held-item 19 243)
571 (deposit-held-item-named :lemonade 16)
572 (deposit-held-item 18 224))))
574 (defn-memo hacking-5
575 "clean out the held-item list again"
576 ([] (hacking-5 (hacking-4)))
577 ([script]
578 (->> script
579 (to-held-items)
580 (toss-held-item 18 30)
581 (toss-held-item 17 1)
582 close-menu
583 close-menu)))
585 (defn-memo hacking-6
586 ([] (hacking-6 (hacking-5)))
587 ([script]
588 (->> script
589 activate-rlm-pc
590 begin-withdraw
591 (widthdraw-pc-item 4 0xFE)
592 (widthdraw-pc-item 5 0xFE)
593 (widthdraw-pc-item 6 0xFE)
594 close-menu)))
596 (defn-memo hacking-7
597 ([] (hacking-7 (hacking-6)))
598 ([script]
599 (->> script
600 begin-deposit
601 (deposit-held-item 19 240)
602 (deposit-held-item 18 230)
603 (deposit-held-item-named :parlyz-heal 55)
604 (deposit-held-item 17 184)
605 (deposit-held-item 17 40)
606 (deposit-held-item-named :TM37 71)
607 (deposit-held-item-named :ice-heal 55)
608 (deposit-held-item-named :fire-stone 23)
609 (deposit-held-item-named :burn-heal 12)
610 ;; as a special case, /don't/ close the menu.
611 )))
613 (defn-memo hacking-8
614 "Clear cruft away from held item list."
615 ([] (hacking-8 (hacking-7)))
616 ([script]
617 (->> script
618 to-held-items
619 (toss-held-item 15 1)
620 (toss-held-item 14 1)
621 (toss-held-item 13 1)
622 close-menu
623 close-menu)))
625 (defn-memo hacking-9
626 ([] (hacking-9 (hacking-8)))
627 ([script]
628 (->> script
629 activate-rlm-pc
630 begin-withdraw
631 (widthdraw-pc-item 7 0xFE)
632 (widthdraw-pc-item 8 0xFC)
633 (widthdraw-pc-item 8 1)
634 (widthdraw-pc-item 8 1)
635 (widthdraw-pc-item 9 0xFE)
636 (multiple-times
637 7
638 (partial combine-pc-items 2))
639 close-menu)))
641 (defn-memo hacking-10
642 ([] (hacking-10 (hacking-9)))
643 ([script]
644 (->> script
645 begin-deposit
646 (deposit-held-item 17 230)
647 (deposit-held-item-named :parlyz-heal 55)
648 (deposit-held-item 14 178)
649 (deposit-held-item-named :water-stone 29)
650 (deposit-held-item 14 32)
651 (deposit-held-item-named :TM18 1)
652 (deposit-held-item 13 1)
653 (deposit-held-item 13 191)
654 (deposit-held-item-named :TM02 98)
655 (deposit-held-item-named :TM09 1)
656 close-menu)))
658 (defn-memo hacking-11
659 ([] (hacking-11 (hacking-10)))
660 ([script]
661 (->> script
662 begin-withdraw
663 (widthdraw-pc-item 3 0xFE)
664 (widthdraw-pc-item 4 0xFE)
665 (widthdraw-pc-item 5 1)
666 (widthdraw-pc-item 5 1)
667 (widthdraw-pc-item 5 1)
668 (widthdraw-pc-item 5 0xFB)
669 (multiple-times
670 3
671 (partial combine-pc-items 2))
672 close-menu)))
674 (defn-memo hacking-12
675 ([] (hacking-12 (hacking-11)))
676 ([script]
677 (->> script
678 begin-deposit
679 (deposit-held-item 18 203)
680 (deposit-held-item-named :guard-spec 87)
681 (deposit-held-item-named :guard-spec 24)
682 (deposit-held-item-named :TM05 1)
683 (multiple-times
684 8
685 (partial deposit-held-item 14 1))
686 (deposit-held-item 14 55)
687 (deposit-held-item-named :x-accuracy 58)
688 (deposit-held-item 14 38)
689 (deposit-held-item-named :TM13 1)
690 (deposit-held-item 13 1)
691 (deposit-held-item 13 233)
692 close-menu)))
694 (defn-memo hacking-13
695 ([] (hacking-13 (hacking-12)))
696 ([script]
697 (->> script
698 (set-cursor-relative 1)
699 (select-menu-entry)
700 (toss-pc-item 1 1)
701 (toss-pc-item 0 156)
702 (toss-pc-item 0 11))))
704 (defn confirm-pattern []
705 (let [start-address (inc pc-item-list-start)
706 target-pattern (pc-item-writer-program)
707 actual-pattern
708 (subvec (vec (memory (second (hacking-13))))
709 start-address
710 (+ start-address (count target-pattern)))]
711 (println target-pattern)
712 (println actual-pattern)
713 (= target-pattern actual-pattern)))
715 (defn-memo go-to-mansion-for-the-lulz
716 ([] (go-to-mansion-for-the-lulz (hacking-13)))
717 ([script]
718 (->> script
719 close-menu
720 close-menu
721 end-text ;;grr
722 (walk [↓ ← ← ← ← ← ← ← ← ← ↓ ↓ ↓])
723 (walk (repeat 17 ←))
724 (walk [↑ → → → → ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
725 (walk [↓ ← ↑])
726 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓
727 ← ← ← ← ↑ ↑ ↑ ← ↑])
728 (talk)
729 (scroll-text 2)
730 (do-nothing 100)
731 close-menu)))
733 (defn-memo launch-bootstrap-program
734 ([] (launch-bootstrap-program
735 (go-to-mansion-for-the-lulz)))
736 ([script]
737 (->> script
738 ;; must corrupt item list again by switching pokemon
739 activate-start-menu ;; \
740 (set-cursor 0) ;; |
741 select-menu-entry ;; |
742 select-menu-entry ;; |
743 (set-cursor 1) ;; | -- switch 9th pokemon
744 select-menu-entry ;; | with 4th pokemon
745 (set-cursor 3) ;; |
746 select-menu-entry ;; |
747 close-menu ;; /
748 ;; now, open items and set map-function to
749 ;; the program inside the item-computer.
750 (set-cursor 1)
751 (select-menu-entry)
752 (toss-held-item 22 12)
753 (switch-held-items 22 40)
754 close-all-menus)))
756 (defn regen-control-checkpoint!
757 [] (write-script! (launch-bootstrap-program) "control-checkpoint"))
759 (defn control-checkpoint []
760 (read-script "control-checkpoint"))
762 (def increasing-pattern [0x01 0x23 0x45 0x67 0x89 0xAB 0xCD 0xEF])
764 (defn test-pattern-writing
765 ([] (test-pattern-writing increasing-pattern))
766 ([pattern]
767 (let [moves (bootstrap-pattern pattern)
768 pattern-insertion
769 (->> (launch-bootstrap-program)
770 (play-moves
771 (take 100 moves)))]
772 (println "Input Pattern:")
773 (apply println (map #(format "0x%02X" %) pattern))
774 (println "\nMemory Listing:")
775 (print-listing (second pattern-insertion)
776 0xD162 (+ 0xD162 (count pattern)))
777 (= (subvec (vec (memory (second pattern-insertion)))
778 0xD162 (+ 0xD162 (count pattern)))
779 pattern))))
781 (defn-memo launch-main-bootstrap-program
782 ([] (launch-main-bootstrap-program
783 (control-checkpoint)
784 ;;(launch-bootstrap-program)
785 ))
786 ([script]
787 (->> script
788 (play-moves
789 (bootstrap-pattern (main-bootstrap-program))))))
791 (defn set-target-address
792 "Assumes that the game is under control of the main-bootstrap
793 program in MODE-SELECT mode, and sets the target address to which
794 jumps/writes will occur."
795 [target-address script]
796 (let [[target-high target-low] (disect-bytes-2 target-address)]
797 (->> script
798 (play-moves
799 (map buttons
800 [set-H-mode target-high 0x00
801 set-L-mode target-low 0x00])))))
803 (defn write-RAM
804 "Assumes that the game is under control of the main-bootstrap
805 program in MODE-SELECT mode, and rewrites RAM starting at
806 'start-address with 'new-ram."
807 [start-address new-ram script]
808 (->> script
809 (set-target-address start-address)
810 (play-moves [(buttons (count new-ram))])
811 (play-moves (map buttons new-ram))))
813 (defn transfer-control
814 "Assumes that the game is under control of the main-bootstrap
815 program in MODE-SELECT mode, and jumps to the target-address."
816 [target-address script]
817 (->> script
818 (set-target-address target-address)
819 (play-moves [(buttons jump-mode)])))
821 (defn-memo relocate-main-bootstrap
822 ([] (relocate-main-bootstrap (launch-main-bootstrap-program)))
823 ([script]
824 (let [target (+ 90 pokemon-box-1-address)]
825 (->> script
826 (write-RAM target (main-bootstrap-program target))
827 (transfer-control target)))))
829 (def mid-game-data
830 (subvec (vec (memory (mid-game)))
831 pokemon-list-start
832 (+ pokemon-list-start 700)))
834 (def mid-game-map-address 0x46BC)
836 (defn set-mid-game-data
837 ([] (set-mid-game-data (relocate-main-bootstrap)))
838 ([script]
839 (->> script
840 (write-RAM pokemon-list-start mid-game-data)
841 (transfer-control mid-game-map-address))))