Mercurial > vba-clojure

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

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

     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 pokemon-list-start)]

    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]);; these can be anything

   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 print-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 wait-for-quantity

   186 ;;   [[moves state :as script]]

   187 ;;   (if (not= (item-quantity-selected state) 1)

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

   189 ;;     script))

   190 

   191 ;; TODO use this:

   192 ;;(wait-until (partial set-cursor-relative 1))

   193 

   194 ;; (defn wait-for-cursor

   195 ;;   [[moves state :as script]]

   196 ;;   (if (not= (list-offset state) 0)

   197 ;;     (repeat-until-different [] list-offset script)

   198 ;;     script))

   199 

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

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

   202     (println "total-quantity" total-quantity)

   203     (->> script

   204          (set-cursor n)

   205          (select-menu-entry 1)

   206          ;;(wait-for-quantity)

   207          (set-quantity total-quantity quantity)

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

   209          (scroll-text))))

   210 

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

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

   213     (->> script

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

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

   216          (select-menu-entry 1)

   217          ;;(wait-for-quantity)

   218          (set-quantity total-quantity quantity)

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

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

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

   222          )))

   223 

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

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

   226     (->> script

   227          (set-cursor n)

   228          (select-menu-entry 1)

   229          ;;(wait-for-quantity)

   230          (set-quantity total-quantity quantity)

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

   232          (scroll-text))))

   233 

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

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

   236     (->> script

   237          (set-cursor n)

   238          (select-menu-entry 1)

   239          (set-cursor-relative 1)

   240          (select-menu-entry -1)

   241          ;;(wait-for-quantity)

   242          (set-quantity total-quantity quantity)

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

   244          (scroll-text)

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

   246          (scroll-text)

   247          )))

   248 

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

   250   (->> script

   251        (set-cursor n)

   252        (purchase-item quantity)))

   253 

   254 (defn switch-items [item-fn idx-1 idx-2 script]

   255   (->> script

   256        (wait-until select-menu-entry)

   257        (set-cursor idx-1)

   258        (wait-until select-menu-entry)

   259        (play-moves [[][:select][]])

   260        (set-cursor idx-2)

   261        (delayed-difference [] [:select] 100

   262                            #(item-fn % (list-offset %)))))

   263 

   264 (def switch-pc-items (partial switch-items nth-pc-item))

   265 (def switch-held-items (partial switch-items nth-item))

   266 

   267 (defn combine-pc-items [idx-1 script]

   268   (->> script

   269        (switch-pc-items idx-1 (inc idx-1))))

   270 

   271 (def desired-zero-quantities

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

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

   274 

   275 (defn-memo bootstrap-corrupt-save

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

   277   ([script]

   278    (->> script

   279         (do-save-corruption 3)

   280         (corrupt-item-list 0)

   281         close-all-menus)))

   282 

   283 (defn-memo prepare-celadon-warp

   284   ([] (prepare-celadon-warp (bootstrap-corrupt-save)))

   285   ([script]

   286      (->> script

   287           (activate-start-menu)

   288           (set-cursor-relative 1)

   289           (select-menu-entry)

   290           ;; vastly increase text speed while we're here.

   291           (switch-held-items 21 27)

   292           (toss-held-item 35 0xFA)

   293           (close-all-menus))))

   294 

   295 (defn-memo begin-initial-deposits

   296   ([] (begin-initial-deposits

   297        (prepare-celadon-warp)))

   298   ([script]

   299      (->> script

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

   301           (scroll-text)

   302           (set-cursor 1)

   303           select-menu-entry)))

   304 

   305 (defn-memo initial-deposits

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

   307   ([script]

   308      (->> script

   309           (deposit-held-item 0 0x1)

   310           ((fn [script]

   311              (reduce 

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

   313               script

   314               (range 3 (+ 13 3)))))

   315           close-all-menus)))

   316 

   317 

   318 ;;0 -- 256

   319 ;;1 -- 254

   320 ;;2 -- 254

   321 ;;3 -- 255

   322 

   323 (defn activate-home-pc

   324   [script]

   325   (->> script

   326        (delayed-difference [] [:a]

   327                            200 first-character)

   328        (scroll-text)))

   329 

   330 (defn-memo restore-items

   331   ([] (restore-items (initial-deposits)))

   332   ([script]

   333      (->> script

   334           activate-home-pc

   335           (select-menu-entry)

   336           (widthdraw-pc-item 0 1)

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

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

   339           (widthdraw-pc-item 13 255)

   340           (close-all-menus))))

   341 

   342 (defn-memo to-celadon

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

   344   ([script]

   345      (->> script

   346           (walk [→ → → → → → → ↑

   347                  ↓ ↓ ↓ ↓ ↓ ← ← ← ←

   348                  ↓ ↓]))))

   349 

   350 

   351 ;; celadon store inventory

   352 

   353 ;; Floor 2

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

   355 ;; Great Ball        TM32 (double-team)

   356 ;; Super Potion      TM33 (reflect)

   357 ;; Revive            TM02 (razor-wind)

   358 ;; Super Repel       TM07 (horn-drill)

   359 ;; Antidote          TM37 (egg-bomb)

   360 ;; Burn Heal         TM01 (mega-punch)

   361 ;; Ice Heal          TM05 (mega-kick)

   362 ;; Awakening         TM09 (take-down)

   363 ;; Parlyz Heal       TM17 (submission)

   364 

   365 

   366 ;; Floor 3

   367 ;;=====================================       

   368 ;; TM18 (counter)

   369 

   370 

   371 ;; Floor 4

   372 ;;=====================================

   373 ;; Poke Doll

   374 ;; Fire Stone

   375 ;; Thunder Stone

   376 ;; Water Stone

   377 ;; Leaf Stone

   378 

   379 ;; Floor 5

   380 ;;=====================================

   381 ;; X Accuracy         HP UP

   382 ;; Guard Spec.        Protein

   383 ;; Dire Hit           Iron

   384 ;; X Attack           Carbos

   385 ;; X Defend           Calcium

   386 ;; X Speed            

   387 ;; X Special

   388 

   389 ;; Roof

   390 ;;=====================================

   391 ;; Fresh Water        TM13 (ice-beam)

   392 ;; Soda Pop           TM48 (rock-slide)

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

   394 

   395 

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

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

   398   ([script]

   399      (->> script

   400           (walk [↑ → → → → → → → → → → →

   401                  ↑ ↑ ↑ ↑ ↑ ↑

   402                  ← ← ← ← 

   403                  ↓ ↓ ↓

   404                  ← ←])

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

   406 

   407 (defn talk

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

   409    causes it to do so."

   410   [script]

   411   (->> script

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

   413                            first-character)))

   414 

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

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

   417   ([script]

   418      (->> script

   419           talk

   420           (set-cursor 1)

   421           (select-menu-entry)

   422           (sell-held-item 0 1)

   423           (sell-held-item 0 1)

   424           (close-menu))))

   425 

   426 (defn-memo floor-two-TMs

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

   428   ([script]

   429      (->> script

   430           (set-cursor 0)

   431           (select-menu-entry)

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

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

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

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

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

   437           (close-menu))))

   438 

   439 (defn end-shop-conversation

   440   [script]

   441   (->> script

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

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

   444        close-menu))

   445 

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

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

   448   ([script]

   449      (->> script

   450           (set-cursor 1)

   451           (select-menu-entry)

   452           (sell-held-item 0 1)

   453           (sell-held-item 0 1)

   454           close-menu

   455           end-shop-conversation)))

   456 

   457 (defn turn [direction script]

   458   (->> script

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

   460 

   461 (defn-memo floor-two-items

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

   463   ([script]

   464      (->> script

   465           (walk [←])

   466           (turn ↑)

   467           talk

   468           select-menu-entry

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

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

   471           (buy-item 7 4)   ;; awakening

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

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

   474           close-menu

   475           end-shop-conversation)))

   476 

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

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

   479   ([script]

   480      (->> script

   481           (walk [→ → → → → → → → → → ↑ ↑ ↑

   482                    → ↑]))))

   483 (defn-memo get-TM18

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

   485   ([script]

   486      (->> script

   487           (walk [↓ ↓])

   488           talk

   489           (scroll-text 3)

   490           end-text)))

   491 

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

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

   494   ([script]

   495      (->> script

   496           (walk [← ← ← ← ↑ ↑

   497                  ↓ ← ← ↓ ↓ ↓

   498                  ← ← ← ← ←])

   499           (turn ↓))))

   500 

   501 (defn-memo floor-four-items

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

   503   ([script]

   504      (->> script

   505           talk

   506           select-menu-entry

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

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

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

   510           close-menu

   511           end-shop-conversation)))

   512 

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

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

   515   ([script]

   516      (->> script

   517           (walk [→ → → → → →

   518                  ↑ ↑ ↑

   519                  → → → → → ↑ ;; leave floor four

   520                  ↓ ← ← ← ← ← ← ← ←

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

   522           (turn ↑))))

   523                 

   524 (defn-memo floor-five-items

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

   526   ([script]

   527      (->> script

   528           talk

   529           select-menu-entry

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

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

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

   533           close-menu

   534           end-shop-conversation)))

   535 

   536 (defn-memo go-to-roof

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

   538   ([script]

   539      (->> script

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

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

   542           (turn ↑))))

   543 

   544 (defn buy-drink

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

   546    drink."

   547   [n script]

   548   (->> script

   549        (do-nothing 20)

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

   551        scroll-text

   552        (set-cursor n)

   553        select-menu-entry

   554        close-menu))

   555 

   556 (defn-memo roof-drinks

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

   558   ([script]

   559      (->> script

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

   561           ;; buy 16 lemonades

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

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

   564 

   565 (defn-memo get-TM13

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

   567   ([script]

   568      (->> script

   569           ;;(walk [← ← ← ← ← ← ↓])

   570           (walk [↓ ↓ ↓ ← ← ← ← ← ←])

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

   572           (scroll-text 3)

   573           select-menu-entry

   574           select-menu-entry

   575           (scroll-text 6)

   576           close-menu)))

   577 

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

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

   580   ([script]

   581      (->> script

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

   583           (walk [→ → → → → → → → → ↑ ↑ ↑ ↑])

   584           (walk [↓ ← ← ← ← ↓ ↓ ↓ ← ← ← ← ← 

   585                  ↑ ↑ ↑ ← ← ↑])                 ; to elevator

   586                  

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

   588           talk

   589           select-menu-entry                    ; to floor 1

   590           (walk [↓ ↓ ← ←])

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

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

   593           (walk (repeat 23 →))

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

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

   596           (turn ↑))))

   597 

   598 (defn activate-rlm-pc [script]

   599   (->> script

   600        talk

   601        scroll-text

   602        ;;wait-for-cursor

   603        (set-cursor 1)

   604        select-menu-entry

   605        (scroll-text 2)))

   606 

   607 (defn begin-deposit [script]

   608   (->> script

   609        (set-cursor 1)

   610        select-menu-entry))

   611 

   612 (defn begin-withdraw [script]

   613   (->> script

   614        (set-cursor 0)

   615        (select-menu-entry)))

   616 

   617 (defn deposit-held-item-named

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

   619   (let [index (count

   620                (take-while

   621                 (fn [[name quant]]

   622                   (or (not= name item-name)

   623                       (< quant quantity)))

   624                   (inventory state)))]

   625     (println "index" index)

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

   627 

   628 (defn open-held-items

   629   [script]

   630   (->> script

   631        select-menu-entry))

   632 

   633 (defn to-held-items

   634   [script]

   635   (->> script

   636        close-menu

   637        close-menu

   638        end-text;;; grr

   639        

   640        activate-start-menu

   641        open-held-items))

   642 

   643 (defn toss-pc-item [n quantity  [moves state :as script]]

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

   645     (->> script

   646          (set-cursor n)

   647          (select-menu-entry 1)

   648          (set-quantity total-quantity quantity)

   649          (delayed-difference [] [:a] 100 #(search-string % "Is"))

   650          (scroll-text)

   651          select-menu-entry

   652          (scroll-text))))

   653 

   654 (defn-memo hacking-1

   655   ([] (hacking-1 (to-celadon-poke-center)))

   656   ([script]

   657      (->> script

   658           activate-rlm-pc

   659           begin-deposit

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

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

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

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

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

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

   666 

   667 (defn-memo hacking-2

   668   ([] (hacking-2 (hacking-1)))

   669   ([script]

   670      (->> script

   671           (to-held-items)

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

   673           close-menu

   674           close-menu)))

   675 

   676 (defn-memo hacking-3

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

   678   ([script]

   679      (->> script

   680           activate-rlm-pc

   681           begin-withdraw

   682           (widthdraw-pc-item 0 99)

   683           (widthdraw-pc-item 0 1)

   684           (widthdraw-pc-item 2 0xFE)

   685           (widthdraw-pc-item 3 0xFE)

   686           close-menu)))

   687           

   688 (defn-memo hacking-4

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

   690   ([script]

   691      (->> script

   692           begin-deposit

   693           (deposit-held-item 19 243)

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

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

   696           

   697 (defn-memo hacking-5

   698   "clean out the held-item list again"

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

   700   ([script]

   701      (->> script

   702           (to-held-items)

   703           (toss-held-item 18 30)

   704           (toss-held-item 17 1)

   705           close-menu

   706           close-menu)))

   707 

   708 (defn-memo hacking-6

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

   710   ([script]

   711      (->> script

   712           activate-rlm-pc

   713           begin-withdraw

   714           (widthdraw-pc-item 4 0xFE)

   715           (widthdraw-pc-item 5 0xFE)

   716           (widthdraw-pc-item 6 0xFE)

   717           close-menu)))

   718 

   719 (defn-memo hacking-7

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

   721   ([script]

   722      (->> script

   723           begin-deposit

   724           (deposit-held-item 19 240)

   725           (deposit-held-item 18 230)

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

   727           (deposit-held-item 17 184)

   728           (deposit-held-item 17 40)

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

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

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

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

   733           ;; as a special case, /don't/ close the menu.

   734           )))

   735 

   736 (defn-memo hacking-8

   737   "Clear cruft away from held item list."

   738   ([] (hacking-8 (hacking-7)))

   739   ([script]

   740      (->> script

   741           to-held-items

   742           (toss-held-item 15 1)

   743           (toss-held-item 14 1)

   744           (toss-held-item 13 1)

   745           close-menu

   746           close-menu)))

   747 

   748 (defn-memo hacking-9

   749   ([] (hacking-9 (hacking-8)))

   750   ([script]

   751      (->> script

   752           activate-rlm-pc

   753           begin-withdraw

   754           (widthdraw-pc-item 7 0xFE)

   755           (widthdraw-pc-item 8 0xFC)

   756           (widthdraw-pc-item 8 1)

   757           (widthdraw-pc-item 8 1)

   758           (widthdraw-pc-item 9 0xFE)

   759           (multiple-times

   760            7

   761            (partial combine-pc-items 2))

   762           close-menu)))

   763           

   764 (defn-memo hacking-10

   765   ([] (hacking-10 (hacking-9)))

   766   ([script]

   767      (->> script

   768           begin-deposit

   769           (deposit-held-item 17 230)

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

   771           (deposit-held-item 14 178)

   772           (deposit-held-item-named :water-stone 29)

   773           (deposit-held-item 14 32)

   774           (deposit-held-item-named :TM18 1)

   775           (deposit-held-item 13 1)

   776           (deposit-held-item 13 191)

   777           (deposit-held-item-named :TM02 98)

   778           (deposit-held-item-named :TM09 1)

   779           close-menu)))

   780 

   781 (defn-memo hacking-11

   782   ([] (hacking-11 (hacking-10)))

   783   ([script]

   784      (->> script

   785           begin-withdraw

   786           (widthdraw-pc-item 3 0xFE)

   787           (widthdraw-pc-item 4 0xFE)

   788           (widthdraw-pc-item 5 1)

   789           (widthdraw-pc-item 5 1)

   790           (widthdraw-pc-item 5 1)

   791           (widthdraw-pc-item 5 0xFB)

   792           (multiple-times

   793            3

   794            (partial combine-pc-items 2))

   795           close-menu)))

   796 

   797 (defn-memo hacking-12

   798   ([] (hacking-12 (hacking-11)))

   799   ([script]

   800      (->> script

   801           begin-deposit

   802           (deposit-held-item 18 203)

   803           (deposit-held-item-named :guard-spec 87)

   804           (deposit-held-item-named :guard-spec 24)

   805           (deposit-held-item-named :TM05 1)

   806           (multiple-times

   807            8

   808            (partial deposit-held-item 14 1))

   809           (deposit-held-item 14 55)

   810           (deposit-held-item-named :x-accuracy 58)

   811           (deposit-held-item 14 38)

   812           (deposit-held-item-named :TM13 1)

   813           (deposit-held-item 13 1)

   814           (deposit-held-item 13 233)

   815           close-menu)))

   816        

   817 (defn-memo hacking-13

   818   ([] (hacking-13 (hacking-12)))

   819   ([script]

   820      (->> script

   821           (set-cursor-relative 1)

   822           (select-menu-entry)

   823           (toss-pc-item 1 1)

   824           (toss-pc-item 0 156)

   825           (toss-pc-item 0 11))))

   826 

   827 (defn confirm-pattern []

   828   (let [start-address (inc pc-item-list-start)

   829         target-pattern (pc-item-writer-program)

   830         actual-pattern

   831         (subvec (vec (memory (second (hacking-13))))

   832                 start-address

   833                 (+ start-address (count target-pattern)))]

   834     (println target-pattern)

   835     (println actual-pattern)

   836     (= target-pattern actual-pattern)))

   837 

   838 (defn-memo go-to-mansion-for-the-lulz

   839   ([] (go-to-mansion-for-the-lulz (hacking-13)))

   840   ([script]

   841      (->> script

   842           close-menu

   843           close-menu

   844           end-text ;;grr

   845           (walk [↓ ← ← ← ← ← ← ← ← ← ↓ ↓ ↓])

   846           (walk (repeat 17 ←))

   847           (walk [↑ → → → → ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])

   848           (walk [↓ ← ↑])

   849           (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓

   850                  ← ← ← ← ↑ ↑ ↑ ← ↑])

   851           (talk)

   852           (scroll-text 2)

   853           (do-nothing 100)

   854           close-menu)))

   855 

   856 (defn-memo launch-bootstrap-program

   857   ([] (launch-bootstrap-program

   858        (go-to-mansion-for-the-lulz)))

   859   ([script]

   860      (->> script

   861           ;; must corrupt item list again by switching pokemon

   862           activate-start-menu    ;; \

   863           (set-cursor 0)         ;; |

   864           select-menu-entry      ;; |

   865           select-menu-entry      ;; |

   866           (set-cursor 1)         ;; | -- switch 9th pokemon

   867           select-menu-entry      ;; |    with 4th pokemon

   868           (set-cursor 3)         ;; |

   869           select-menu-entry      ;; |

   870           close-menu             ;; /

   871           ;; now, open items and set map-function to

   872           ;; the program inside the item-computer.

   873           (set-cursor 1)

   874           (select-menu-entry)

   875           (toss-held-item 22 12)

   876           (switch-held-items 22 40)

   877           close-all-menus)))

   878 

   879 (defn regen-control-checkpoint!

   880   [] (write-script! (launch-bootstrap-program) "control-checkpoint"))

   881                     

   882 (defn control-checkpoint []

   883   (read-script "control-checkpoint"))

   884 

   885 (defn no-consecutive-repeats? [seq]

   886   (not (contains? (set(map - seq (rest seq))) 0)))

   887 

   888 (defn byte->nybbles [byte]

   889   [(bit-shift-right byte 4) (bit-and byte 0x0F)])

   890 

   891 (defn bootstrap-pattern

   892   "Given an assembly sequence, generate the keypresses required to

   893    create that sequence in memory using the pc-item-writer

   894    program. The assembly must not have any consecutive repeating

   895    nybbles."

   896   [assembly]

   897   (let [nybbles (flatten (map byte->nybbles assembly))

   898         moves (map (comp buttons (partial - 15)) nybbles)

   899         header (map buttons

   900                     (concat (repeat

   901                              50

   902                              (- 15 (first nybbles)))

   903                             [(first nybbles)]))

   904         tail (map buttons

   905                   (take

   906                    (- 201 (count moves))

   907                    (interleave (repeat 100 (last nybbles))

   908                                (repeat 1000 (- 15 (last nybbles))))))]

   909     (assert (no-consecutive-repeats? nybbles))

   910     (concat header moves tail)))

   911 

   912 (def increasing-pattern [0x01 0x23 0x45 0x67 0x89 0xAB 0xCD 0xEF])

   913 

   914 (defn test-pattern-writing

   915   ([] (test-pattern-writing increasing-pattern))

   916   ([pattern]

   917      (let [moves (bootstrap-pattern pattern)

   918            pattern-insertion

   919            (->> (launch-bootstrap-program)

   920                 (play-moves

   921                  (take 100 moves)))]

   922        (println "Input Pattern:")

   923        (apply println  (map #(format "0x%02X" %) pattern))

   924        (println "\nMemory Listing:")

   925        (print-listing (second pattern-insertion)

   926                       0xD162 (+ 0xD162 (count pattern)))

   927        (= (subvec (vec (memory (second pattern-insertion)))

   928                        0xD162 (+ 0xD162 (count pattern)))

   929           pattern))))

   930 

   931 

   932
author	Robert McIntyre <rlm@mit.edu>
date	Wed, 11 Apr 2012 10:47:27 -0500
parents	7c89fe478de4
children	0162dd315814