Mercurial > vba-clojure
view clojure/com/aurellem/run/bootstrap_0.clj @ 322:d604bd3c122c
added function to determine wuantity of items currently selected
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Wed, 04 Apr 2012 00:35:44 -0500 |
parents | af86b5ba622b |
children | 92ee94945327 |
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"]))))341 (def item-cursor-offset-address 52262)342 (def item-screen-offset-address 52278)344 (defn item-offset345 ([^SaveState state]346 (let [mem (memory state)]347 (+ (aget mem item-screen-offset-address)348 (aget mem item-cursor-offset-address))))349 ([] (item-offset @current-state)))352 (defn exp-item-selection []353 (clojure.pprint/pprint354 (apply memory-compare355 (map read-state356 ["1-item"357 "2-items"358 "3-items"359 "4-items"360 ]))))362 (def item-quantity-selected-address 65432)364 (defn item-quantity-selected365 ([^SaveState state]366 (aget (memory state) item-quantity-selected-address))367 ([] (item-quantity-selected @current-state)))370 (defn buy-item371 "Assumes that the main item-screen is up, and buys372 quantity of the nth item in the list, assuming that you373 have enough money."374 [n quantity script]375 (if (= 0 quantity)376 script377 (let [after-initial-pause378 (do-nothing 20 script)379 move-to-item380 (reduce (fn [script _]381 (->> script382 (play-moves [[:d]])383 (do-nothing 3)))384 after-initial-pause385 (range n))386 select-item387 (play-moves [[:a]] move-to-item)388 request-items389 (reduce (fn [script _]390 (->> script391 (play-moves [[:u]])392 (do-nothing 1)))393 select-item394 (range (dec quantity)))395 buy-items396 (->> request-items397 (do-nothing 10)398 (play-moves [[:a]])399 (scroll-text)400 (scroll-text)401 (do-nothing 10)402 (play-moves [[:a]])403 (scroll-text))]404 buy-items)))407 (defn buy-items408 "Given a list of [item-no quantity], buys the quantity409 from the shop's list. Assumes that the item list is410 already up."411 [item-pairs script]412 (let [item-lookup (into {0 0 1 0 2 0 3 0 4 0} item-pairs)413 initial-purchase414 (->> script415 (buy-item 0 (item-lookup 0))416 (buy-item 1 (item-lookup 1))417 (buy-item 2 (item-lookup 2)))]418 (cond419 (and420 (not= 0 (item-lookup 3))421 (not= 0 (item-lookup 4)))422 (->> initial-purchase423 (do-nothing 20)424 (play-moves [[:d]])425 (do-nothing 3)426 (play-moves [[:d]])427 (do-nothing 3)428 (play-moves [[:d]])429 (do-nothing 10)430 (buy-item 0 (item-lookup 3))431 (do-nothing 20)432 (play-moves [[:d]])433 (do-nothing 3)434 (play-moves [[:d]])435 (do-nothing 3)436 (play-moves [[:d]])437 (do-nothing 10)438 (buy-item 0 (item-lookup 4)))439 (and (= 0 (item-lookup 3))440 (not= 0 (item-lookup 4)))441 (->> initial-purchase442 (do-nothing 20)443 (play-moves [[:d]])444 (do-nothing 3)445 (play-moves [[:d]])446 (do-nothing 3)447 (play-moves [[:d]])448 (do-nothing 10)449 (play-moves [[:d]])450 (do-nothing 10)451 (buy-item 0 (item-lookup 4)))452 (and (not= 0 (item-lookup 3))453 (= 0 (item-lookup 4)))454 (->> initial-purchase455 (do-nothing 20)456 (play-moves [[:d]])457 (do-nothing 3)458 (play-moves [[:d]])459 (do-nothing 3)460 (play-moves [[:d]])461 (do-nothing 10)462 (buy-item 0 (item-lookup 3)))463 (and (= 0 (item-lookup 3))464 (= 0 (item-lookup 4)))465 initial-purchase)))468 (defn test-buy-items469 ([] (test-buy-items470 (walk-to-counter)))471 ([script]472 (->> [(first script) (set-money (second script)473 999999)]474 (play-moves475 [[] [:a] []])476 (scroll-text)477 (do-nothing 100)478 (play-moves [[:a]])479 (do-nothing 100)480 (buy-items481 [[0 1]482 [1 15]483 [2 1]484 [3 20]485 [4 95]486 ]))))488 (defn-memo buy-initial-items489 ([] (buy-initial-items490 (walk-to-counter)))491 ([script]492 (->> script493 (play-moves494 [[] [:a] []])495 (scroll-text)496 (do-nothing 100)497 (play-moves [[:a]])498 (do-nothing 100)499 (buy-items500 [[0 1]501 [1 1]502 [2 1]503 [3 1]504 [4 1]])505 (do-nothing 100)506 (play-moves [[:b]])507 (do-nothing 100)508 (play-moves [[:b]])509 (do-nothing 100)510 (play-moves [[:b] []])511 (first-difference [:b] [:b :start] AF))))514 (defn-memo do-save-corruption515 ([] (do-save-corruption516 (buy-initial-items)))517 ([script]518 (->> script519 (first-difference [] [:d] AF)520 (play-moves [[] [] [] [:d]521 [] [] [] [:d]522 [] [] [] [:d]523 [] [] [:a]])524 scroll-text525 (play-moves526 ;; this section is copied from speedrun-2942 and corrupts527 ;; the save so that the total number of pokemon is set to528 ;; 0xFF, allowing manipulation of non-pokemon data in RAM529 ;; via the pokemon interface.530 [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []531 [] [] [] [] [] [] [] [] [] [] [] [:select] [:restart]])532 (title)533 (first-difference [] [:start] AF)534 (first-difference [] [:a] AF)535 (first-difference [:a] [:a :start] AF))))537 (def menu do-nothing )539 (defn-memo corrupt-item-list540 ([] (corrupt-item-list541 (do-save-corruption)))542 ([script]543 (->> script544 (do-nothing 200)545 (menu [↓ [:a]]) ; select "POKEMON" from546 ; from main menu547 (menu [↓ ↓ ↓ ↓ ↓ ↓ ; go to 6th pokemon548 [:a] ↓ [:a] ; select "switch"549 ↓ ↓ ↓ [:a]]) ; switch with 9th "pokemon"551 (do-nothing 1))))553 (defn-memo get-burn-heals554 ([] (get-burn-heals555 (corrupt-item-list)))556 ([script]557 (->> script558 (menu [[:b] [:b]])559 (menu [[:a]])560 (do-nothing 100)561 (menu [↓ [:a]])562 (do-nothing 100)563 (menu [[:a] ↓ [:a]])564 (scroll-text)565 (menu [[:b][:b]])566 (menu [[:a]])568 (do-nothing 50)569 (buy-items [[0 1]])570 (do-nothing 60)571 (menu [[:a]])572 (scroll-text)574 (do-nothing 50)575 (buy-items [[0 1]])576 (do-nothing 60)577 ;;(menu [[:a]])578 ;;(scroll-text)580 ;;(do-nothing 300)581 ;;(menu [[:b] [:b]])582 ;;(do-nothing 300)584 (buy-items [[0 1]585 [1 1]586 [1 1]587 [2 1]588 [3 1]589 [4 97]])591 (do-nothing 10))))593 (defn-memo corrupt-item-list-again594 ([] (corrupt-item-list-again (get-burn-heals)))595 ([script]596 (->> script597 (do-nothing 10)598 (play-moves [[:b]])599 (do-nothing 100)600 (play-moves [[:b]])601 (do-nothing 40)602 (play-moves [[:b]])603 (first-difference [:b] [:start :b] AF)604 (menu [[:a] ↑ ↑ ↑ ↑ ↑ ; get fifth pokemon605 [:a] ↓ [:a] ; and corrupt the606 ↓ ↓ ↓ ↓ ↓ [:a]]) ; item list again by607 ; switching it to608 ))) ; tenth place.610 (defn-memo viridian-store->viridian-poke-center611 ([] (viridian-store->viridian-poke-center612 (corrupt-item-list-again)))613 ([script]614 (->> script615 (do-nothing 100)616 (play-moves [[:b]])617 (do-nothing 100)618 (play-moves [[:b]])619 (do-nothing 40)620 ;; leave store621 (walk [↓ ↓622 → ↓ ↓])623 (walk [← ← ← ←624 ↓ ↓ ↓ ↓ ↓ ↓625 ← ← ← ↑]))))627 (defn-memo to-poke-center-computer628 ([] (to-poke-center-computer629 (viridian-store->viridian-poke-center)))630 ([script]631 (->> script632 (walk [→ →633 ↑ ↑ ↑634 → → → → → → → → → ↑])635 (do-nothing 1))))637 (defn-memo begin-deposits638 ([] (begin-deposits639 (to-poke-center-computer)))640 ([script]641 (->> script642 ;; access PC643 (scroll-text 2)645 ;; access item storage646 (menu [[:a] [:d] [:a]])647 (scroll-text 2)649 ;; begin deposit650 (menu [[:d] [:a]])651 (do-nothing 40))))653 (defn deposit-n-items654 [n script]655 (->> script656 (do-nothing 100)657 (play-moves [[:a]])658 (do-nothing 80)659 (multiple-times660 (dec n)661 (fn [script]662 (->> script663 (play-moves [[:u]])664 (do-nothing 1))))665 (play-moves [[:a]])666 (scroll-text)))668 (defn deposit-one-item669 [script]670 (->> script671 (do-nothing 100)672 (play-moves [[:a]])673 (do-nothing 80)674 (play-moves [[:a]])675 (scroll-text)))677 (defn-memo create-header678 ([] (create-header (begin-deposits)))679 ([script]680 (->> script681 (multiple-times 33 deposit-one-item)682 (do-nothing 1))))684 (defn bootstrap-init []685 [(read-moves "bootstrap-init")686 (read-state "bootstrap-init")])688 (defn create-bootstrap-program689 ([] (create-bootstrap-program690 (create-header)))691 ([script]692 (->> script693 (do-nothing 120)694 (menu [↓ ↓ ↓ ↓ ↓ ↓ ↓])695 ;;(deposit-n-items 33)697 (menu (repeat 17 ↓))701 (do-nothing 1))))704 (defn test-pc-item-program []705 (-> (read-state "bootstrap-init")706 (set-memory pc-item-list-start 50)707 (set-memory-range708 map-function-address-start [0x8B 0xD5])709 (set-memory-range710 (inc pc-item-list-start)711 (flatten712 [(repeat713 28714 [0xFF 0x01])715 [;; second part of item manipulation program716 0x00 ;; this starts at address 0xD56C717 0x2A ;; save (HL)=(target) to A, increment HL719 0x00720 0x47 ;; save A to B722 0x00723 0x3A ;; save (target+1) to A, decrement HL725 0x00726 0x22 ;; A -> target, increment HL [(target+1) -> target]728 0x00729 0x70 ;; load B into target+1 [(target) -> target+1]731 0x00732 0xC3 ;; first part of absolute jump734 0x0C ;; return control to pokemon kernel735 0x5F]736 (repeat737 5738 [0xFF 0x01])740 [;; first part of item manipulation program741 0x00742 0x21 ;; load target into HL744 0x94 ;; this is the target address745 0xD5747 0x00 ;; relative jump back to first part748 0x18750 0xE1 ;; of program751 0x01753 0xFF ;; spacer754 0x01756 0x04 ;; target ID (pokeball)757 0x3E ;; target Quantity (lemonade)758 ]]))))