view clojure/com/aurellem/run/bootstrap_1.clj @ 438:067ea3f0d951

can now play midi files with two tracks.
author Robert McIntyre <rlm@mit.edu>
date Wed, 25 Apr 2012 13:46:31 -0500
parents 0b6624c1291c
children cd557c922cec
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-memo 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 (first-difference [] ↑ AF))))
285 (defn talk
286 "Assumes that you are facing something that initiates text and
287 causes it to do so."
288 [script]
289 (->> script
290 (delayed-difference [] [:a] 100
291 first-character)))
293 (defn-memo get-money-floor-two
294 ([] (get-money-floor-two (go-to-floor-two)))
295 ([script]
296 (->> script
297 talk
298 (set-cursor 1)
299 (select-menu-entry)
300 (sell-held-item 0 1)
301 (sell-held-item 0 1)
302 (close-menu))))
304 (defn-memo floor-two-TMs
305 ([] (floor-two-TMs (get-money-floor-two)))
306 ([script]
307 (->> script
308 (set-cursor 0)
309 (select-menu-entry)
310 (buy-item 2 98) ;; TM02 (razor-wind)
311 (buy-item 4 71) ;; TM37 (doubleteam)
312 (buy-item 5 63) ;; TM01 (mega-punch)
313 (buy-item 6 1) ;; TM05 (mega-kick)
314 (buy-item 7 56) ;; TM09 (take-down)
315 (close-menu))))
317 (defn end-shop-conversation
318 [script]
319 (->> script
320 (wait-until scroll-text [:b])
321 (play-moves [[] [:b]])
322 close-menu))
324 (defn-memo floor-two-more-money
325 ([] (floor-two-more-money (floor-two-TMs)))
326 ([script]
327 (->> script
328 (set-cursor 1)
329 (select-menu-entry)
330 (sell-held-item 0 1)
331 (sell-held-item 0 1)
332 close-menu
333 end-shop-conversation)))
335 (defn turn [direction script]
336 (->> script
337 (first-difference [] direction AF)))
339 (defn-memo floor-two-items
340 ([] (floor-two-items (floor-two-more-money)))
341 ([script]
342 (->> script
343 (walk [←])
344 (turn ↑)
345 talk
346 select-menu-entry
347 (buy-item 5 12) ;; burn heal
348 (buy-item 6 55) ;; ice heal
349 (buy-item 7 4) ;; awakening
350 (buy-item 8 99) ;; parlyz heal
351 (buy-item 8 55) ;; parlyz heal
352 close-menu
353 end-shop-conversation)))
355 (defn-memo go-to-floor-three
356 ([] (go-to-floor-three (floor-two-items)))
357 ([script]
358 (->> script
359 (walk [→ → → → → → → → → → ↑ ↑ ↑
360 → ↑]))))
361 (defn-memo get-TM18
362 ([] (get-TM18 (go-to-floor-three)))
363 ([script]
364 (->> script
365 (walk [↓ ↓])
366 talk
367 (scroll-text 3)
368 end-text)))
370 (defn-memo go-to-floor-four
371 ([] (go-to-floor-four (get-TM18)))
372 ([script]
373 (->> script
374 (walk [← ← ← ← ↑ ↑
375 ↓ ← ← ↓ ↓ ↓
376 ← ← ← ← ←])
377 (turn ↓))))
379 (defn-memo floor-four-items
380 ([] (floor-four-items (go-to-floor-four)))
381 ([script]
382 (->> script
383 talk
384 select-menu-entry
385 (buy-item 1 23) ;; Fire Stone
386 (buy-item 2 98) ;; Thunder Stone
387 (buy-item 3 29) ;; Water Stone
388 close-menu
389 end-shop-conversation)))
391 (defn-memo go-to-floor-five
392 ([] (go-to-floor-five (floor-four-items)))
393 ([script]
394 (->> script
395 (walk [→ → → → → →
396 ↑ ↑ ↑
397 → → → → → ↑ ;; leave floor four
398 ↓ ← ← ← ← ← ← ← ←
399 ↓ ↓ ↓ ← ← ← ]);; go to five's clerk
400 (turn ↑))))
402 (defn-memo floor-five-items
403 ([] (floor-five-items (go-to-floor-five)))
404 ([script]
405 (->> script
406 talk
407 select-menu-entry
408 (buy-item 0 58) ;; X-Accuracy
409 (buy-item 1 99) ;; Guard Spec.
410 (buy-item 1 24) ;; Guard Spec.
411 close-menu
412 end-shop-conversation)))
414 (defn-memo go-to-roof
415 ([] (go-to-roof (floor-five-items)))
416 ([script]
417 (->> script
418 (walk [→ → → → ↑ ↑ ↑ → → → ↑ ;; leave floor five
419 ↓ ← ← ←]) ;; walk to vending machine
420 (turn ↑))))
422 (defn buy-drink
423 "Assumes you're in front of the vending machine. Buys the indicated
424 drink."
425 [n script]
426 (->> script
427 (do-nothing 20)
428 (play-moves [[:a][:a]])
429 scroll-text
430 (set-cursor n)
431 select-menu-entry
432 close-menu))
434 (defn-memo roof-drinks
435 ([] (roof-drinks (go-to-roof)))
436 ([script]
437 (->> script
438 (buy-drink 0) ;; fresh water (for TM13)
439 ;; buy 16 lemonades
440 ;; LEMONADE is the best item <3 :)
441 (multiple-times 16 (partial buy-drink 2)))))
443 (defn-memo get-TM13
444 ([] (get-TM13 (roof-drinks)))
445 ([script]
446 (->> script
447 ;;(walk [← ← ← ← ← ← ↓])
448 (walk [↓ ↓ ↓ ← ← ← ← ← ←])
449 (play-moves [[][][][][:a][:a][]])
450 (scroll-text 3)
451 select-menu-entry
452 select-menu-entry
453 (scroll-text 6)
454 close-menu)))
456 (defn-memo to-celadon-poke-center
457 ([] (to-celadon-poke-center (get-TM13)))
458 ([script]
459 (->> script
460 ;;(walk [↑ → → → → → → → → → ↑]) ; leave roof
461 (walk [→ → → → → → → → → ↑ ↑ ↑ ↑])
462 (walk [↓ ← ← ← ← ↓ ↓ ↓ ← ← ← ← ←
463 ↑ ↑ ↑ ← ← ↑]) ; to elevator
465 (walk [→ → ↑ ↑]) ; to controls
466 talk
467 select-menu-entry ; to floor 1
468 (walk [↓ ↓ ← ←])
469 (walk [↓ → ↓ ↓ ↓ ↓ ↓ ↓]) ; leave store
470 (walk [↓ → → → → → → → → → → ↑ ↑])
471 (walk (repeat 23 →))
472 (walk [↑ ↑ ↑ ↑]) ; enter poke center
473 (walk [↑ ↑ ↑ → → → → → → → → → →]) ; to computer
474 (turn ↑))))
476 (defn activate-rlm-pc [script]
477 (->> script
478 talk
479 scroll-text
480 ;;wait-for-cursor
481 (set-cursor 1)
482 select-menu-entry
483 (scroll-text 2)))
485 (defn begin-deposit [script]
486 (->> script
487 (set-cursor 1)
488 select-menu-entry))
490 (defn begin-withdraw [script]
491 (->> script
492 (set-cursor 0)
493 (select-menu-entry)))
495 (defn deposit-held-item-named
496 [item-name quantity [moves state :as script]]
497 (let [index (count
498 (take-while
499 (fn [[name quant]]
500 (or (not= name item-name)
501 (< quant quantity)))
502 (inventory state)))]
503 (println "index" index)
504 (deposit-held-item index quantity script)))
506 (defn open-held-items
507 [script]
508 (->> script
509 select-menu-entry))
511 (defn to-held-items
512 [script]
513 (->> script
514 close-menu
515 close-menu
516 end-text;;; grr
518 activate-start-menu
519 open-held-items))
521 (defn toss-pc-item [n quantity [moves state :as script]]
522 (let [total-quantity (second (nth-pc-item state n))]
523 (->> script
524 (set-cursor n)
525 (select-menu-entry 1)
526 (set-quantity total-quantity quantity)
527 (delayed-difference [] [:a] 100 #(search-string % "Is"))
528 (scroll-text)
529 select-menu-entry
530 (scroll-text))))
532 (defn-memo hacking-1
533 ([] (hacking-1 (to-celadon-poke-center)))
534 ([script]
535 (->> script
536 activate-rlm-pc
537 begin-deposit
538 (deposit-held-item-named 0x00 30)
539 (deposit-held-item-named :TM01 63)
540 (deposit-held-item-named :awakening 4)
541 (deposit-held-item-named :thunderstone 98)
542 (deposit-held-item-named :TM09 55)
543 (deposit-held-item-named 0x00 55))))
545 (defn-memo hacking-2
546 ([] (hacking-2 (hacking-1)))
547 ([script]
548 (->> script
549 (to-held-items)
550 (toss-held-item 0 166) ;; discard cruft
551 close-menu
552 close-menu)))
554 (defn-memo hacking-3
555 ([] (hacking-3 (hacking-2)))
556 ([script]
557 (->> script
558 activate-rlm-pc
559 begin-withdraw
560 (widthdraw-pc-item 0 99)
561 (widthdraw-pc-item 0 1)
562 (widthdraw-pc-item 2 0xFE)
563 (widthdraw-pc-item 3 0xFE)
564 close-menu)))
566 (defn-memo hacking-4
567 ([] (hacking-4 (hacking-3)))
568 ([script]
569 (->> script
570 begin-deposit
571 (deposit-held-item 19 243)
572 (deposit-held-item-named :lemonade 16)
573 (deposit-held-item 18 224))))
575 (defn-memo hacking-5
576 "clean out the held-item list again"
577 ([] (hacking-5 (hacking-4)))
578 ([script]
579 (->> script
580 (to-held-items)
581 (toss-held-item 18 30)
582 (toss-held-item 17 1)
583 close-menu
584 close-menu)))
586 (defn-memo hacking-6
587 ([] (hacking-6 (hacking-5)))
588 ([script]
589 (->> script
590 activate-rlm-pc
591 begin-withdraw
592 (widthdraw-pc-item 4 0xFE)
593 (widthdraw-pc-item 5 0xFE)
594 (widthdraw-pc-item 6 0xFE)
595 close-menu)))
597 (defn-memo hacking-7
598 ([] (hacking-7 (hacking-6)))
599 ([script]
600 (->> script
601 begin-deposit
602 (deposit-held-item 19 240)
603 (deposit-held-item 18 230)
604 (deposit-held-item-named :parlyz-heal 55)
605 (deposit-held-item 17 184)
606 (deposit-held-item 17 40)
607 (deposit-held-item-named :TM37 71)
608 (deposit-held-item-named :ice-heal 55)
609 (deposit-held-item-named :fire-stone 23)
610 (deposit-held-item-named :burn-heal 12)
611 ;; as a special case, /don't/ close the menu.
612 )))
614 (defn-memo hacking-8
615 "Clear cruft away from held item list."
616 ([] (hacking-8 (hacking-7)))
617 ([script]
618 (->> script
619 to-held-items
620 (toss-held-item 15 1)
621 (toss-held-item 14 1)
622 (toss-held-item 13 1)
623 close-menu
624 close-menu)))
626 (defn-memo hacking-9
627 ([] (hacking-9 (hacking-8)))
628 ([script]
629 (->> script
630 activate-rlm-pc
631 begin-withdraw
632 (widthdraw-pc-item 7 0xFE)
633 (widthdraw-pc-item 8 0xFC)
634 (widthdraw-pc-item 8 1)
635 (widthdraw-pc-item 8 1)
636 (widthdraw-pc-item 9 0xFE)
637 (multiple-times
638 7
639 (partial combine-pc-items 2))
640 close-menu)))
642 (defn-memo hacking-10
643 ([] (hacking-10 (hacking-9)))
644 ([script]
645 (->> script
646 begin-deposit
647 (deposit-held-item 17 230)
648 (deposit-held-item-named :parlyz-heal 55)
649 (deposit-held-item 14 178)
650 (deposit-held-item-named :water-stone 29)
651 (deposit-held-item 14 32)
652 (deposit-held-item-named :TM18 1)
653 (deposit-held-item 13 1)
654 (deposit-held-item 13 191)
655 (deposit-held-item-named :TM02 98)
656 (deposit-held-item-named :TM09 1)
657 close-menu)))
659 (defn-memo hacking-11
660 ([] (hacking-11 (hacking-10)))
661 ([script]
662 (->> script
663 begin-withdraw
664 (widthdraw-pc-item 3 0xFE)
665 (widthdraw-pc-item 4 0xFE)
666 (widthdraw-pc-item 5 1)
667 (widthdraw-pc-item 5 1)
668 (widthdraw-pc-item 5 1)
669 (widthdraw-pc-item 5 0xFB)
670 (multiple-times
671 3
672 (partial combine-pc-items 2))
673 close-menu)))
675 (defn-memo hacking-12
676 ([] (hacking-12 (hacking-11)))
677 ([script]
678 (->> script
679 begin-deposit
680 (deposit-held-item 18 203)
681 (deposit-held-item-named :guard-spec 87)
682 (deposit-held-item-named :guard-spec 24)
683 (deposit-held-item-named :TM05 1)
684 (multiple-times
685 8
686 (partial deposit-held-item 14 1))
687 (deposit-held-item 14 55)
688 (deposit-held-item-named :x-accuracy 58)
689 (deposit-held-item 14 38)
690 (deposit-held-item-named :TM13 1)
691 (deposit-held-item 13 1)
692 (deposit-held-item 13 233)
693 close-menu)))
695 (defn-memo hacking-13
696 ([] (hacking-13 (hacking-12)))
697 ([script]
698 (->> script
699 (set-cursor-relative 1)
700 (select-menu-entry)
701 (toss-pc-item 1 1)
702 (toss-pc-item 0 156)
703 (toss-pc-item 0 11))))
705 (defn confirm-pattern []
706 (let [start-address (inc pc-item-list-start)
707 target-pattern (pc-item-writer-program)
708 actual-pattern
709 (subvec (vec (memory (second (hacking-13))))
710 start-address
711 (+ start-address (count target-pattern)))]
712 (println target-pattern)
713 (println actual-pattern)
714 (= target-pattern actual-pattern)))
716 (defn-memo go-to-mansion-for-the-lulz
717 ([] (go-to-mansion-for-the-lulz (hacking-13)))
718 ([script]
719 (->> script
720 close-menu
721 close-menu
722 end-text ;;grr
723 (walk [↓ ← ← ← ← ← ← ← ← ← ↓ ↓ ↓])
724 (walk (repeat 17 ←))
725 (walk [↑ → → → → ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
726 (walk [↓ ← ↑])
727 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓
728 ← ← ← ← ↑ ↑ ↑ ← ↑])
729 (talk)
730 (scroll-text 2)
731 (do-nothing 100)
732 close-menu)))
734 (defn-memo launch-bootstrap-program
735 ([] (launch-bootstrap-program
736 (go-to-mansion-for-the-lulz)))
737 ([script]
738 (->> script
739 ;; must corrupt item list again by switching pokemon
740 activate-start-menu ;; \
741 (set-cursor 0) ;; |
742 select-menu-entry ;; |
743 select-menu-entry ;; |
744 (set-cursor 1) ;; | -- switch 9th pokemon
745 select-menu-entry ;; | with 4th pokemon
746 (set-cursor 3) ;; |
747 select-menu-entry ;; |
748 close-menu ;; /
749 ;; now, open items and set map-function to
750 ;; the program inside the item-computer.
751 (set-cursor 1)
752 (select-menu-entry)
753 (toss-held-item 22 12)
754 (switch-held-items 22 40)
755 close-all-menus)))
757 (defn regen-control-checkpoint!
758 [] (write-script! (launch-bootstrap-program) "control-checkpoint"))
760 (defn control-checkpoint []
761 (read-script "control-checkpoint"))
763 (def increasing-pattern [0x01 0x23 0x45 0x67 0x89 0xAB 0xCD 0xEF])
765 (defn test-pattern-writing
766 ([] (test-pattern-writing increasing-pattern))
767 ([pattern]
768 (let [moves (bootstrap-pattern pattern)
769 pattern-insertion
770 (->> (launch-bootstrap-program)
771 (play-moves
772 (take 100 moves)))]
773 (println "Input Pattern:")
774 (apply println (map #(format "0x%02X" %) pattern))
775 (println "\nMemory Listing:")
776 (print-listing (second pattern-insertion)
777 0xD162 (+ 0xD162 (count pattern)))
778 (= (subvec (vec (memory (second pattern-insertion)))
779 0xD162 (+ 0xD162 (count pattern)))
780 pattern))))
782 (defn-memo launch-main-bootstrap-program
783 ([] (launch-main-bootstrap-program
784 (control-checkpoint)
785 ;;(launch-bootstrap-program)
786 ))
787 ([script]
788 (->> script
789 (play-moves
790 (bootstrap-pattern (main-bootstrap-program)))
791 (play-moves
792 (take 253 (interleave (repeat 1000 [:b])
793 (repeat 1000 [])))))))
795 (defn test-main-bootstrap-integrety
796 []
797 (assert
798 (= (main-bootstrap-program)
799 (subvec (vec (memory (second (launch-main-bootstrap-program))))
800 pokemon-list-start
801 (+ pokemon-list-start (count (main-bootstrap-program)))))))
803 (defn set-target-address
804 "Assumes that the game is under control of the main-bootstrap
805 program in MODE-SELECT mode, and sets the target address to which
806 jumps/writes will occur."
807 [target-address script]
808 (let [[target-high target-low] (disect-bytes-2 target-address)]
809 (->> script
810 (play-moves
811 (map buttons
812 [set-H-mode target-high 0x00
813 set-L-mode target-low 0x00])))))
815 (defn write-RAM-segment
816 "Assumes that the game is under control of the main-bootstrap
817 program in MODE-SELECT mode and that target-address has been
818 appropriately set, and writes 255 bytes or less to RAM."
819 [segment script]
820 (->> script
821 (play-moves
822 (map buttons
823 [write-mode (count segment)]))
824 (play-moves (map buttons segment))
825 (play-moves [[]])))
827 (defn write-RAM
828 "Assumes that the game is under control of the main-bootstrap
829 program in MODE-SELECT mode, and rewrites RAM starting at
830 'start-address with 'new-ram."
831 [start-address new-ram script]
832 (loop [s (set-target-address start-address script)
833 to-write new-ram]
834 (if (< (count to-write) 0x100)
835 (write-RAM-segment to-write s)
836 (recur
837 (write-RAM-segment (take 0xFF to-write) s)
838 (drop 0xFF to-write)))))
840 (defn transfer-control
841 "Assumes that the game is under control of the main-bootstrap
842 program in MODE-SELECT mode, and jumps to the target-address."
843 [target-address script]
844 (->> script
845 (set-target-address target-address)
846 (play-moves [(buttons jump-mode)])))
848 (def box-target (+ 90 pokemon-box-1-address))
850 (defn-memo relocate-main-bootstrap
851 ([] (relocate-main-bootstrap (launch-main-bootstrap-program)))
852 ([script]
853 (let [target (+ 90 pokemon-box-1-address)]
854 (->> script
855 (do-nothing 2)
856 (write-RAM target (main-bootstrap-program target))
857 (do-nothing 1)
858 (transfer-control target)
859 (do-nothing 1)))))
861 (defn gen-new-kernel-checkpoint! []
862 (write-script! (do-nothing 10 (relocate-main-bootstrap))
863 "new-kernel"))
865 (defn new-kernel [] (read-script "new-kernel"))
868 (def mid-game-data
869 (subvec (vec (memory (mid-game)))
870 pokemon-list-start
871 (+ pokemon-list-start 697)))
873 (def mid-game-map-address 0x46BC)
875 (defn-memo set-mid-game-data
876 ([] (set-mid-game-data (relocate-main-bootstrap)))
877 ([script]
878 (->> script
879 (do-nothing 10)
880 (write-RAM pokemon-list-start
881 mid-game-data))))
882 (defn test-set-data
883 ([] (test-set-data (relocate-main-bootstrap)))
884 ([script]
885 (->> script
886 (do-nothing 10)
887 (write-RAM pokemon-list-start
888 (repeat 500 0xCC)))))
890 (defn test-mid-game-transfer []
891 (= (subvec (vec (memory (second (set-mid-game-data))))
892 pokemon-list-start
893 (+ pokemon-list-start 500))
894 (subvec (vec (memory (mid-game)))
895 pokemon-list-start
896 (+ pokemon-list-start 500))))
898 (defn-memo return-to-pokemon-kernel
899 ([] (return-to-pokemon-kernel (set-mid-game-data)))
900 ([script]
901 (let [scratch (+ 200 pokemon-box-1-address)
902 return-program
903 (flatten
904 [0xFB
905 0xC3
906 (reverse (disect-bytes-2 mid-game-map-address))])]
907 (->> script
908 (write-RAM scratch return-program)
909 (transfer-control scratch)
910 (do-nothing 1)))))