Mercurial > vba-clojure
view clojure/com/aurellem/run/bootstrap_0.clj @ 323:92ee94945327
created functions to set the cursor to any position in any list
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Wed, 04 Apr 2012 00:56:53 -0500 |
parents | d604bd3c122c |
children | 7876781520ea |
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 item-screen-offset-address)352 (aget mem item-cursor-offset-address))))353 ([] (item-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 (aget (memory state) item-quantity-selected-address))372 ([] (item-quantity-selected @current-state)))374 (defn set-cursor-relative375 "Assumes the arrow keys currently control the cursor.376 Moves the cursor n steps relative to its current377 position."378 [n script]379 (let [key (if (< 0 n) ↓ ↑)]380 (multiple-times381 n (partial repeat-until-different382 key list-offset) script)))384 (defn set-cursor385 "Assumes the arrow keys currently control the cursor. Sets386 the cursor to the desired position. Works for any menu387 that uses a cursor including the start menu, item menu,388 pokemon menu, and battle menu."389 [n [moves state :as script]]390 (let [current-position (list-offset state)391 difference (- n current-position)]392 (println difference)393 (set-cursor-relative difference script)))395 (defn buy-item396 "Assumes that the main item-screen is up, and buys397 quantity of the nth item in the list, assuming that you398 have enough money."399 [n quantity script]400 (if (= 0 quantity)401 script402 (let [after-initial-pause403 (do-nothing 20 script)404 move-to-item405 (reduce (fn [script _]406 (->> script407 (play-moves [[:d]])408 (do-nothing 3)))409 after-initial-pause410 (range n))411 select-item412 (play-moves [[:a]] move-to-item)413 request-items414 (reduce (fn [script _]415 (->> script416 (play-moves [[:u]])417 (do-nothing 1)))418 select-item419 (range (dec quantity)))420 buy-items421 (->> request-items422 (do-nothing 10)423 (play-moves [[:a]])424 (scroll-text)425 (scroll-text)426 (do-nothing 10)427 (play-moves [[:a]])428 (scroll-text))]429 buy-items)))432 (defn buy-items433 "Given a list of [item-no quantity], buys the quantity434 from the shop's list. Assumes that the item list is435 already up."436 [item-pairs script]437 (let [item-lookup (into {0 0 1 0 2 0 3 0 4 0} item-pairs)438 initial-purchase439 (->> script440 (buy-item 0 (item-lookup 0))441 (buy-item 1 (item-lookup 1))442 (buy-item 2 (item-lookup 2)))]443 (cond444 (and445 (not= 0 (item-lookup 3))446 (not= 0 (item-lookup 4)))447 (->> initial-purchase448 (do-nothing 20)449 (play-moves [[:d]])450 (do-nothing 3)451 (play-moves [[:d]])452 (do-nothing 3)453 (play-moves [[:d]])454 (do-nothing 10)455 (buy-item 0 (item-lookup 3))456 (do-nothing 20)457 (play-moves [[:d]])458 (do-nothing 3)459 (play-moves [[:d]])460 (do-nothing 3)461 (play-moves [[:d]])462 (do-nothing 10)463 (buy-item 0 (item-lookup 4)))464 (and (= 0 (item-lookup 3))465 (not= 0 (item-lookup 4)))466 (->> initial-purchase467 (do-nothing 20)468 (play-moves [[:d]])469 (do-nothing 3)470 (play-moves [[:d]])471 (do-nothing 3)472 (play-moves [[:d]])473 (do-nothing 10)474 (play-moves [[:d]])475 (do-nothing 10)476 (buy-item 0 (item-lookup 4)))477 (and (not= 0 (item-lookup 3))478 (= 0 (item-lookup 4)))479 (->> initial-purchase480 (do-nothing 20)481 (play-moves [[:d]])482 (do-nothing 3)483 (play-moves [[:d]])484 (do-nothing 3)485 (play-moves [[:d]])486 (do-nothing 10)487 (buy-item 0 (item-lookup 3)))488 (and (= 0 (item-lookup 3))489 (= 0 (item-lookup 4)))490 initial-purchase)))493 (defn test-buy-items494 ([] (test-buy-items495 (walk-to-counter)))496 ([script]497 (->> [(first script) (set-money (second script)498 999999)]499 (play-moves500 [[] [:a] []])501 (scroll-text)502 (do-nothing 100)503 (play-moves [[:a]])504 (do-nothing 100)505 (buy-items506 [[0 1]507 [1 15]508 [2 1]509 [3 20]510 [4 95]511 ]))))513 (defn-memo buy-initial-items514 ([] (buy-initial-items515 (walk-to-counter)))516 ([script]517 (->> script518 (play-moves519 [[] [:a] []])520 (scroll-text)521 (do-nothing 100)522 (play-moves [[:a]])523 (do-nothing 100)524 (buy-items525 [[0 1]526 [1 1]527 [2 1]528 [3 1]529 [4 1]])530 (do-nothing 100)531 (play-moves [[:b]])532 (do-nothing 100)533 (play-moves [[:b]])534 (do-nothing 100)535 (play-moves [[:b] []])536 (first-difference [:b] [:b :start] AF))))539 (defn-memo do-save-corruption540 ([] (do-save-corruption541 (buy-initial-items)))542 ([script]543 (->> script544 (first-difference [] [:d] AF)545 (play-moves [[] [] [] [:d]546 [] [] [] [:d]547 [] [] [] [:d]548 [] [] [:a]])549 scroll-text550 (play-moves551 ;; this section is copied from speedrun-2942 and corrupts552 ;; the save so that the total number of pokemon is set to553 ;; 0xFF, allowing manipulation of non-pokemon data in RAM554 ;; via the pokemon interface.555 [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []556 [] [] [] [] [] [] [] [] [] [] [] [:select] [:restart]])557 (title)558 (first-difference [] [:start] AF)559 (first-difference [] [:a] AF)560 (first-difference [:a] [:a :start] AF))))562 (def menu do-nothing )564 (defn-memo corrupt-item-list565 ([] (corrupt-item-list566 (do-save-corruption)))567 ([script]568 (->> script569 (do-nothing 200)570 (menu [↓ [:a]]) ; select "POKEMON" from571 ; from main menu572 (menu [↓ ↓ ↓ ↓ ↓ ↓ ; go to 6th pokemon573 [:a] ↓ [:a] ; select "switch"574 ↓ ↓ ↓ [:a]]) ; switch with 9th "pokemon"576 (do-nothing 1))))578 (defn-memo get-burn-heals579 ([] (get-burn-heals580 (corrupt-item-list)))581 ([script]582 (->> script583 (menu [[:b] [:b]])584 (menu [[:a]])585 (do-nothing 100)586 (menu [↓ [:a]])587 (do-nothing 100)588 (menu [[:a] ↓ [:a]])589 (scroll-text)590 (menu [[:b][:b]])591 (menu [[:a]])593 (do-nothing 50)594 (buy-items [[0 1]])595 (do-nothing 60)596 (menu [[:a]])597 (scroll-text)599 (do-nothing 50)600 (buy-items [[0 1]])601 (do-nothing 60)602 ;;(menu [[:a]])603 ;;(scroll-text)605 ;;(do-nothing 300)606 ;;(menu [[:b] [:b]])607 ;;(do-nothing 300)609 (buy-items [[0 1]610 [1 1]611 [1 1]612 [2 1]613 [3 1]614 [4 97]])616 (do-nothing 10))))618 (defn-memo corrupt-item-list-again619 ([] (corrupt-item-list-again (get-burn-heals)))620 ([script]621 (->> script622 (do-nothing 10)623 (play-moves [[:b]])624 (do-nothing 100)625 (play-moves [[:b]])626 (do-nothing 40)627 (play-moves [[:b]])628 (first-difference [:b] [:start :b] AF)629 (menu [[:a] ↑ ↑ ↑ ↑ ↑ ; get fifth pokemon630 [:a] ↓ [:a] ; and corrupt the631 ↓ ↓ ↓ ↓ ↓ [:a]]) ; item list again by632 ; switching it to633 ))) ; tenth place.635 (defn-memo viridian-store->viridian-poke-center636 ([] (viridian-store->viridian-poke-center637 (corrupt-item-list-again)))638 ([script]639 (->> script640 (do-nothing 100)641 (play-moves [[:b]])642 (do-nothing 100)643 (play-moves [[:b]])644 (do-nothing 40)645 ;; leave store646 (walk [↓ ↓647 → ↓ ↓])648 (walk [← ← ← ←649 ↓ ↓ ↓ ↓ ↓ ↓650 ← ← ← ↑]))))652 (defn-memo to-poke-center-computer653 ([] (to-poke-center-computer654 (viridian-store->viridian-poke-center)))655 ([script]656 (->> script657 (walk [→ →658 ↑ ↑ ↑659 → → → → → → → → → ↑])660 (do-nothing 1))))662 (defn-memo begin-deposits663 ([] (begin-deposits664 (to-poke-center-computer)))665 ([script]666 (->> script667 ;; access PC668 (scroll-text 2)670 ;; access item storage671 (menu [[:a] [:d] [:a]])672 (scroll-text 2)674 ;; begin deposit675 (menu [[:d] [:a]])676 (do-nothing 40))))678 (defn deposit-n-items679 [n script]680 (->> script681 (do-nothing 100)682 (play-moves [[:a]])683 (do-nothing 80)684 (multiple-times685 (dec n)686 (fn [script]687 (->> script688 (play-moves [[:u]])689 (do-nothing 1))))690 (play-moves [[:a]])691 (scroll-text)))693 (defn deposit-one-item694 [script]695 (->> script696 (do-nothing 100)697 (play-moves [[:a]])698 (do-nothing 80)699 (play-moves [[:a]])700 (scroll-text)))702 (defn-memo create-header703 ([] (create-header (begin-deposits)))704 ([script]705 (->> script706 (multiple-times 33 deposit-one-item)707 (do-nothing 1))))709 (defn bootstrap-init []710 [(read-moves "bootstrap-init")711 (read-state "bootstrap-init")])713 (defn create-bootstrap-program714 ([] (create-bootstrap-program715 (create-header)))716 ([script]717 (->> script718 (do-nothing 120)719 (menu [↓ ↓ ↓ ↓ ↓ ↓ ↓])720 ;;(deposit-n-items 33)722 (menu (repeat 17 ↓))726 (do-nothing 1))))729 (defn test-pc-item-program []730 (-> (read-state "bootstrap-init")731 (set-memory pc-item-list-start 50)732 (set-memory-range733 map-function-address-start [0x8B 0xD5])734 (set-memory-range735 (inc pc-item-list-start)736 (flatten737 [(repeat738 28739 [0xFF 0x01])740 [;; second part of item manipulation program741 0x00 ;; this starts at address 0xD56C742 0x2A ;; save (HL)=(target) to A, increment HL744 0x00745 0x47 ;; save A to B747 0x00748 0x3A ;; save (target+1) to A, decrement HL750 0x00751 0x22 ;; A -> target, increment HL [(target+1) -> target]753 0x00754 0x70 ;; load B into target+1 [(target) -> target+1]756 0x00757 0xC3 ;; first part of absolute jump759 0x0C ;; return control to pokemon kernel760 0x5F]761 (repeat762 5763 [0xFF 0x01])765 [;; first part of item manipulation program766 0x00767 0x21 ;; load target into HL769 0x94 ;; this is the target address770 0xD5772 0x00 ;; relative jump back to first part773 0x18775 0xE1 ;; of program776 0x01778 0xFF ;; spacer779 0x01781 0x04 ;; target ID (pokeball)782 0x3E ;; target Quantity (lemonade)783 ]]))))