view clojure/com/aurellem/run/bootstrap_0.clj @ 620:1b52b14868d3 tip

merge.
author rlm <rlm@aurellem.org>
date Sun, 07 Feb 2016 23:16:04 -0800
parents daa3497bbe12
children
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)))
355 (defn exp-item-selection []
356 (clojure.pprint/pprint
357 (apply memory-compare
358 (map read-state
359 ["1-item"
360 "2-items"
361 "3-items"
362 "4-items"
363 ]))))
365 (def item-quantity-selected-address 65432)
367 (defn item-quantity-selected
368 ([^SaveState state]
369 (println "items:" (aget (memory state) item-quantity-selected-address))
370 (aget (memory state) item-quantity-selected-address))
371 ([] (item-quantity-selected @current-state)))
373 (defn wait-until
374 ([script-fn default-key script]
375 (let [wait-time
376 (- (dec (count (first (script-fn script))))
377 (count (first script)))]
378 (println "wait-time" wait-time)
379 (play-moves (repeat wait-time default-key) script)))
380 ([script-fn script]
381 (wait-until script-fn [] script)))
383 (defn set-cursor-relative
384 "Assumes the arrow keys currently control the cursor.
385 Moves the cursor n steps relative to its current
386 position."
387 [n script]
388 (let [key (if (< 0 n) ↓ ↑)]
389 (multiple-times
390 (Math/abs n)
391 (partial first-difference
392 [] key list-offset)
393 script)))
395 (defn set-cursor*
396 [n [moves state :as script]]
397 (let [current-position (list-offset state)
398 difference (- n current-position)]
399 (set-cursor-relative difference script)))
401 (defn set-cursor
402 "Assumes the arrow keys currently control the cursor. Sets
403 the cursor to the desired position. Works for any menu
404 that uses a cursor including the start menu, item menu,
405 pokemon menu, and battle menu."
406 [n [moves state :as script]]
407 (->> script
408 (wait-until (partial set-cursor-relative 1))
409 (set-cursor* n)))
411 (defn first-character [state]
412 (aget (memory state) text-address))
414 (defn first-20-characters [state]
415 (subvec (vec (memory state)) text-address (+ 20 text-address)))
417 (defn set-quantity*
418 "Set the quantity of an item to buy or sell to the desired value
419 using the fewest possible button presses."
420 [total-quantity desired-quantity [moves state :as script]]
421 (cond (= desired-quantity 1) (do (println "1 of 1") script)
422 (= total-quantity desired-quantity)
423 (do (println "get everything!")
424 (delayed-difference [] ↓ 5 item-quantity-selected
425 script))
426 true
427 (let [current-quantity (item-quantity-selected state)
428 loop-point (if (= 0 total-quantity) 0x100 total-quantity)
429 distance (- desired-quantity current-quantity)
430 loop-distance (int(* -1 (Math/signum (float distance))
431 (- loop-point (Math/abs distance))))
432 best-path (first (sort-by #(Math/abs %)
433 [distance loop-distance]))
434 direction (if (< 0 best-path) ↑ ↓)]
435 (println "best-path" best-path)
436 (println "current-quantity" current-quantity)
437 (println "desired-quantity" desired-quantity)
438 (println "options" [distance loop-distance])
439 (reduce
440 (fn [script _]
441 (delayed-difference [] direction 5 item-quantity-selected
442 script))
443 script
444 (range (Math/abs best-path))))))
446 (defn set-quantity
447 ([total-quantity desired-quantity [moves state :as script]]
448 (->> script (wait-until (partial delayed-difference [] [:a] 100
449 first-20-characters))
450 (set-quantity* total-quantity desired-quantity)))
451 ([desired-quantity [moves state :as script]]
452 (set-quantity 99 desired-quantity script)))
455 (defn activate-start-menu [script]
456 (first-difference [:b] [:b :start] AF script))
458 (defn select-menu-entry
459 ([test-direction [moves state :as script]]
460 (->> script
461 (wait-until (partial set-cursor-relative test-direction))
462 (play-moves [[] [:a] []])))
463 ([[moves state :as script]]
464 (select-menu-entry
465 1 script)))
467 (defn restart
468 "The two button presses after a restart event are converted to
469 blanks. Due to weirdness with the VBM format. To compensate, ensure
470 that the two button presses after restart are both blanks."
471 [script]
472 (play-moves [[:restart] [] []] script))
474 (defn do-save-corruption
475 ([] (do-save-corruption
476 (walk-to-counter)))
477 ([script] (do-save-corruption 4 script))
478 ([n script]
479 (->> script
480 activate-start-menu
481 (set-cursor n)
482 select-menu-entry
484 ;; say yes to save game
485 ;; first-difference is faster than select-menu-entry
486 ;; for this special case
487 ;;select-menu-entry
488 (first-difference [:b] [:a] AF)
490 (play-moves
491 ;; this section is copied from speedrun-2942 and corrupts
492 ;; the save so that the total number of pokemon is set to
493 ;; 0xFF, allowing manipulation of non-pokemon data in RAM
494 ;; via the pokemon interface.
495 [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
496 [] [] [] [] [] [] [] [] [] [] [] []])
497 (restart)
498 (title)
499 (first-difference [] [:start] AF)
500 (first-difference [] [:a] AF))))
502 (defn gen-corrupted-checkpoint! []
503 (let [[cor-moves cor-save] (do-save-corruption)]
504 (write-moves! cor-moves "cor-checkpoint")
505 (write-state! cor-save "cor-checkpoint")))
507 (defn corrupted-checkpoint []
508 [(read-moves "cor-checkpoint")
509 (read-state "cor-checkpoint")])
511 (def menu do-nothing )
514 (defn investivate-close-menu []
515 (clojure.pprint/pprint
516 (apply harmonic-compare
517 (map read-state
518 ["start-up-1"
519 "start-down-1"
520 ;;"start-up-2"
521 ;;"start-down-2"
522 ;;"start-up-3"
523 ;;"start-down-3"
524 ;;"computer-up-1"
525 ;;"computer-down-2"
526 "computer-up-2"
527 "computer-down-2"
528 "pokemon-up-1"
529 "pokemon-down-1"
530 "pokemon-up-2"
531 "pokemon-down-2"
532 "item-up-1"
533 "item-down-1"
534 "save-up-1"
535 "save-down-1"
536 "item-nest-up-1"
537 "item-nest-down-1"]))))
539 (def list-nesting-depth-address 50339)
541 (defn current-depth
542 ([^SaveState state] (aget (memory state) list-nesting-depth-address))
543 ([] (current-depth @current-state)))
546 (defn close-menu [script]
547 (delayed-difference
548 [] [:b] 50
549 current-depth
550 script))
553 (defn purchase-item
554 "Assumes that the cursor is over the desired item, and purchases
555 quantity of that item."
556 [n script]
557 (->> script
558 select-menu-entry
559 (set-quantity n)
560 (first-difference [] [:a] AF)
561 scroll-text
562 select-menu-entry
563 scroll-text))
565 (defn-memo corrupt-item-list
566 "Corrupt the num-of-items variable by switching a corrupted pokemon
567 into out-of-bounds memory."
568 ([] (corrupt-item-list
569 ;;(corrupted-checkpoint)
570 (do-save-corruption)
571 ))
572 ([script] (corrupt-item-list 1))
573 ([n script]
574 (->> script
575 activate-start-menu
576 (set-cursor n) ; select "POKEMON"
577 select-menu-entry ; from main menu.
578 (set-cursor 5) ; select 6th pokemon
579 select-menu-entry
580 (set-cursor 1)
581 select-menu-entry
582 (repeat-until-different [] list-offset)
583 (set-cursor 9)
584 select-menu-entry ; switch 6th with 10th
585 close-menu
586 close-menu)))
588 (defn-memo get-lots-of-money
589 "Sell 0xFE cancel buttons to make a tremendous amount of money."
590 ([] (get-lots-of-money (corrupt-item-list)))
591 ([script]
592 (->> script
593 (first-difference [] [:a] AF) ; talk to shopkeep
594 (repeat-until-different [] list-offset)
595 (set-cursor 1)
596 select-menu-entry
597 (repeat-until-different [] list-offset)
598 select-menu-entry
599 (set-quantity 0xFF 0xF7)
600 (first-difference [] [:a] AF)
601 select-menu-entry
602 close-menu)))
604 (defn note [str script]
605 (println str) script)
607 (defn-memo buy-bootstrapping-items
608 "Buy items that will become part of the bootstrapping
609 program."
610 ([] (buy-bootstrapping-items (get-lots-of-money)))
611 ([script]
612 (->> script
613 close-menu
614 select-menu-entry
615 (purchase-item 1) ; buying a pokeball overflows
616 ; the item-counter from 0xFF to 0x00
617 ; repairing the item-list.
618 (set-cursor 1)
619 (purchase-item 1) ; these other items are here to
620 ; protect the burn heals when the
621 (set-cursor 2) ; item list is corrupted again.
622 (purchase-item 1)
624 (set-cursor 3)
625 (purchase-item 1)
627 (set-cursor 4) ; 95 burn-heals spells out the
628 (purchase-item 96) ; return address to the pokemon
629 ; kernel. 96 so that they can be
630 ; deposited without causing a shift.
632 close-menu ; stop talking to shopkeep
633 (wait-until select-menu-entry)
634 (play-moves [[:b]])
635 end-text)))
637 (defn-memo corrupt-item-list-again
638 ([] (corrupt-item-list-again (buy-bootstrapping-items)))
639 ([script]
640 (->> script
641 activate-start-menu
642 (set-cursor-relative 0)
643 select-menu-entry
645 ;; repair list-offset for pokemon-list
646 (set-cursor-relative -1)
648 (set-cursor 4) ; switching it to
649 select-menu-entry ; tenth place.
650 (set-cursor 1)
651 select-menu-entry ; select "switch" on 5th
653 (repeat-until-different [] list-offset)
654 (set-cursor 9) ; goto 10th pokemon
655 select-menu-entry ; do switch
656 close-menu
657 close-menu)))
659 (defn-memo leave-viridian-store
660 ([] (leave-viridian-store (corrupt-item-list-again)))
661 ([script]
662 (->> script
663 ;; leave store
664 (walk [↓ ↓ → ↓]))))
666 (defn force-encounter [direction script]
667 (delayed-improbability-search
668 600
669 #(search-string % "Wild")
670 (partial move direction) script))
672 (defn-memo fight-wild-pokemon
673 ([] (fight-wild-pokemon (leave-viridian-store)))
674 ([script]
675 (->> script
676 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
677 ← ← ← ← ← ← ← ←
678 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])
679 (force-encounter →))))
681 (defn-memo run-from-pokemon
682 ([] (run-from-pokemon (fight-wild-pokemon)))
683 ([script]
684 (->> script
685 (scroll-text)
686 (play-moves [[:a]])
687 (wait-until select-menu-entry)
688 (set-cursor 1)
689 (first-difference [] → AF)
690 (scroll-text)
691 (scroll-text))))
693 (defn-memo to-poke-center-computer
694 ([] (to-poke-center-computer
695 (run-from-pokemon)))
696 ([script]
697 (->> script
698 (walk-thru-grass [→ → ↑])
699 (walk [↑ ← ← ←
700 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
701 ← ←
702 ↑ ↑ ↑ ↑
703 → → → → ↑])
704 (walk [→ →
705 ↑ ↑ ↑
706 → → → → → → → → →])
707 (first-difference [] ↑ AF))))
709 (defn-memo begin-deposits
710 ([] (begin-deposits
711 (to-poke-center-computer)))
712 ([script]
713 (->> script
714 ;; access PC
715 (scroll-text 2)
717 ;; access item storage
718 (menu [[:a] [:d] [:a]])
719 (scroll-text 2)
721 ;; begin deposit
722 (menu [[:d] [:a]])
723 (do-nothing 40))))
725 (defn deposit-n-items
726 [n script]
727 (->> script
728 (do-nothing 100)
729 (play-moves [[:a]])
730 (do-nothing 80)
731 (multiple-times
732 (dec n)
733 (fn [script]
734 (->> script
735 (play-moves [[:u]])
736 (do-nothing 1))))
737 (play-moves [[:a]])
738 (scroll-text)))
740 (defn deposit-one-item
741 [script]
742 (->> script
743 (do-nothing 100)
744 (play-moves [[:a]])
745 (do-nothing 80)
746 (play-moves [[:a]])
747 (scroll-text)))
749 (defn-memo create-header
750 ([] (create-header (begin-deposits)))
751 ([script]
752 (->> script
753 (multiple-times 33 deposit-one-item)
754 (do-nothing 1))))
756 (defn bootstrap-init []
757 [(read-moves "bootstrap-init")
758 (read-state "bootstrap-init")])
760 (defn create-bootstrap-program
761 ([] (create-bootstrap-program
762 (create-header)))
763 ([script]
764 (->> script
765 (do-nothing 120)
766 (menu [↓ ↓ ↓ ↓ ↓ ↓ ↓])
767 ;;(deposit-n-items 33)
769 (menu (repeat 17 ↓))
773 (do-nothing 1))))
776 (defn test-pc-item-program []
777 (-> (read-state "bootstrap-init")
778 (set-memory pc-item-list-start 50)
779 (set-memory-range
780 map-function-address-start [0x8B 0xD5])
781 (set-memory-range
782 (inc pc-item-list-start)
783 (flatten
784 [(repeat
785 28
786 [0xFF 0x01])
787 [;; second part of item manipulation program
788 0x00 ;; this starts at address 0xD56C
789 0x2A ;; save (HL)=(target) to A, increment HL
791 0x00
792 0x47 ;; save A to B
794 0x00
795 0x3A ;; save (target+1) to A, decrement HL
797 0x00
798 0x22 ;; A -> target, increment HL [(target+1) -> target]
800 0x00
801 0x70 ;; load B into target+1 [(target) -> target+1]
803 0x00
804 0xC3 ;; first part of absolute jump
806 0x0C ;; return control to pokemon kernel
807 0x5F]
808 (repeat
809 5
810 [0xFF 0x01])
812 [;; first part of item manipulation program
813 0x00
814 0x21 ;; load target into HL
816 0x94 ;; this is the target address
817 0xD5
819 0x00 ;; relative jump back to first part
820 0x18
822 0xE1 ;; of program
823 0x01
825 0xFF ;; spacer
826 0x01
828 0x04 ;; target ID (pokeball)
829 0x3E ;; target Quantity (lemonade)
830 ]]))))
836 (defn basic-writer [target-address limit return-address]
837 (let [[target-high target-low] (disect-bytes-2 target-address)
838 [return-high return-low] (disect-bytes-2 return-address)]
839 (flatten
840 [0xF3 ;; disable interrupts
842 0x1E ;; load limit into E
843 limit
845 0x21 ;; load target into HL
846 target-low
847 target-high
849 ;; load 1 into C.
850 0x0E ;; C == 1 means input-first nybble
851 0x01 ;; C == 0 means input-second nybble
853 ;; Input Section
855 0x3E ;; load 0x20 into A, to measure dpad
856 0x20
858 0xE0 ;; load A into [FF00]
859 0x00
861 0xF0 ;; load 0xFF00 into A to get
862 0x00 ;; d-pad presses
864 0xE6
865 0x0F ;; select bottom four bits of A
867 0xB8 ;; see if input is different (CP A B)
869 0x28 ;; repeat above steps if input is not different
870 ;; (jump relative backwards if B != A)
871 0xF5 ;; (literal -11)
873 0x47 ;; load A into B
875 0x0D ;; dec C
876 ;; branch based on C:
877 0x20 ;; JR NZ
878 0x07 ;; skip "input first nybble" below
881 ;; input first nybble
883 0xCB
884 0x37 ;; swap nybbles on A
886 0x57 ;; A -> D
888 0x18
889 0xEC ;; literal -20 -- go back to input section
891 ;; input second nybble
893 0x0C ;; inc C
895 0xE6 ;; select bottom bits
896 0x0F
898 0xB2 ;; (OR A D) -> A
900 0x22 ;; (do (A -> (HL)) (INC HL))
902 0x1D ;; (DEC E)
904 0x20 ;; jump back to input section if not done
905 0xE4 ;; literal -28
907 0xFB ;; re-enable interrupts
909 0xC3
910 return-low
911 return-high ])))
914 (defn test-basic-writer []
915 (-> (read-state "bootstrap-init")
916 (set-memory pc-item-list-start 50)
917 (set-memory-range
918 map-function-address-start
919 (reverse (disect-bytes-2 (inc pc-item-list-start))))
920 (set-memory-range
921 (inc pc-item-list-start)
922 (basic-writer 0xD162 10 0x5F0C))))
924 (defn debug-basic-writer []
925 (PC! (test-basic-writer) (inc pc-item-list-start)))
927 (defn d-ticks [state n]
928 (reduce (fn [state _] (d-tick state))
929 state (range n)))
931 (defn d-print [state message]
932 (println message) state)
934 (defn dddd
935 []
936 (-> (debug-basic-writer)
937 (d-ticks 20)
938 (set-memory 0xFF00 0xFF)
939 (d-print "============== second cycle")
940 (d-ticks 14)
941 (d-print "============== end")
942 (d-ticks 20)))
944 ;;TMs at celadon store ---
945 ;;01 (any-number) mega punch
946 ;;02 (any-number) razor wind
947 ;;05 (any-number) mega kick
948 ;;07 (any-number) hyper beam
949 ;;09 (any-number) take down
950 ;;13 (only 1) ice beam
951 ;;17 (any-number) submission
952 ;;18 (only 1) counter
953 ;;32 (any-number) double team
954 ;;33 (any-number) reflect
955 ;;37 (any-number) egg bomb
956 ;;48 (only 1) rock slide
957 ;;49 (only 1) tri attack
960 ;; no-ops
961 ;; 0x00
962 ;; 0xB8 - 0xBF (compares) :garbage
963 ;; 0x3F clear carry flag :s.s.ticket
964 ;; 0x37 set carry flag :guard-spec [!]
965 ;; 0x33 increment SP :poke-doll [!]
966 ;; 0x3B decrement SP :coin
968 ;;0x7F A->A :garbage
969 ;;0x40 B->B :gold-teeth
970 ;;0x49 C->C :poke-flute
971 ;;0x52 D->D :elixer
972 ;;0x5B E->E :garbage
973 ;;0x6D L->L :garbage
974 ;;0x64 H->H :garbage
977 ;;0xC5 push BC :HM02
978 ;;0xD5 push DE :TM13 (ice-beam)
979 ;;0xE5 push HL :TM29 (psychic)
980 ;;0xF5 push AF :TM45 (thunder-wave)
982 ;; 0xA7 (AND A A) :garbage
983 ;; 0xB7 (OR A A) :garbage
985 ;; 0x2F (CPL A) :leaf-stone
988 (defn item-writer
989 "This is the basic writer, optimized to be made of valid
990 item-quantity pairs."
991 [target-address limit return-address]
992 (let [[target-high target-low] (disect-bytes-2 target-address)
993 [return-high return-low] (disect-bytes-2 return-address)]
994 (flatten
995 [
996 ;;0xC5 ;; push junk onto stack
997 ;;0xD5
998 ;;0xE5
999 ;;0xF5
1000 0x33 ;; (item-hack) set increment stack pointer no-op
1001 0x1E ;; load limit into E
1002 limit
1003 0x3F ;; (item-hack) set carry flag no-op
1005 ;; load 2 into C.
1006 0x0E ;; C == 1 means input-first nybble
1007 0x04 ;; C == 0 means input-second nybble
1009 0x21 ;; load target into HL
1010 target-low
1011 target-high
1012 0x37 ;; (item-hack) set carry flag no-op
1014 0x2F ;; (item-hack) cpl A
1015 0x2F ;; (item-hack) cpl A --together a spacer no-op
1017 0x00 ;; (item-hack) no-op
1018 0xF3 ;; disable interrupts
1019 ;; Input Section
1021 0x3E ;; load 0x20 into A, to measure buttons
1022 0x10
1024 0x00 ;; (item-hack) no-op
1025 0xE0 ;; load A into [FF00]
1026 0x00
1028 0xF0 ;; load 0xFF00 into A to get
1029 0x00 ;; button presses
1031 0xE6
1032 0x0F ;; select bottom four bits of A
1033 0x37 ;; (item-hack) set carry flag no-op
1035 0x00 ;; (item-hack) no-op
1036 0xB8 ;; see if input is different (CP A B)
1038 0x00 ;; (item-hack) (INC SP)
1039 0x28 ;; repeat above steps if input is not different
1040 ;; (jump relative backwards if B != A)
1041 0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)
1043 0x47 ;; load A into B
1045 0x0D ;; dec C
1046 0x37 ;; (item-hack) set-carry flag
1047 ;; branch based on C:
1048 0x20 ;; JR NZ
1049 23 ;; skip "input second nybble" and "jump to target" below
1051 ;; input second nybble
1053 0x0C ;; inc C
1054 0x0C ;; inc C
1056 0x00 ;; (item-hack) no-op
1057 0xE6 ;; select bottom bits
1058 0x0F
1059 0x37 ;; (item-hack) set-carry flag no-op
1061 0x00 ;; (item-hack) no-op
1062 0xB2 ;; (OR A D) -> A
1064 0x22 ;; (do (A -> (HL)) (INC HL))
1066 0x1D ;; (DEC E)
1068 0x00 ;; (item-hack)
1069 0x20 ;; jump back to input section if not done
1070 0xDA ;; literal -36 == TM 18 (counter)
1071 0x01 ;; (item-hack) set BC to literal (no-op)
1073 ;; jump to target
1074 0x00 ;; (item-hack) these two bytes can be anything.
1075 0x01
1077 0x00 ;; (item-hack) no-op
1078 0xBF ;; (CP A A) ensures Z
1080 0xCA ;; (item-hack) jump if Z
1081 return-low
1082 return-high
1083 0x01 ;; (item-hack) will never be reached.
1087 ;; input first nybble
1088 0x00
1089 0xCB
1090 0x37 ;; swap nybbles on A
1092 0x57 ;; A -> D
1094 0x37 ;; (item-hack) set carry flag no-op
1095 0x18 ;; relative jump backwards
1096 0xCD ;; literal -51 == TM05; go back to input section
1097 0x01 ;; (item-hack) will never reach this instruction
1099 ])))
1101 (defn test-item-writer []
1102 (-> (read-state "bootstrap-init")
1103 (set-memory pc-item-list-start 50)
1104 (set-memory-range
1105 map-function-address-start
1106 (reverse (disect-bytes-2 (inc pc-item-list-start))))
1107 (set-memory-range
1108 (inc pc-item-list-start)
1109 (item-writer 0xD162 201 0xD162))))
1111 (defn item-writer-state []
1112 (read-state "item-writer"))
1114 (defn test-item-writer-2 []
1115 (let [orig (item-writer-state)]
1116 (-> orig
1117 (print-listing 0xD162 (+ 0xD162 20))
1118 (run-moves (reduce concat
1119 (repeat 10 [[:a :b :start :select] []])))
1120 ((fn [_] (println "===========") _))
1121 (print-listing 0xD162 (+ 0xD162 20)))))