Mercurial > vba-clojure
view clojure/com/aurellem/run/bootstrap_0.clj @ 407:03ade2a04458
Astoundingly, it is not generally possible to convert decimal representations into hexadecimal simply by prepending 0x.
author | Dylan Holmes <ocsenave@gmail.com> |
---|---|
date | Thu, 12 Apr 2012 22:30:03 -0500 |
parents | abcc522a3242 |
children | daa3497bbe12 |
line wrap: on
line source
1 (ns com.aurellem.run.bootstrap-02 (:use (com.aurellem.gb saves gb-driver util3 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-name12 ([] (to-rival-name (boot-root)))13 ([script]14 (->> script15 title16 oak17 name-entry-rlm18 (scroll-text 5))))20 (defn-memo name-rival-bootstrap21 ([] (name-rival-bootstrap (to-rival-name)))22 ([script]23 (->> script24 (first-difference [] [:a] AF)25 (first-difference [] [:r] DE)26 (play-moves27 [[]28 [] [] [:r] [] [:d] [:a] ;; L29 [:r] [] [:r] [] [:r] [] [:r] []30 [:r] [] [:d] [] [:d] [:a] ;; [PK]31 [:u] [] [:l] [] [:l] []32 [:l] [] [:l] [] [:l] [:a] ;; U33 [:r] [] [:r] [] [:r] []34 [:r] [] [:r] [] [:d] [:a] ;; [PK]35 [] [:a] ;; [PK]36 [] [:a] ;; [PK]37 [:r] [] [:d] [:a] ;; END38 ]))))40 (defn-memo leave-house41 ([] (leave-house (name-rival-bootstrap)))42 ([script]43 (->> script44 finish-title45 walk-to-stairs46 walk-to-door47 (walk [↓ ↓]))))49 (defn-memo to-pallet-town-edge50 ([] (to-pallet-town-edge (leave-house)))51 ([script]52 (->> script53 (walk [→ → → → →54 ↑ ↑ ↑ ↑ ↑ ↑]))))56 (defn-memo start-pikachu-battle57 ([] (start-pikachu-battle58 (to-pallet-town-edge)))59 ([script]60 (->> script61 (first-difference [:b] [:b :a] DE)62 scroll-text63 (do-nothing 200)64 (play-moves [[:b]]))))66 (defn-memo capture-pikachu67 ([] (capture-pikachu (start-pikachu-battle)))68 ([script]69 (->> script70 (scroll-text 3))))72 (defn-memo go-to-lab73 ([] (go-to-lab (capture-pikachu)))74 ([script]75 (->> script76 end-text77 (scroll-text 5)78 end-text79 ;; oak walks you to his lab; no input required.80 (do-nothing 400))))82 (defn-memo talk-to-oak-in-lab83 ([] (talk-to-oak-in-lab (go-to-lab)))84 ([script]85 (->> script86 (scroll-text 14)87 end-text)))89 (defn-memo try-to-get-eevee90 ([] (try-to-get-eevee (talk-to-oak-in-lab)))91 ([script]92 (->> script93 ;; walk to pokeball94 (walk [↓ → →])95 ;; and try to grab it96 (play-moves97 (concat [↑ ↑ [:a]]98 (repeat 100 [])))99 (scroll-text 10)100 (end-text))))102 (defn-memo obtain-pikachu103 ([] (obtain-pikachu (try-to-get-eevee)))104 ([script]105 (->> script106 (scroll-text 6)107 (end-text))))110 (defn-memo begin-battle-with-rival111 ([] (begin-battle-with-rival112 (obtain-pikachu)))113 ([script]114 (->> script115 (walk [↓ ↓ ↓])116 (scroll-text 3)117 (end-text)118 (scroll-text))))120 (defn-memo defeat-eevee121 ([] (defeat-eevee122 (begin-battle-with-rival)))123 ([script]124 (->> script125 (do-nothing 400)126 (play-moves [[:a]])127 (critical-hit)128 (do-nothing 200)129 (scroll-text 2) ;; for eevee's tail-whip130 (do-nothing 10)131 (play-moves [[:a]])132 (critical-hit)133 (do-nothing 200)134 (scroll-text 2) ;; tail whip again135 (do-nothing 10)136 (play-moves [[:a]])137 (critical-hit)138 (do-nothing 200))))140 (defn-memo finish-rival-text141 ([] (finish-rival-text142 (defeat-eevee)))143 ([script]144 (->> script145 (scroll-text 12)146 (end-text))))148 (defn-memo pikachu-comes-out149 ([] (pikachu-comes-out150 (finish-rival-text)))151 ([script]152 (->> script153 (scroll-text 8)154 (end-text))))156 (defn-memo leave-oaks-lab157 ([] (leave-oaks-lab158 (pikachu-comes-out)))159 ([script]160 (->> script161 (walk [↓ ↓ ↓ ↓ ↓ ↓]))))163 (defn-memo oaks-lab->pallet-town-edge164 ([] (oaks-lab->pallet-town-edge165 (leave-oaks-lab)))166 ([script]167 (->> script168 (walk [← ← ←169 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ →]))))171 (defn-memo pallet-edge->viridian-mart172 ([] (pallet-edge->viridian-mart true173 (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 (->> script183 ;; leave straight grass184 (walk-thru-grass185 [↑ ↑ ↑ ↑ ↑])187 (walk [↑ ↑ ↑ ↑])189 (walk-thru-grass190 [← ← ↑])192 (walk [↑ ↑ ↑ ↑ → → → ])194 (walk-thru-grass195 [→ ↑ ↑ ←])197 (walk198 [← ←199 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑200 → → → → ])202 ;; this part is dependent on that203 ;; stupid NPC in the grass patch204 (walk-thru-grass205 (concat dodge-1206 [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ]))208 (walk209 (concat210 dodge-2211 [← ← ←212 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑213 ← ←214 ↑ ↑ ↑ ↑215 → → → → → → → → → →216 ↑ ↑ ↑ ↑ ↑ ↑ ↑]))))))218 (defn-memo get-oaks-parcel219 ([] (get-oaks-parcel220 (pallet-edge->viridian-mart)))221 ([script]222 (->> script223 (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-lab231 ([] (viridian-store->oaks-lab232 (get-oaks-parcel)))233 ([script]234 (->> script235 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓236 ← ← ← ← ← ← ← ← ←237 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓238 ← ←239 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓240 ↓ ↓ ↓ ↓ ↓ ↓ ↓241 → → → → → → → →242 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓243 ← ← ← ← ←244 ↓ ↓ ↓ ↓245 ])246 (walk-thru-grass247 [↓ ↓ ↓ ↓ ↓ ↓ ↓])248 (walk [↓ ↓ ← ↓ ↓ ↓ ←249 ↓ ↓ ↓ ↓ ↓ ↓250 → → → ↑])252 (do-nothing 1))))255 (defn-memo viridian-store->oaks-lab-like-a-boss256 ([] (viridian-store->oaks-lab-like-a-boss257 (get-oaks-parcel)))258 ([script]259 (->> script260 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓261 ← ← ← ← ← ← ← ← ←262 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])264 (walk-thru-grass265 [↓ ↓ ↓ ↓ ↓])267 (walk268 [↓ ↓ ← ↓269 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓270 → → → ↓])272 (walk-thru-grass273 [↓ ↓ ↓])275 (walk [↓ ← ← ↓ ↓ ↓ ↓ ↓ ↓])277 (walk-thru-grass278 [↓ ↓ ↓ ↓ ↓ ↓])280 (walk [↓ ↓ ↓ ← ↓ ↓ ↓281 ↓ ↓ ↓ ↓ ↓282 → → → ↑]))))284 (defn-memo deliver-oaks-parcel285 ([] (deliver-oaks-parcel286 (viridian-store->oaks-lab-like-a-boss)))287 ([script]288 (->> script289 (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-mart307 ([] (return-to-viridian-mart308 (deliver-oaks-parcel)))309 ([script]310 (->> script311 oaks-lab->pallet-town-edge312 (pallet-edge->viridian-mart false))))314 (defn-memo walk-to-counter315 ([] (walk-to-counter316 (return-to-viridian-mart)))317 ([script]318 (->> script319 (walk [↑ ↑ ←]))))323 ;; useful addresses324 52262 ;; --- current-cursor-offset325 52278 ;; --- current screen-offset328 (defn exp-item-list []329 (clojure.pprint/pprint330 (apply harmonic-compare331 (map read-state332 ["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 position341 ;; for all lists in the game (start list, pokemon list, shop342 ;; lists, inventory lists, battle list, basically343 ;; everything!)345 (def list-cursor-offset-address 52262)346 (def list-screen-offset-address 52278)348 (defn list-offset349 ([^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/pprint357 (apply memory-compare358 (map read-state359 ["1-item"360 "2-items"361 "3-items"362 "4-items"363 ]))))365 (def item-quantity-selected-address 65432)367 (defn item-quantity-selected368 ([^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-until374 ([script-fn default-key script]375 (let [wait-time376 (- (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-relative384 "Assumes the arrow keys currently control the cursor.385 Moves the cursor n steps relative to its current386 position."387 [n script]388 (let [key (if (< 0 n) ↓ ↑)]389 (multiple-times390 (Math/abs n)391 (partial first-difference392 [] 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-cursor402 "Assumes the arrow keys currently control the cursor. Sets403 the cursor to the desired position. Works for any menu404 that uses a cursor including the start menu, item menu,405 pokemon menu, and battle menu."406 [n [moves state :as script]]407 (->> script408 (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 value419 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-selected425 script))426 true427 (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 (reduce440 (fn [script _]441 (delayed-difference [] direction 5 item-quantity-selected442 script))443 script444 (range (Math/abs best-path))))))446 (defn set-quantity447 ([total-quantity desired-quantity [moves state :as script]]448 (->> script (wait-until (partial delayed-difference [] [:a] 100449 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-entry459 ([test-direction [moves state :as script]]460 (->> script461 (wait-until (partial set-cursor-relative test-direction))462 (play-moves [[] [:a] []])))463 ([[moves state :as script]]464 (select-menu-entry465 1 script)))467 (defn restart468 "The two button presses after a restart event are converted to469 blanks. Due to weirdness with the VBM format. To compensate, ensure470 that the two button presses after restart are both blanks."471 [script]472 (play-moves [[:restart] [] []] script))474 (defn-memo do-save-corruption475 ([] (do-save-corruption476 (walk-to-counter)))477 ([script] (do-save-corruption 4 script))478 ([n script]479 (->> script480 activate-start-menu481 (set-cursor n)482 select-menu-entry483 select-menu-entry484 (play-moves485 ;; this section is copied from speedrun-2942 and corrupts486 ;; the save so that the total number of pokemon is set to487 ;; 0xFF, allowing manipulation of non-pokemon data in RAM488 ;; via the pokemon interface.489 [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []490 [] [] [] [] [] [] [] [] [] [] [] []])491 (restart)492 (title)493 (first-difference [] [:start] AF)494 (first-difference [] [:a] AF))))496 (defn gen-corrupted-checkpoint! []497 (let [[cor-moves cor-save] (do-save-corruption)]498 (write-moves! cor-moves "cor-checkpoint")499 (write-state! cor-save "cor-checkpoint")))501 (defn corrupted-checkpoint []502 [(read-moves "cor-checkpoint")503 (read-state "cor-checkpoint")])505 (def menu do-nothing )508 (defn investivate-close-menu []509 (clojure.pprint/pprint510 (apply harmonic-compare511 (map read-state512 ["start-up-1"513 "start-down-1"514 ;;"start-up-2"515 ;;"start-down-2"516 ;;"start-up-3"517 ;;"start-down-3"518 ;;"computer-up-1"519 ;;"computer-down-2"520 "computer-up-2"521 "computer-down-2"522 "pokemon-up-1"523 "pokemon-down-1"524 "pokemon-up-2"525 "pokemon-down-2"526 "item-up-1"527 "item-down-1"528 "save-up-1"529 "save-down-1"530 "item-nest-up-1"531 "item-nest-down-1"]))))533 (def list-nesting-depth-address 50339)535 (defn current-depth536 ([^SaveState state] (aget (memory state) list-nesting-depth-address))537 ([] (current-depth @current-state)))540 (defn close-menu [script]541 (delayed-difference542 [] [:b] 50543 current-depth544 script))547 (defn purchase-item548 "Assumes that the cursor is over the desired item, and purchases549 quantity of that item."550 [n script]551 (->> script552 select-menu-entry553 (set-quantity n)554 (first-difference [] [:a] AF)555 scroll-text556 select-menu-entry557 scroll-text))559 (defn-memo corrupt-item-list560 "Corrupt the num-of-items variable by switching a corrupted pokemon561 into out-of-bounds memory."562 ([] (corrupt-item-list563 ;;(corrupted-checkpoint)564 (do-save-corruption)565 ))566 ([script] (corrupt-item-list 1))567 ([n script]568 (->> script569 activate-start-menu570 (set-cursor n) ; select "POKEMON"571 select-menu-entry ; from main menu.572 (set-cursor 5) ; select 6th pokemon573 select-menu-entry574 (set-cursor 1)575 select-menu-entry576 (repeat-until-different [] list-offset)577 (set-cursor 9)578 select-menu-entry ; switch 6th with 10th579 close-menu580 close-menu)))582 (defn-memo get-lots-of-money583 "Sell 0xFE cancel buttons to make a tremendous amount of money."584 ([] (get-lots-of-money (corrupt-item-list)))585 ([script]586 (->> script587 (first-difference [] [:a] AF) ; talk to shopkeep588 (repeat-until-different [] list-offset)589 (set-cursor 1)590 select-menu-entry591 (repeat-until-different [] list-offset)592 select-menu-entry593 (set-quantity 0xFF 0xF7)594 (first-difference [] [:a] AF)595 select-menu-entry596 close-menu)))598 (defn note [str script]599 (println str) script)601 (defn-memo buy-bootstrapping-items602 "Buy items that will become part of the bootstrapping603 program."604 ([] (buy-bootstrapping-items (get-lots-of-money)))605 ([script]606 (->> script607 close-menu608 select-menu-entry609 (purchase-item 1) ; buying a pokeball overflows610 ; the item-counter from 0xFF to 0x00611 ; repairing the item-list.612 (set-cursor 1)613 (purchase-item 1) ; these other items are here to614 ; protect the burn heals when the615 (set-cursor 2) ; item list is corrupted again.616 (purchase-item 1)618 (set-cursor 3)619 (purchase-item 1)621 (set-cursor 4) ; 95 burn-heals spells out the622 (purchase-item 96) ; return address to the pokemon623 ; kernel. 96 so that they can be624 ; deposited without causing a shift.626 close-menu ; stop talking to shopkeep627 (wait-until select-menu-entry)628 (play-moves [[:b]])629 end-text)))631 (defn-memo corrupt-item-list-again632 ([] (corrupt-item-list-again (buy-bootstrapping-items)))633 ([script]634 (->> script635 activate-start-menu636 (set-cursor-relative 0)637 select-menu-entry639 ;; repair list-offset for pokemon-list640 (set-cursor-relative -1)642 (set-cursor 4) ; switching it to643 select-menu-entry ; tenth place.644 (set-cursor 1)645 select-menu-entry ; select "switch" on 5th647 (repeat-until-different [] list-offset)648 (set-cursor 9) ; goto 10th pokemon649 select-menu-entry ; do switch650 close-menu651 close-menu)))653 (defn-memo leave-viridian-store654 ([] (leave-viridian-store (corrupt-item-list-again)))655 ([script]656 (->> script657 ;; leave store658 (walk [↓ ↓ → ↓]))))660 (defn force-encounter [direction script]661 (delayed-improbability-search662 600663 #(search-string % "Wild")664 (partial move direction) script))666 (defn-memo fight-wild-pokemon667 ([] (fight-wild-pokemon (leave-viridian-store)))668 ([script]669 (->> script670 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓671 ← ← ← ← ← ← ← ←672 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])673 (force-encounter →))))675 (defn-memo run-from-pokemon676 ([] (run-from-pokemon (fight-wild-pokemon)))677 ([script]678 (->> script679 (scroll-text)680 (play-moves [[:a]])681 (wait-until select-menu-entry)682 (set-cursor 1)683 (first-difference [] → AF)684 (scroll-text)685 (scroll-text))))687 (defn-memo to-poke-center-computer688 ([] (to-poke-center-computer689 (run-from-pokemon)))690 ([script]691 (->> script692 (walk-thru-grass [→ → ↑])693 (walk [↑ ← ← ←694 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑695 ← ←696 ↑ ↑ ↑ ↑697 → → → → ↑])698 (walk [→ →699 ↑ ↑ ↑700 → → → → → → → → →])701 (first-difference [] ↑ AF))))703 (defn-memo begin-deposits704 ([] (begin-deposits705 (to-poke-center-computer)))706 ([script]707 (->> script708 ;; access PC709 (scroll-text 2)711 ;; access item storage712 (menu [[:a] [:d] [:a]])713 (scroll-text 2)715 ;; begin deposit716 (menu [[:d] [:a]])717 (do-nothing 40))))719 (defn deposit-n-items720 [n script]721 (->> script722 (do-nothing 100)723 (play-moves [[:a]])724 (do-nothing 80)725 (multiple-times726 (dec n)727 (fn [script]728 (->> script729 (play-moves [[:u]])730 (do-nothing 1))))731 (play-moves [[:a]])732 (scroll-text)))734 (defn deposit-one-item735 [script]736 (->> script737 (do-nothing 100)738 (play-moves [[:a]])739 (do-nothing 80)740 (play-moves [[:a]])741 (scroll-text)))743 (defn-memo create-header744 ([] (create-header (begin-deposits)))745 ([script]746 (->> script747 (multiple-times 33 deposit-one-item)748 (do-nothing 1))))750 (defn bootstrap-init []751 [(read-moves "bootstrap-init")752 (read-state "bootstrap-init")])754 (defn create-bootstrap-program755 ([] (create-bootstrap-program756 (create-header)))757 ([script]758 (->> script759 (do-nothing 120)760 (menu [↓ ↓ ↓ ↓ ↓ ↓ ↓])761 ;;(deposit-n-items 33)763 (menu (repeat 17 ↓))767 (do-nothing 1))))770 (defn test-pc-item-program []771 (-> (read-state "bootstrap-init")772 (set-memory pc-item-list-start 50)773 (set-memory-range774 map-function-address-start [0x8B 0xD5])775 (set-memory-range776 (inc pc-item-list-start)777 (flatten778 [(repeat779 28780 [0xFF 0x01])781 [;; second part of item manipulation program782 0x00 ;; this starts at address 0xD56C783 0x2A ;; save (HL)=(target) to A, increment HL785 0x00786 0x47 ;; save A to B788 0x00789 0x3A ;; save (target+1) to A, decrement HL791 0x00792 0x22 ;; A -> target, increment HL [(target+1) -> target]794 0x00795 0x70 ;; load B into target+1 [(target) -> target+1]797 0x00798 0xC3 ;; first part of absolute jump800 0x0C ;; return control to pokemon kernel801 0x5F]802 (repeat803 5804 [0xFF 0x01])806 [;; first part of item manipulation program807 0x00808 0x21 ;; load target into HL810 0x94 ;; this is the target address811 0xD5813 0x00 ;; relative jump back to first part814 0x18816 0xE1 ;; of program817 0x01819 0xFF ;; spacer820 0x01822 0x04 ;; target ID (pokeball)823 0x3E ;; target Quantity (lemonade)824 ]]))))830 (defn basic-writer [target-address limit return-address]831 (let [[target-high target-low] (disect-bytes-2 target-address)832 [return-high return-low] (disect-bytes-2 return-address)]833 (flatten834 [0xF3 ;; disable interrupts836 0x1E ;; load limit into E837 limit839 0x21 ;; load target into HL840 target-low841 target-high843 ;; load 1 into C.844 0x0E ;; C == 1 means input-first nybble845 0x01 ;; C == 0 means input-second nybble847 ;; Input Section849 0x3E ;; load 0x20 into A, to measure dpad850 0x20852 0xE0 ;; load A into [FF00]853 0x00855 0xF0 ;; load 0xFF00 into A to get856 0x00 ;; d-pad presses858 0xE6859 0x0F ;; select bottom four bits of A861 0xB8 ;; see if input is different (CP A B)863 0x28 ;; repeat above steps if input is not different864 ;; (jump relative backwards if B != A)865 0xF5 ;; (literal -11)867 0x47 ;; load A into B869 0x0D ;; dec C870 ;; branch based on C:871 0x20 ;; JR NZ872 0x07 ;; skip "input first nybble" below875 ;; input first nybble877 0xCB878 0x37 ;; swap nybbles on A880 0x57 ;; A -> D882 0x18883 0xEC ;; literal -20 -- go back to input section885 ;; input second nybble887 0x0C ;; inc C889 0xE6 ;; select bottom bits890 0x0F892 0xB2 ;; (OR A D) -> A894 0x22 ;; (do (A -> (HL)) (INC HL))896 0x1D ;; (DEC E)898 0x20 ;; jump back to input section if not done899 0xE4 ;; literal -28901 0xFB ;; re-enable interrupts903 0xC3904 return-low905 return-high ])))908 (defn test-basic-writer []909 (-> (read-state "bootstrap-init")910 (set-memory pc-item-list-start 50)911 (set-memory-range912 map-function-address-start913 (reverse (disect-bytes-2 (inc pc-item-list-start))))914 (set-memory-range915 (inc pc-item-list-start)916 (basic-writer 0xD162 10 0x5F0C))))918 (defn debug-basic-writer []919 (PC! (test-basic-writer) (inc pc-item-list-start)))921 (defn d-ticks [state n]922 (reduce (fn [state _] (d-tick state))923 state (range n)))925 (defn d-print [state message]926 (println message) state)928 (defn dddd929 []930 (-> (debug-basic-writer)931 (d-ticks 20)932 (set-memory 0xFF00 0xFF)933 (d-print "============== second cycle")934 (d-ticks 14)935 (d-print "============== end")936 (d-ticks 20)))938 ;;TMs at celadon store ---939 ;;01 (any-number) mega punch940 ;;02 (any-number) razor wind941 ;;05 (any-number) mega kick942 ;;07 (any-number) hyper beam943 ;;09 (any-number) take down944 ;;13 (only 1) ice beam945 ;;17 (any-number) submission946 ;;18 (only 1) counter947 ;;32 (any-number) double team948 ;;33 (any-number) reflect949 ;;37 (any-number) egg bomb950 ;;48 (only 1) rock slide951 ;;49 (only 1) tri attack954 ;; no-ops955 ;; 0x00956 ;; 0xB8 - 0xBF (compares) :garbage957 ;; 0x3F clear carry flag :s.s.ticket958 ;; 0x37 set carry flag :guard-spec [!]959 ;; 0x33 increment SP :poke-doll [!]960 ;; 0x3B decrement SP :coin962 ;;0x7F A->A :garbage963 ;;0x40 B->B :gold-teeth964 ;;0x49 C->C :poke-flute965 ;;0x52 D->D :elixer966 ;;0x5B E->E :garbage967 ;;0x6D L->L :garbage968 ;;0x64 H->H :garbage971 ;;0xC5 push BC :HM02972 ;;0xD5 push DE :TM13 (ice-beam)973 ;;0xE5 push HL :TM29 (psychic)974 ;;0xF5 push AF :TM45 (thunder-wave)976 ;; 0xA7 (AND A A) :garbage977 ;; 0xB7 (OR A A) :garbage979 ;; 0x2F (CPL A) :leaf-stone982 (defn item-writer983 "This is the basic writer, optimized to be made of valid984 item-quantity pairs."985 [target-address limit return-address]986 (let [[target-high target-low] (disect-bytes-2 target-address)987 [return-high return-low] (disect-bytes-2 return-address)]988 (flatten989 [990 ;;0xC5 ;; push junk onto stack991 ;;0xD5992 ;;0xE5993 ;;0xF5994 0x33 ;; (item-hack) set increment stack pointer no-op995 0x1E ;; load limit into E996 limit997 0x3F ;; (item-hack) set carry flag no-op999 ;; load 2 into C.1000 0x0E ;; C == 1 means input-first nybble1001 0x04 ;; C == 0 means input-second nybble1003 0x21 ;; load target into HL1004 target-low1005 target-high1006 0x37 ;; (item-hack) set carry flag no-op1008 0x2F ;; (item-hack) cpl A1009 0x2F ;; (item-hack) cpl A --together a spacer no-op1011 0x00 ;; (item-hack) no-op1012 0xF3 ;; disable interrupts1013 ;; Input Section1015 0x3E ;; load 0x20 into A, to measure buttons1016 0x101018 0x00 ;; (item-hack) no-op1019 0xE0 ;; load A into [FF00]1020 0x001022 0xF0 ;; load 0xFF00 into A to get1023 0x00 ;; button presses1025 0xE61026 0x0F ;; select bottom four bits of A1027 0x37 ;; (item-hack) set carry flag no-op1029 0x00 ;; (item-hack) no-op1030 0xB8 ;; see if input is different (CP A B)1032 0x00 ;; (item-hack) (INC SP)1033 0x28 ;; repeat above steps if input is not different1034 ;; (jump relative backwards if B != A)1035 0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)1037 0x47 ;; load A into B1039 0x0D ;; dec C1040 0x37 ;; (item-hack) set-carry flag1041 ;; branch based on C:1042 0x20 ;; JR NZ1043 23 ;; skip "input second nybble" and "jump to target" below1045 ;; input second nybble1047 0x0C ;; inc C1048 0x0C ;; inc C1050 0x00 ;; (item-hack) no-op1051 0xE6 ;; select bottom bits1052 0x0F1053 0x37 ;; (item-hack) set-carry flag no-op1055 0x00 ;; (item-hack) no-op1056 0xB2 ;; (OR A D) -> A1058 0x22 ;; (do (A -> (HL)) (INC HL))1060 0x1D ;; (DEC E)1062 0x00 ;; (item-hack)1063 0x20 ;; jump back to input section if not done1064 0xDA ;; literal -36 == TM 18 (counter)1065 0x01 ;; (item-hack) set BC to literal (no-op)1067 ;; jump to target1068 0x00 ;; (item-hack) these two bytes can be anything.1069 0x011071 0x00 ;; (item-hack) no-op1072 0xBF ;; (CP A A) ensures Z1074 0xCA ;; (item-hack) jump if Z1075 return-low1076 return-high1077 0x01 ;; (item-hack) will never be reached.1081 ;; input first nybble1082 0x001083 0xCB1084 0x37 ;; swap nybbles on A1086 0x57 ;; A -> D1088 0x37 ;; (item-hack) set carry flag no-op1089 0x18 ;; relative jump backwards1090 0xCD ;; literal -51 == TM05; go back to input section1091 0x01 ;; (item-hack) will never reach this instruction1093 ])))1095 (defn test-item-writer []1096 (-> (read-state "bootstrap-init")1097 (set-memory pc-item-list-start 50)1098 (set-memory-range1099 map-function-address-start1100 (reverse (disect-bytes-2 (inc pc-item-list-start))))1101 (set-memory-range1102 (inc pc-item-list-start)1103 (item-writer 0xD162 201 0xD162))))1105 (defn item-writer-state []1106 (read-state "item-writer"))1108 (defn test-item-writer-2 []1109 (let [orig (item-writer-state)]1110 (-> orig1111 (print-listing 0xD162 (+ 0xD162 20))1112 (run-moves (reduce concat1113 (repeat 10 [[:a :b :start :select] []])))1114 ((fn [_] (println "===========") _))1115 (print-listing 0xD162 (+ 0xD162 20)))))