Mercurial > vba-clojure

     1 (ns com.aurellem.run.bootstrap-1

     2   (:use (com.aurellem.gb saves gb-driver util

     3                          items vbm characters money))

     4   (:use (com.aurellem.run util title save-corruption bootstrap-0))

     5   (:use (com.aurellem.exp item-bridge))

     6   (:import [com.aurellem.gb.gb_driver SaveState]))

     7 

     8 (defn pc-item-writer-program

     9   []

    10   (let [limit 201

    11         [target-high target-low] (disect-bytes-2 0xD162)]

    12     (flatten

    13      [[0x00  ;; (item-hack) set increment stack pointer no-op

    14        0x1E  ;; load limit into E

    15        limit

    16        0x3F  ;; (item-hack) set carry flag no-op

    17 

    18        ;; load 2 into C.

    19        0x0E   ;; C == 1 means input-first nybble

    20        0x04   ;; C == 0 means input-second nybble

    21 

    22        0x21 ;; load target into HL

    23        target-low

    24        target-high

    25        0x37 ;; (item-hack) set carry flag no-op

    26 

    27        0x00 ;; (item-hack) no-op

    28        0x37 ;; (item-hack) set carry flag no-op

    29        

    30        0x00 ;; (item-hack) no-op

    31        0xF3 ;; disable interrupts

    32        ;; Input Section

    33 

    34        0x3E ;; load 0x20 into A, to measure buttons

    35        0x10 

    36 

    37        0x00 ;; (item-hack) no-op

    38        0xE0 ;; load A into [FF00]

    39        0x00

    40 

    41        0xF0 ;; load 0xFF00 into A to get

    42        0x00 ;; button presses

    43        

    44        0xE6

    45        0x0F ;; select bottom four bits of A

    46        0x37 ;; (item-hack) set carry flag no-op

    47 

    48        0x00 ;; (item-hack) no-op

    49        0xB8 ;; see if input is different (CP A B)

    50 

    51        0x00 ;; (item-hack) (INC SP)

    52        0x28 ;; repeat above steps if input is not different

    53        ;; (jump relative backwards if B != A)

    54        0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)

    55 

    56        0x47 ;; load A into B

    57        

    58        0x0D ;; dec C

    59        0x37 ;; (item-hack) set-carry flag

    60        ;; branch based on C:

    61        0x20 ;; JR NZ

    62        23 ;; skip "input second nybble" and "jump to target" below

    63        

    64        ;; input second nybble

    65 

    66        0x0C ;; inc C

    67        0x0C ;; inc C

    68 

    69        0x00 ;; (item-hack) no-op

    70        0xE6 ;; select bottom bits

    71        0x0F

    72        0x37 ;; (item-hack) set-carry flag no-op

    73 

    74        0x00 ;; (item-hack) no-op

    75        0xB2 ;; (OR A D) -> A

    76 

    77        0x22 ;; (do (A -> (HL)) (INC HL))

    78 

    79        0x1D ;; (DEC E)

    80 

    81        0x00 ;; (item-hack) 

    82        0x20 ;; jump back to input section if not done

    83        0xDA ;; literal -36 == TM 18 (counter)

    84        0x01 ;; (item-hack) set BC to literal (no-op)

    85 

    86        ;; jump to target

    87        0x00  ;; (item-hack) these two bytes can be anything.

    88        0x01 

    89 

    90        0x00   ;; (item-hack) no-op

    91        0xBF   ;; (CP A A) ensures Z

    92        

    93        0xCA   ;; (item-hack) jump if Z

    94        target-low

    95        target-high

    96        0x01   ;; (item-hack) will never be reached.

    97        

    98        ;; input first nybble

    99        0x00

   100        0xCB

   101        0x37  ;; swap nybbles on A

   102 

   103        0x57  ;; A -> D

   104 

   105        0x37  ;; (item-hack) set carry flag no-op

   106        0x18  ;; relative jump backwards

   107        0xCD  ;; literal -51 == TM05; go back to input section

   108        0x01  ;; (item-hack) will never reach this instruction

   109 

   110        ]

   111       (repeat 8 [0x00 0x01])

   112 

   113       [;; jump to actual program

   114        0x00

   115        0x37  ;; (item-hack) set carry flag no-op

   116 

   117        0x2E  ;; 0x3A -> L

   118        0x3A

   119 

   120 

   121        0x00  ;; (item-hack) no-op

   122        0x26  ;; 0xD5 -> L

   123        0xD5  

   124        0x01  ;; (item-hack) set-carry BC

   125 

   126        0x00  ;; (item-hack) these can be anything

   127        0x01  

   128 

   129        0x00

   130        0xE9 ;; jump to (HL)

   131        ]])))

   132 

   133 (defn view-desired-item-layout []

   134   (clojure.pprint/pprint

   135    (raw-inventory->inventory (pc-item-writer-program))))

   136 

   137 (defn pc-item-writer-state []

   138     (-> (read-state "bootstrap-init")

   139       (set-memory pc-item-list-start 50)

   140       (set-memory-range

   141        map-function-address-start

   142        [0x8B 0xD5])

   143       (set-memory-range

   144        (inc pc-item-list-start)

   145        (pc-item-writer-program))))

   146 

   147 (defn test-pc-item-writer []

   148   (let [orig (read-state "pc-item-writer")]

   149     (-> orig

   150     (print-listing 0xD162 (+ 0xD162 20))

   151     (run-moves (reduce concat

   152                 (repeat 10 [[:a :b :start :select] []])))

   153     ((fn [_] (println "===========") _))

   154     (print-listing 0xD162 (+ 0xD162 20)))))

   155 

   156 (defn close-all-menus [[moves state :as script]]

   157   (loop [s script]

   158     (let [depth (current-depth (second (do-nothing 50 s)))]

   159       (println "depth" depth)

   160       (if (= depth 1)

   161         s

   162         (recur (close-menu s))))))

   163 

   164 (defn-memo name-rival

   165   ([] (name-rival (to-rival-name)))

   166   ([script]

   167      (->> script

   168           (first-difference [] [:a] AF)

   169           (first-difference [] [:r] DE)

   170           (play-moves

   171            [[]

   172             [] [] [:r] [] [:d] [:a]           ;; L

   173             [:r] [] [:r] [] [:r] [] [:r] [] 

   174             [:r] [] [:d] [] [:d] [:a]         ;; [PK]

   175             [:d] [] [:r] [:a]

   176             ]))))

   177 

   178 (defn-memo to-room-pc

   179   ([] (to-room-pc (name-rival)))

   180   ([script]

   181      (->> script

   182           finish-title

   183           (walk [← ← ↑ ← ↑ ↑ ↑]))))

   184 

   185 (defn-memo bootstrap-corrupt-save

   186   ([] (bootstrap-corrupt-save (to-room-pc)))

   187   ([script]

   188    (->> script

   189         (do-save-corruption 2)

   190         (corrupt-item-list 0)

   191         close-all-menus)))

   192 

   193 (defn-memo begin-initial-deposits

   194   ([] (begin-initial-deposits

   195        (bootstrap-corrupt-save)))

   196   ([script]

   197      (->> script

   198           (first-difference [] [:a] AF)

   199           (scroll-text)

   200           (set-cursor 1)

   201           select-menu-entry)))

   202 

   203 (defn wait-for-quantity

   204   [[moves state :as script]]

   205   (if (not= (item-quantity-selected state) 1)

   206     (repeat-until-different [] item-quantity-selected script)

   207     script))

   208 

   209 (defn wait-for-cursor

   210   [[moves state :as script]]

   211   (if (not= (list-offset state) 0)

   212     (repeat-until-different [] list-offset script)

   213     script))

   214 

   215 (defn deposit-held-item [n quantity [moves state :as script]]

   216   (let [total-quantity (second (nth-item state n))]

   217     (println "total-quantity" total-quantity)

   218     (->> script

   219          (set-cursor n)

   220          (select-menu-entry 1)

   221          (wait-for-quantity)

   222          (set-quantity total-quantity quantity)

   223          (delayed-difference [] [:a] 100 #(search-string % "stored"))

   224          (scroll-text))))

   225 

   226 (defn sell-held-item [n quantity [moves state :as script]]

   227   (let [total-quantity (second (nth-item state n))]

   228     (->> script

   229          (wait-for-cursor)  ;; when selling, the cursor always

   230          (set-cursor n)     ;; returns to the top of the list.

   231          (select-menu-entry 1)

   232          (wait-for-quantity)

   233          (set-quantity total-quantity quantity)

   234          (delayed-difference [] [:a] 100 current-depth)

   235          (play-moves (repeat 20 [:b]))

   236          (delayed-difference [] [:a] 100 #(search-string % "What"))

   237          )))

   238 

   239 (defn widthdraw-pc-item [n quantity [moves state :as script]]

   240   (let [total-quantity (second (nth-pc-item state n))]

   241     (->> script

   242          (set-cursor n)

   243          (select-menu-entry 1)

   244          (wait-for-quantity)

   245          (set-quantity total-quantity quantity)

   246          (delayed-difference [] [:a] 100 #(search-string % "Withdrew"))

   247          (scroll-text))))

   248 

   249 (defn toss-held-item [n quantity [moves state :as script]]

   250   (let [total-quantity (second (nth-item state n))]

   251     (->> script

   252          (set-cursor n)

   253          (select-menu-entry 1)

   254          (set-cursor-relative 1)

   255          (select-menu-entry -1)

   256          (wait-for-quantity)

   257          (set-quantity total-quantity quantity)

   258          (play-moves [[:a]])

   259          (scroll-text)

   260          (delayed-difference [] [:a] 100 #(search-string % "Threw"))

   261          (scroll-text)

   262          )))

   263 

   264 (defn buy-item [n quantity [moves state :as script]]

   265   (->> script

   266        (set-cursor n)

   267        (purchase-item quantity)))

   268 

   269 

   270 (def desired-zero-quantities

   271   (map second (filter (comp (partial = 0) first)

   272                       (partition 2 (pc-item-writer-program)))))

   273   

   274 (defn-memo initial-deposits

   275   ([] (initial-deposits (begin-initial-deposits)))

   276   ([script]

   277      (->> script

   278           (deposit-held-item 0 0x1)

   279           ((fn [script]

   280              (reduce 

   281               (fn [script item] (deposit-held-item item 0xFF script))

   282               script

   283               (range 3 (+ 13 3)))))

   284           close-all-menus)))

   285 

   286 

   287 (defn-memo prepare-celadon-warp

   288   ([] (prepare-celadon-warp (initial-deposits)))

   289   ([script]

   290      (->> script

   291           (activate-start-menu)

   292           (set-cursor-relative 1)

   293           (select-menu-entry)

   294           (toss-held-item 35 0xFA)

   295           (close-all-menus))))

   296 

   297 

   298 ;;0 -- 256

   299 ;;1 -- 254

   300 ;;2 -- 254

   301 ;;3 -- 255

   302 

   303 (defn-memo restore-items

   304   ([] (restore-items (prepare-celadon-warp)))

   305   ([script]

   306      (->> script

   307           (first-difference [] [:a] AF)

   308           (scroll-text)

   309           (select-menu-entry)

   310           (widthdraw-pc-item 0 1)

   311           ;;(widthdraw-pc-item 0 99)

   312           ;;(widthdraw-pc-item 1 1)

   313           (widthdraw-pc-item 13 255)

   314           (close-all-menus))))

   315 

   316 (defn-memo to-celadon

   317   ([] (to-celadon (restore-items)))

   318   ([script]

   319      (->> script

   320           (walk [→ → → → → → → ↑

   321                  ↓ ↓ ↓ ↓ ↓ ← ← ← ←

   322                  ↓ ↓]))))

   323 

   324 

   325 ;; celadon store inventory

   326 

   327 ;; Floor 2

   328 ;;=====================================

   329 ;; Great Ball        TM32 (double-team)

   330 ;; Super Potion      TM33 (reflect)

   331 ;; Revive            TM02 (razor-wind)

   332 ;; Super Repel       TM07 (horn-drill)

   333 ;; Antidote          TM37 (egg-bomb)

   334 ;; Burn Heal         TM01 (mega-punch)

   335 ;; Ice Heal          TM05 (mega-kick)

   336 ;; Awakening         TM09 (take-down)

   337 ;; Parlyz Heal       TM17 (submission)

   338 

   339 

   340 ;; Floor 3

   341 ;;=====================================       

   342 ;; TM18 (counter)

   343 

   344 

   345 ;; Floor 4

   346 ;;=====================================

   347 ;; Poke Doll

   348 ;; Fire Stone

   349 ;; Thunder Stone

   350 ;; Water Stone

   351 ;; Leaf Stone

   352 

   353 ;; Floor 5

   354 ;;=====================================

   355 ;; X Accuracy         HP UP

   356 ;; Guard Spec.        Protein

   357 ;; Dire Hit           Iron

   358 ;; X Attack           Carbos

   359 ;; X Defend           Calcium

   360 ;; X Speed            

   361 ;; X Special

   362 

   363 ;; Roof

   364 ;;=====================================

   365 ;; Fresh Water        TM13 (ice-beam)

   366 ;; Soda Pop           TM48 (rock-slide)

   367 ;; Lemonade :)        TM49 (tri-attack)

   368 

   369 

   370 (defn-memo go-to-floor-two

   371   ([] (go-to-floor-two (to-celadon)))

   372   ([script]

   373      (->> script

   374           (walk [↑ → → → → → → → → → → →

   375                  ↑ ↑ ↑ ↑ ↑ ↑

   376                  ← ← ← ← 

   377                  ↓ ↓ ↓

   378                  ← ←])

   379           (first-difference [] ↑ AF))))

   380 

   381 (defn talk

   382   "Assumes that you are facing something that initiates text and

   383    causes it to do so."

   384   [script]

   385   (->> script

   386        (delayed-difference [] [:a] 100

   387                            #(aget (memory %) text-address))))

   388 

   389 (defn-memo get-money-floor-two

   390   ([] (get-money-floor-two (go-to-floor-two)))

   391   ([script]

   392      (->> script

   393           talk

   394           (set-cursor 1)

   395           (select-menu-entry)

   396           (sell-held-item 0 1)

   397           (sell-held-item 0 1)

   398           (close-menu))))

   399 

   400 (defn-memo floor-two-TMs

   401   ([] (floor-two-TMs (get-money-floor-two)))

   402   ([script]

   403      (->> script

   404           (wait-for-cursor)

   405           (select-menu-entry)

   406           (buy-item 2 98)  ;; TM02 (razor-wind)

   407           (buy-item 4 71)  ;; TM37 (doubleteam)

   408           (buy-item 5 63)  ;; TM01 (mega-punch)

   409           (buy-item 6 1)   ;; TM05 (mega-kick)

   410           (buy-item 7 56)  ;; TM09 (take-down)

   411           (close-menu))))

   412 

   413 (defn end-shop-conversation

   414   [script]

   415   (->> script

   416        (wait-until scroll-text [:b])

   417        (play-moves [[] [:b]])

   418        close-menu))

   419 

   420 (defn-memo floor-two-more-money

   421   ([] (floor-two-more-money (floor-two-TMs)))

   422   ([script]

   423      (->> script

   424           (wait-for-cursor)

   425           (set-cursor 1)

   426           (select-menu-entry)

   427           (sell-held-item 0 1)

   428           (sell-held-item 0 1)

   429           close-menu

   430           end-shop-conversation)))

   431 

   432 (defn turn [direction script]

   433   (->> script

   434        (first-difference [] direction AF)))

   435 

   436 (defn-memo floor-two-items

   437   ([] (floor-two-items (floor-two-more-money)))

   438   ([script]

   439      (->> script

   440           (walk [←])

   441           (turn ↑)

   442           talk

   443           select-menu-entry

   444           (buy-item 5 12)  ;; burn heal

   445           (buy-item 6 55)  ;; ice heal

   446           (buy-item 7 4)   ;; awakening

   447           (buy-item 8 99)  ;; parlyz heal

   448           (buy-item 8 55)  ;; parlyz heal

   449           close-menu

   450           end-shop-conversation)))

   451 

   452 (defn-memo go-to-floor-three

   453   ([] (go-to-floor-three (floor-two-items)))

   454   ([script]

   455      (->> script

   456           (walk [→ → → → → → → → → → ↑ ↑ ↑

   457                    → ↑]))))

   458 (defn-memo get-TM18

   459   ([] (get-TM18 (go-to-floor-three)))

   460   ([script]

   461      (->> script

   462           (walk [↓ ↓])

   463           talk

   464           (scroll-text 3)

   465           end-text)))

   466 

   467 (defn-memo go-to-floor-four

   468   ([] (go-to-floor-four (get-TM18)))

   469   ([script]

   470      (->> script

   471           (walk [← ← ← ← ↑ ↑

   472                  ↓ ← ← ↓ ↓ ↓

   473                  ← ← ← ← ←])

   474           (turn ↓))))

   475 

   476 (defn-memo floor-four-items

   477   ([] (floor-four-items (go-to-floor-four)))

   478   ([script]

   479      (->> script

   480           talk

   481           select-menu-entry

   482           (buy-item 1 23)  ;; Fire Stone

   483           (buy-item 2 98)  ;; Thunder Stone

   484           (buy-item 3 29)  ;; Water Stone

   485           close-menu

   486           end-shop-conversation)))

   487 

   488 (defn-memo go-to-floor-five

   489   ([] (go-to-floor-five (floor-four-items)))

   490   ([script]

   491      (->> script

   492           (walk [→ → → → → →

   493                  ↑ ↑ ↑

   494                  → → → → → ↑ ;; leave floor four

   495                  ↓ ← ← ← ← ← ← ← ←

   496                  ↓ ↓ ↓ ← ← ← ]);; go to five's clerk

   497           (turn ↑))))

   498                 

   499 (defn-memo floor-five-items

   500   ([] (floor-five-items (go-to-floor-five)))

   501   ([script]

   502      (->> script

   503           talk

   504           select-menu-entry

   505           (buy-item 0 58)   ;; X-Accuracy

   506           (buy-item 1 99)   ;; Guard Spec.

   507           (buy-item 1 24)   ;; Guard Spec.

   508           close-menu

   509           end-shop-conversation)))

   510 

   511 (defn-memo go-to-roof

   512   ([] (go-to-roof (floor-five-items)))

   513   ([script]

   514      (->> script

   515           (walk [→ → → → ↑ ↑ ↑ → → → ↑ ;; leave floor five

   516                  ↓ ← ← ←]) ;; walk to vending machine

   517           (turn ↑))))

   518 

   519 (defn buy-drink

   520   "Assumes you're in front of the vending machine. Buys the indicated

   521    drink."

   522   [n script]

   523   (->> script

   524        (do-nothing 20)

   525        (play-moves [[:a][:a]])

   526        scroll-text

   527        (wait-for-cursor)

   528        (set-cursor n)

   529        select-menu-entry

   530        close-menu))

   531 

   532 (defn-memo roof-drinks

   533   ([] (roof-drinks (go-to-roof)))

   534   ([script]

   535      (->> script

   536           (buy-drink 0) ;; fresh water (for TM13)

   537           ;; buy 16 lemonades

   538           ;; LEMONADE is the best item <3  :)

   539           (multiple-times 16 (partial buy-drink 2)))))

   540 

   541 (defn-memo get-TM13

   542   ([] (get-TM13 (roof-drinks)))

   543   ([script]

   544      (->> script

   545           (walk [← ← ← ← ← ← ↓])

   546           (play-moves [[][:a][:a][]])

   547           (scroll-text 3)

   548           select-menu-entry

   549           select-menu-entry

   550           (scroll-text 6)

   551           close-menu)))

   552 

   553 (defn-memo to-celadon-poke-center

   554   ([] (to-celadon-poke-center (get-TM13)))

   555   ([script]

   556      (->> script

   557           (walk [↑ → → → → → → → → → ↑])       ; leave roof

   558           (walk [↓ ← ← ← ← ↓ ↓ ↓ ← ← ← ← ← 

   559                  ↑ ↑ ↑ ← ← ↑])                 ; to elevator

   560                  

   561           (walk [→ → ↑ ↑])                     ; to controls

   562           talk

   563           select-menu-entry                    ; to floor 1

   564           (walk [↓ ↓ ← ←])

   565           (walk [↓ → ↓ ↓ ↓ ↓ ↓ ↓])             ; leave store

   566           (walk [↓ → → → → → → → → → → ↑ ↑])

   567           (walk (repeat 23 →))

   568           (walk [↑ ↑ ↑ ↑])                     ; enter poke center

   569           (walk [↑ ↑ ↑ → → → → → → → → → →])   ; to computer

   570           (turn ↑))))

   571 

   572 (defn activate-rlm-pc [script]

   573   (->> script

   574        talk

   575        scroll-text

   576        wait-for-cursor

   577        (set-cursor 1)

   578        select-menu-entry

   579        (scroll-text 2)))

   580 

   581 (defn begin-deposit [script]

   582   (->> script

   583        (set-cursor 1)

   584        select-menu-entry))

   585 

   586 (defn begin-withdraw [script]

   587   (->> script

   588        (set-cursor 0)

   589        (select-menu-entry)))

   590 

   591 (defn deposit-held-item-named

   592   [item-name quantity [moves state :as script]]

   593   (let [index (count

   594                (take-while

   595                 (fn [[name quant]]

   596                   (or (not= name item-name)

   597                       (< quant quantity)))

   598                   (inventory state)))]

   599     (println "index" index)

   600     (deposit-held-item index quantity script)))

   601 

   602 

   603 (defn-memo begin-hacking

   604   ([] (begin-hacking(to-celadon-poke-center)))

   605   ([script]

   606      (->> script

   607           activate-rlm-pc

   608           begin-deposit

   609           (deposit-held-item-named 0x00           30)

   610           (deposit-held-item-named :TM01          63)

   611           (deposit-held-item-named :awakening      4)

   612           (deposit-held-item-named :thunderstone  98)

   613           (deposit-held-item-named :TM09          55)

   614           (deposit-held-item-named 0x00           55))))

   615 

   616 (defn open-held-items

   617   [script]

   618   (->> script

   619        select-menu-entry))

   620 

   621 (defn to-held-items

   622   [script]

   623   (->> script

   624        close-menu

   625        close-menu

   626        end-text;;; grr

   627        

   628        activate-start-menu

   629        open-held-items))

   630 

   631 (defn-memo hacking-2

   632   ([] (hacking-2 (begin-hacking)))

   633   ([script]

   634      (->> script

   635           (to-held-items)

   636           (toss-held-item 0 166) ;; discard cruft

   637           close-menu

   638           close-menu)))

   639 

   640 (defn-memo hacking-3

   641   ([] (hacking-3 (hacking-2)))

   642   ([script]

   643      (->> script

   644           activate-rlm-pc

   645           begin-withdraw

   646           (widthdraw-pc-item 0 99)

   647           (widthdraw-pc-item 0 1)

   648           (widthdraw-pc-item 2 0xFE)

   649           (widthdraw-pc-item 3 0xFE))))

   650           

   651 (defn-memo hacking-4

   652   ([] (hacking-4 (hacking-3)))

   653   ([script]

   654      (->> script

   655           close-menu

   656           begin-deposit

   657           (deposit-held-item 19 243)

   658           (deposit-held-item-named :lemonade 16)

   659           (deposit-held-item 18 224))))

   660           

   661 (defn-memo hacking-5

   662   "clean out the held-item list again"

   663   ([] (hacking-5 (hacking-4)))

   664   ([script]

   665      (->> script

   666           (to-held-items)

   667           (toss-held-item 18 30)

   668           (toss-held-item 17 1)

   669           close-menu

   670           close-menu)))

   671 

   672 (defn-memo hacking-6

   673   ([] (hacking-6 (hacking-5)))

   674   ([script]

   675      (->> script

   676           activate-rlm-pc

   677           begin-withdraw

   678           (widthdraw-pc-item 4 0xFE)

   679           (widthdraw-pc-item 5 0xFE)

   680           (widthdraw-pc-item 6 0xFE)

   681           close-menu)))

   682 

   683 (defn-memo hacking-7

   684   ([] (hacking-7 (hacking-6)))

   685   ([script]

   686      (->> script

   687           begin-deposit

   688           (deposit-held-item 19 240)

   689           (deposit-held-item 18 230)

   690           (deposit-held-item-named :parlyz-heal 55)

   691           (deposit-held-item 17 184)

   692           (deposit-held-item 17 40)

   693           (deposit-held-item-named :TM37 71)

   694           (deposit-held-item-named :ice-heal 55)

   695           (deposit-held-item-named :fire-stone 23)

   696           (deposit-held-item-named :burn-heal 12))))

   697
author	Robert McIntyre <rlm@mit.edu>
date	Mon, 09 Apr 2012 11:31:09 -0500
parents	958a333f16e2
children	985e91060567