Mercurial > vba-clojure
view clojure/com/aurellem/run/bootstrap_0.clj @ 333:61a096a53330
fixed problem with rival's name.
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Fri, 06 Apr 2012 14:41:28 -0500 |
parents | 5c2041d1cdda |
children | 57f4c57d2897 |
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)))357 (defn exp-item-selection []358 (clojure.pprint/pprint359 (apply memory-compare360 (map read-state361 ["1-item"362 "2-items"363 "3-items"364 "4-items"365 ]))))367 (def item-quantity-selected-address 65432)369 (defn item-quantity-selected370 ([^SaveState state]371 (println "items:" (aget (memory state) item-quantity-selected-address))372 (aget (memory state) item-quantity-selected-address))373 ([] (item-quantity-selected @current-state)))375 (defn set-cursor-relative376 "Assumes the arrow keys currently control the cursor.377 Moves the cursor n steps relative to its current378 position."379 [n script]380 (let [key (if (< 0 n) ↓ ↑)]381 (multiple-times382 (Math/abs n)383 (partial first-difference384 [] key list-offset)385 script)))387 (defn set-cursor388 "Assumes the arrow keys currently control the cursor. Sets389 the cursor to the desired position. Works for any menu390 that uses a cursor including the start menu, item menu,391 pokemon menu, and battle menu."392 [n [moves state :as script]]393 (let [current-position (list-offset state)394 difference (- n current-position)]395 (println difference)396 (set-cursor-relative difference script)))398 (defn set-quantity399 "Set the quantity of an item to buy or sell to the desired value400 using the fewest possible button presses."401 ([total-quantity desired-quantity [moves state :as script]]402 (let [current-quantity (item-quantity-selected state)403 loop-point (if (> total-quantity 99) 0xFF 99)404 distance (- desired-quantity current-quantity)405 loop-distance (int(* -1 (Math/signum (float distance))406 (- loop-point (Math/abs distance))))407 best-path (first (sort-by #(Math/abs %)408 [distance loop-distance]))409 direction (if (< 0 best-path) ↑ ↓)]410 (println "best-path" best-path)411 (reduce412 (fn [script _]413 (delayed-difference [] direction 5 item-quantity-selected414 script))416 script417 (range (Math/abs best-path)))))418 ([desired-quantity [moves state :as script]]419 (set-quantity 99 desired-quantity script)))421 (defn activate-start-menu [script]422 (first-difference [:b] [:b :start] AF script))424 (defn wait-until [script-fn script]425 (let [wait-time426 (- (dec (count (first (script-fn script))))427 (count (first script)))]428 (println "wait-time" wait-time)429 (do-nothing wait-time script)))431 (defn select-menu-entry [script]432 (->> script433 (wait-until (partial set-cursor-relative 1))434 (play-moves [[:a] []])))436 (defn-memo do-save-corruption437 ([] (do-save-corruption438 (walk-to-counter)))439 ([script]440 (->> script441 activate-start-menu442 (set-cursor 4)443 select-menu-entry444 select-menu-entry445 (play-moves446 ;; this section is copied from speedrun-2942 and corrupts447 ;; the save so that the total number of pokemon is set to448 ;; 0xFF, allowing manipulation of non-pokemon data in RAM449 ;; via the pokemon interface.450 [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []451 [] [] [] [] [] [] [] [] [] [] [] [:select] [:restart]])452 (title)453 (first-difference [] [:start] AF)454 (first-difference [] [:a] AF))))456 (defn gen-corrupted-checkpoint! []457 (let [[cor-moves cor-save] (do-save-corruption)]458 (write-moves! cor-moves "cor-checkpoint")459 (write-state! cor-save "cor-checkpoint")))461 (defn corrupted-checkpoint []462 [(read-moves "cor-checkpoint")463 (read-state "cor-checkpoint")])465 (def menu do-nothing )467 (defn close-menu [script]468 (first-difference [] [:b] AF script))470 (defn purchase-item471 "Assumes that the cursor is over the desired item, and purchases472 quantity of that item."473 [n script]474 (->> script475 select-menu-entry476 (set-quantity n)477 (first-difference [] [:a] AF)478 scroll-text479 select-menu-entry480 scroll-text))482 (defn-memo corrupt-item-list483 "Corrupt the num-of-items variable by switching a corrupted pokemon484 into out-of-bounds memory."485 ([] (corrupt-item-list486 (corrupted-checkpoint)487 ;;(do-save-corruption)488 ))489 ([script]490 (->> script491 activate-start-menu492 (set-cursor 1) ; select "POKEMON" from493 select-menu-entry ; from main menu.494 (set-cursor 5) ; select 6th pokemon495 select-menu-entry496 (set-cursor 1)497 select-menu-entry498 (repeat-until-different [] list-offset)499 (set-cursor 9)500 select-menu-entry ; switch 6th with 10th501 close-menu502 close-menu)))504 (defn-memo get-lots-of-money505 "Sell 0xFE cancel buttons to make a tremendous amount of money."506 ([] (get-lots-of-money (corrupt-item-list)))507 ([script]508 (->> script509 (first-difference [] [:a] AF) ; talk to shopkeep510 (repeat-until-different [] list-offset)511 (set-cursor 1)512 select-menu-entry513 (repeat-until-different [] list-offset)514 select-menu-entry515 (set-quantity 0xFF 0xF7)516 (first-difference [] [:a] AF)517 select-menu-entry518 close-menu)))520 (defn note [str script]521 (println str) script)523 (defn-memo buy-bootstrapping-items524 "Buy items that will become part of the bootstrapping525 program."526 ([] (buy-bootstrapping-items (get-lots-of-money)))527 ([script]528 (->> script529 close-menu530 select-menu-entry531 (purchase-item 1) ; buying a pokeball overflows532 ; the item-counter from 0xFF to 0x00533 ; repairing the item-list.534 (set-cursor 1)535 (purchase-item 1) ; these other items are here to536 ; protect the burn heals when the537 (set-cursor 2) ; item list is corrupted again.538 (purchase-item 1)540 (set-cursor 3)541 (purchase-item 1)543 (set-cursor 4) ; 95 burn-heals spells out the544 (purchase-item 96) ; return address to the pokemon545 ; kernel. 96 so that they can be546 ; deposited without causing a shift.548 close-menu ; stop talking to shopkeep549 (wait-until select-menu-entry)550 (play-moves [[:b]])551 end-text)))553 (defn-memo corrupt-item-list-again554 ([] (corrupt-item-list-again (buy-bootstrapping-items)))555 ([script]556 (->> script557 activate-start-menu558 (set-cursor-relative 0)559 select-menu-entry561 ;; repair list-offset for pokemon-list562 (set-cursor-relative -1)564 (set-cursor 4) ; switching it to565 select-menu-entry ; tenth place.566 (set-cursor 1)567 select-menu-entry ; select "switch" on 5th569 (repeat-until-different [] list-offset)570 (set-cursor 9) ; goto 10th pokemon571 select-menu-entry ; do switch572 close-menu573 close-menu)))575 (defn leave-viridian-store576 ([] (leave-viridian-store (corrupt-item-list-again)))577 ([script]578 (->> script579 ;; leave store580 (walk [↓ ↓ → ↓])581 (do-nothing 1))))583 (defn force-encounter [direction script]584 (delayed-improbability-search585 600586 #(search-string % "Wild")587 (partial move direction) script))589 (defn-memo fight-wild-pokemon590 ([] (fight-wild-pokemon (leave-viridian-store)))591 ([script]592 (->> script593 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓594 ← ← ← ← ← ← ← ←595 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])596 (force-encounter →))))598 (defn-memo run-from-pokemon599 ([] (run-from-pokemon (fight-wild-pokemon)))600 ([script]601 (->> script602 (scroll-text)603 (wait-until select-menu-entry)604 (set-cursor 1)605 (first-difference [] → AF)606 (scroll-text)607 (scroll-text))))609 (defn-memo to-poke-center-computer610 ([] (to-poke-center-computer611 (run-from-pokemon)))612 ([script]613 (->> script614 (walk-thru-grass [→ ↑])615 (walk [↑ ← ← ←616 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑617 ← ←618 ↑ ↑ ↑ ↑619 → → → → ↑])620 (walk [→ →621 ↑ ↑ ↑622 → → → → → → → → →]))))624 (defn-memo begin-deposits625 ([] (begin-deposits626 (to-poke-center-computer)))627 ([script]628 (->> script629 ;; access PC630 (scroll-text 2)632 ;; access item storage633 (menu [[:a] [:d] [:a]])634 (scroll-text 2)636 ;; begin deposit637 (menu [[:d] [:a]])638 (do-nothing 40))))640 (defn deposit-n-items641 [n script]642 (->> script643 (do-nothing 100)644 (play-moves [[:a]])645 (do-nothing 80)646 (multiple-times647 (dec n)648 (fn [script]649 (->> script650 (play-moves [[:u]])651 (do-nothing 1))))652 (play-moves [[:a]])653 (scroll-text)))655 (defn deposit-one-item656 [script]657 (->> script658 (do-nothing 100)659 (play-moves [[:a]])660 (do-nothing 80)661 (play-moves [[:a]])662 (scroll-text)))664 (defn-memo create-header665 ([] (create-header (begin-deposits)))666 ([script]667 (->> script668 (multiple-times 33 deposit-one-item)669 (do-nothing 1))))671 (defn bootstrap-init []672 [(read-moves "bootstrap-init")673 (read-state "bootstrap-init")])675 (defn create-bootstrap-program676 ([] (create-bootstrap-program677 (create-header)))678 ([script]679 (->> script680 (do-nothing 120)681 (menu [↓ ↓ ↓ ↓ ↓ ↓ ↓])682 ;;(deposit-n-items 33)684 (menu (repeat 17 ↓))688 (do-nothing 1))))691 (defn test-pc-item-program []692 (-> (read-state "bootstrap-init")693 (set-memory pc-item-list-start 50)694 (set-memory-range695 map-function-address-start [0x8B 0xD5])696 (set-memory-range697 (inc pc-item-list-start)698 (flatten699 [(repeat700 28701 [0xFF 0x01])702 [;; second part of item manipulation program703 0x00 ;; this starts at address 0xD56C704 0x2A ;; save (HL)=(target) to A, increment HL706 0x00707 0x47 ;; save A to B709 0x00710 0x3A ;; save (target+1) to A, decrement HL712 0x00713 0x22 ;; A -> target, increment HL [(target+1) -> target]715 0x00716 0x70 ;; load B into target+1 [(target) -> target+1]718 0x00719 0xC3 ;; first part of absolute jump721 0x0C ;; return control to pokemon kernel722 0x5F]723 (repeat724 5725 [0xFF 0x01])727 [;; first part of item manipulation program728 0x00729 0x21 ;; load target into HL731 0x94 ;; this is the target address732 0xD5734 0x00 ;; relative jump back to first part735 0x18737 0xE1 ;; of program738 0x01740 0xFF ;; spacer741 0x01743 0x04 ;; target ID (pokeball)744 0x3E ;; target Quantity (lemonade)745 ]]))))