Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_0.clj @ 323:92ee94945327

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
rev   line source
rlm@247 1 (ns com.aurellem.run.bootstrap-0
rlm@320 2 (:use (com.aurellem.gb saves gb-driver util
rlm@320 3 items vbm characters money))
rlm@319 4 (:use (com.aurellem.run util title save-corruption))
rlm@264 5 (:use (com.aurellem.exp item-bridge))
rlm@264 6 (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@247 7
rlm@250 8 (defn-memo boot-root []
rlm@255 9 [ [] (root)])
rlm@247 10
rlm@255 11 (defn-memo to-rival-name
rlm@255 12 ([] (to-rival-name (boot-root)))
rlm@255 13 ([script]
rlm@319 14 (->> script
rlm@255 15 title
rlm@255 16 oak
rlm@255 17 name-entry-rlm
rlm@319 18 (scroll-text 5))))
rlm@247 19
rlm@255 20 (defn-memo name-rival-bootstrap
rlm@255 21 ([] (name-rival-bootstrap (to-rival-name)))
rlm@255 22 ([script]
rlm@255 23 (->> script
rlm@319 24 (first-difference [] [:a] AF)
rlm@319 25 (first-difference [] [:r] DE)
rlm@255 26 (play-moves
rlm@255 27 [[]
rlm@313 28 [] [] [:r] [] [:d] [:a] ;; L
rlm@313 29 [:r] [] [:r] [] [:r] [] [:r] []
rlm@313 30 [:r] [] [:d] [] [:d] [:a] ;; [PK]
rlm@313 31 [:u] [] [:l] [] [:l] []
rlm@313 32 [:l] [] [:l] [] [:l] [:a] ;; U
rlm@313 33 [:r] [] [:r] [] [:r] []
rlm@313 34 [:r] [] [:r] [] [:d] [:a] ;; [PK]
rlm@313 35 [] [:a] ;; [PK]
rlm@313 36 [] [:a] ;; [PK]
rlm@313 37 [:r] [] [:d] [:a] ;; END
rlm@255 38 ]))))
rlm@255 39
rlm@255 40 (defn-memo leave-house
rlm@255 41 ([] (leave-house (name-rival-bootstrap)))
rlm@255 42 ([script]
rlm@255 43 (->> script
rlm@255 44 finish-title
rlm@255 45 walk-to-stairs
rlm@255 46 walk-to-door
rlm@255 47 (walk [↓ ↓]))))
rlm@255 48
rlm@255 49 (defn-memo to-pallet-town-edge
rlm@255 50 ([] (to-pallet-town-edge (leave-house)))
rlm@255 51 ([script]
rlm@255 52 (->> script
rlm@255 53 (walk [→ → → → →
rlm@255 54 ↑ ↑ ↑ ↑ ↑ ↑]))))
rlm@255 55
rlm@257 56 (defn-memo start-pikachu-battle
rlm@257 57 ([] (start-pikachu-battle
rlm@257 58 (to-pallet-town-edge)))
rlm@257 59 ([script]
rlm@257 60 (->> script
rlm@319 61 (first-difference [:b] [:b :a] DE)
rlm@319 62 scroll-text
rlm@319 63 (do-nothing 200)
rlm@319 64 (play-moves [[:b]]))))
rlm@257 65
rlm@257 66 (defn-memo capture-pikachu
rlm@257 67 ([] (capture-pikachu (start-pikachu-battle)))
rlm@257 68 ([script]
rlm@257 69 (->> script
rlm@319 70 (scroll-text 3))))
rlm@257 71
rlm@257 72 (defn-memo go-to-lab
rlm@257 73 ([] (go-to-lab (capture-pikachu)))
rlm@257 74 ([script]
rlm@257 75 (->> script
rlm@319 76 end-text
rlm@257 77 (scroll-text 5)
rlm@319 78 end-text
rlm@319 79 ;; oak walks you to his lab; no input required.
rlm@319 80 (do-nothing 400))))
rlm@319 81
rlm@319 82 (defn-memo talk-to-oak-in-lab
rlm@319 83 ([] (talk-to-oak-in-lab (go-to-lab)))
rlm@319 84 ([script]
rlm@319 85 (->> script
rlm@319 86 (scroll-text 14)
rlm@319 87 end-text)))
rlm@319 88
rlm@319 89 (defn-memo try-to-get-eevee
rlm@319 90 ([] (try-to-get-eevee (talk-to-oak-in-lab)))
rlm@319 91 ([script]
rlm@319 92 (->> script
rlm@319 93 ;; walk to pokeball
rlm@319 94 (walk [↓ → →])
rlm@319 95 ;; and try to grab it
rlm@319 96 (play-moves
rlm@319 97 (concat [↑ ↑ [:a]]
rlm@319 98 (repeat 100 [])))
rlm@319 99 (scroll-text 10)
rlm@257 100 (end-text))))
rlm@257 101
rlm@257 102 (defn-memo obtain-pikachu
rlm@319 103 ([] (obtain-pikachu (try-to-get-eevee)))
rlm@257 104 ([script]
rlm@257 105 (->> script
rlm@319 106 (scroll-text 6)
rlm@319 107 (end-text))))
rlm@319 108
rlm@319 109
rlm@258 110 (defn-memo begin-battle-with-rival
rlm@258 111 ([] (begin-battle-with-rival
rlm@258 112 (obtain-pikachu)))
rlm@258 113 ([script]
rlm@258 114 (->> script
rlm@319 115 (walk [↓ ↓ ↓])
rlm@260 116 (scroll-text 3)
rlm@260 117 (end-text)
rlm@260 118 (scroll-text))))
rlm@260 119
rlm@319 120 (defn-memo defeat-eevee
rlm@319 121 ([] (defeat-eevee
rlm@260 122 (begin-battle-with-rival)))
rlm@260 123 ([script]
rlm@260 124 (->> script
rlm@313 125 (do-nothing 400)
rlm@260 126 (play-moves [[:a]])
rlm@260 127 (critical-hit)
rlm@319 128 (do-nothing 200)
rlm@319 129 (scroll-text 2) ;; for eevee's tail-whip
rlm@319 130 (do-nothing 10)
rlm@313 131 (play-moves [[:a]])
rlm@260 132 (critical-hit)
rlm@319 133 (do-nothing 200)
rlm@319 134 (scroll-text 2) ;; tail whip again
rlm@319 135 (do-nothing 10)
rlm@313 136 (play-moves [[:a]])
rlm@313 137 (critical-hit)
rlm@319 138 (do-nothing 200))))
rlm@260 139
rlm@260 140 (defn-memo finish-rival-text
rlm@260 141 ([] (finish-rival-text
rlm@319 142 (defeat-eevee)))
rlm@260 143 ([script]
rlm@260 144 (->> script
rlm@319 145 (scroll-text 12)
rlm@260 146 (end-text))))
rlm@260 147
rlm@262 148 (defn-memo pikachu-comes-out
rlm@262 149 ([] (pikachu-comes-out
rlm@262 150 (finish-rival-text)))
rlm@262 151 ([script]
rlm@262 152 (->> script
rlm@319 153 (scroll-text 8)
rlm@262 154 (end-text))))
rlm@260 155
rlm@262 156 (defn-memo leave-oaks-lab
rlm@262 157 ([] (leave-oaks-lab
rlm@262 158 (pikachu-comes-out)))
rlm@262 159 ([script]
rlm@262 160 (->> script
rlm@319 161 (walk [↓ ↓ ↓ ↓ ↓ ↓]))))
rlm@257 162
rlm@271 163 (defn-memo oaks-lab->pallet-town-edge
rlm@262 164 ([] (oaks-lab->pallet-town-edge
rlm@262 165 (leave-oaks-lab)))
rlm@262 166 ([script]
rlm@262 167 (->> script
rlm@319 168 (walk [← ← ←
rlm@319 169 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ →]))))
rlm@264 170
rlm@264 171 (defn-memo pallet-edge->viridian-mart
rlm@271 172 ([] (pallet-edge->viridian-mart true
rlm@264 173 (oaks-lab->pallet-town-edge)))
rlm@271 174 ([dodge-stupid-guy? script]
rlm@271 175 (let [dodge-1 (if dodge-stupid-guy?
rlm@271 176 [→ →]
rlm@271 177 [→])
rlm@271 178 dodge-2 (if dodge-stupid-guy?
rlm@271 179 [↑ ↑ ←]
rlm@319 180 [↑ ↑])]
rlm@271 181
rlm@271 182 (->> script
rlm@264 183 ;; leave straight grass
rlm@264 184 (walk-thru-grass
rlm@264 185 [↑ ↑ ↑ ↑ ↑])
rlm@313 186
rlm@264 187 (walk [↑ ↑ ↑ ↑])
rlm@313 188
rlm@264 189 (walk-thru-grass
rlm@264 190 [← ← ↑])
rlm@313 191
rlm@264 192 (walk [↑ ↑ ↑ ↑ → → → ])
rlm@264 193
rlm@264 194 (walk-thru-grass
rlm@264 195 [→ ↑ ↑ ←])
rlm@264 196
rlm@264 197 (walk
rlm@264 198 [← ←
rlm@264 199 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
rlm@264 200 → → → → ])
rlm@264 201
rlm@271 202 ;; this part is dependent on that
rlm@266 203 ;; stupid NPC in the grass patch
rlm@264 204 (walk-thru-grass
rlm@271 205 (concat dodge-1
rlm@271 206 [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ]))
rlm@271 207
rlm@264 208 (walk
rlm@271 209 (concat
rlm@271 210 dodge-2
rlm@271 211 [← ← ←
rlm@271 212 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
rlm@271 213 ← ←
rlm@271 214 ↑ ↑ ↑ ↑
rlm@271 215 → → → → → → → → → →
rlm@271 216 ↑ ↑ ↑ ↑ ↑ ↑ ↑]))))))
rlm@264 217
rlm@266 218 (defn-memo get-oaks-parcel
rlm@266 219 ([] (get-oaks-parcel
rlm@266 220 (pallet-edge->viridian-mart)))
rlm@266 221 ([script]
rlm@266 222 (->> script
rlm@319 223 (do-nothing 50)
rlm@266 224 (end-text)
rlm@266 225 (scroll-text 3)
rlm@266 226 (do-nothing 197)
rlm@266 227 (play-moves [[:a] []])
rlm@266 228 (walk [↓ ↓ → ↓]))))
rlm@266 229
rlm@269 230 (defn-memo viridian-store->oaks-lab
rlm@269 231 ([] (viridian-store->oaks-lab
rlm@269 232 (get-oaks-parcel)))
rlm@269 233 ([script]
rlm@269 234 (->> script
rlm@269 235 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@319 236 ← ← ← ← ← ← ← ← ←
rlm@269 237 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269 238 ← ←
rlm@269 239 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269 240 ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269 241 → → → → → → → →
rlm@319 242 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@319 243 ← ← ← ← ←
rlm@269 244 ↓ ↓ ↓ ↓
rlm@319 245 ])
rlm@269 246 (walk-thru-grass
rlm@269 247 [↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@319 248 (walk [↓ ↓ ← ↓ ↓ ↓ ←
rlm@319 249 ↓ ↓ ↓ ↓ ↓ ↓
rlm@319 250 → → → ↑])
rlm@319 251
rlm@319 252 (do-nothing 1))))
rlm@269 253
rlm@269 254
rlm@269 255 (defn-memo viridian-store->oaks-lab-like-a-boss
rlm@269 256 ([] (viridian-store->oaks-lab-like-a-boss
rlm@269 257 (get-oaks-parcel)))
rlm@269 258 ([script]
rlm@269 259 (->> script
rlm@269 260 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@319 261 ← ← ← ← ← ← ← ← ←
rlm@269 262 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@269 263
rlm@269 264 (walk-thru-grass
rlm@269 265 [↓ ↓ ↓ ↓ ↓])
rlm@269 266
rlm@269 267 (walk
rlm@269 268 [↓ ↓ ← ↓
rlm@319 269 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@319 270 → → → ↓])
rlm@269 271
rlm@269 272 (walk-thru-grass
rlm@319 273 [↓ ↓ ↓])
rlm@269 274
rlm@269 275 (walk [↓ ← ← ↓ ↓ ↓ ↓ ↓ ↓])
rlm@269 276
rlm@269 277 (walk-thru-grass
rlm@319 278 [↓ ↓ ↓ ↓ ↓ ↓])
rlm@269 279
rlm@319 280 (walk [↓ ↓ ↓ ← ↓ ↓ ↓
rlm@269 281 ↓ ↓ ↓ ↓ ↓
rlm@269 282 → → → ↑]))))
rlm@270 283
rlm@270 284 (defn-memo deliver-oaks-parcel
rlm@270 285 ([] (deliver-oaks-parcel
rlm@270 286 (viridian-store->oaks-lab-like-a-boss)))
rlm@270 287 ([script]
rlm@270 288 (->> script
rlm@270 289 (walk [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
rlm@319 290 (play-moves [[] [:a]])
rlm@319 291 (scroll-text 13)
rlm@270 292 (end-text)
rlm@270 293 (do-nothing 200)
rlm@319 294 (scroll-text 2)
rlm@270 295 (end-text)
rlm@270 296 (scroll-text 2)
rlm@270 297 (end-text)
rlm@319 298 (scroll-text 8)
rlm@270 299 (end-text)
rlm@270 300 (scroll-text 9)
rlm@270 301 (end-text)
rlm@270 302 (scroll-text 7)
rlm@319 303 (end-text)
rlm@319 304 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓]))))
rlm@271 305
rlm@271 306 (defn-memo return-to-viridian-mart
rlm@271 307 ([] (return-to-viridian-mart
rlm@271 308 (deliver-oaks-parcel)))
rlm@271 309 ([script]
rlm@271 310 (->> script
rlm@271 311 oaks-lab->pallet-town-edge
rlm@274 312 (pallet-edge->viridian-mart false))))
rlm@274 313
rlm@274 314 (defn-memo walk-to-counter
rlm@274 315 ([] (walk-to-counter
rlm@274 316 (return-to-viridian-mart)))
rlm@274 317 ([script]
rlm@274 318 (->> script
rlm@319 319 (walk [↑ ↑ ←]))))
rlm@275 320
rlm@320 321
rlm@320 322
rlm@320 323 ;; useful addresses
rlm@320 324 52262 ;; --- current-cursor-offset
rlm@320 325 52278 ;; --- current screen-offset
rlm@320 326
rlm@320 327
rlm@320 328 (defn exp-item-list []
rlm@320 329 (clojure.pprint/pprint
rlm@320 330 (apply harmonic-compare
rlm@320 331 (map read-state
rlm@320 332 ["up-1" "down-1"
rlm@320 333 "up-2" "down-2"
rlm@320 334 "up-3" "down-3"
rlm@320 335 "up-4" "down-4"
rlm@320 336 "up-5" "down-5"
rlm@320 337 "up-6"]))))
rlm@321 338
rlm@322 339
rlm@323 340 ;; turns out that these addresses are the cursor position
rlm@323 341 ;; for all lists in the game (start list, pokemon list, shop
rlm@323 342 ;; lists, inventory lists, battle list, basically
rlm@323 343 ;; everything!)
rlm@322 344
rlm@323 345 (def list-cursor-offset-address 52262)
rlm@323 346 (def list-screen-offset-address 52278)
rlm@321 347
rlm@323 348 (defn list-offset
rlm@321 349 ([^SaveState state]
rlm@321 350 (let [mem (memory state)]
rlm@321 351 (+ (aget mem item-screen-offset-address)
rlm@321 352 (aget mem item-cursor-offset-address))))
rlm@321 353 ([] (item-offset @current-state)))
rlm@320 354
rlm@320 355
rlm@323 356
rlm@322 357 (defn exp-item-selection []
rlm@322 358 (clojure.pprint/pprint
rlm@322 359 (apply memory-compare
rlm@322 360 (map read-state
rlm@322 361 ["1-item"
rlm@322 362 "2-items"
rlm@322 363 "3-items"
rlm@322 364 "4-items"
rlm@322 365 ]))))
rlm@322 366
rlm@322 367 (def item-quantity-selected-address 65432)
rlm@322 368
rlm@322 369 (defn item-quantity-selected
rlm@322 370 ([^SaveState state]
rlm@322 371 (aget (memory state) item-quantity-selected-address))
rlm@322 372 ([] (item-quantity-selected @current-state)))
rlm@322 373
rlm@323 374 (defn set-cursor-relative
rlm@323 375 "Assumes the arrow keys currently control the cursor.
rlm@323 376 Moves the cursor n steps relative to its current
rlm@323 377 position."
rlm@323 378 [n script]
rlm@323 379 (let [key (if (< 0 n) ↓ ↑)]
rlm@323 380 (multiple-times
rlm@323 381 n (partial repeat-until-different
rlm@323 382 key list-offset) script)))
rlm@322 383
rlm@323 384 (defn set-cursor
rlm@323 385 "Assumes the arrow keys currently control the cursor. Sets
rlm@323 386 the cursor to the desired position. Works for any menu
rlm@323 387 that uses a cursor including the start menu, item menu,
rlm@323 388 pokemon menu, and battle menu."
rlm@323 389 [n [moves state :as script]]
rlm@323 390 (let [current-position (list-offset state)
rlm@323 391 difference (- n current-position)]
rlm@323 392 (println difference)
rlm@323 393 (set-cursor-relative difference script)))
rlm@323 394
rlm@275 395 (defn buy-item
rlm@275 396 "Assumes that the main item-screen is up, and buys
rlm@275 397 quantity of the nth item in the list, assuming that you
rlm@275 398 have enough money."
rlm@275 399 [n quantity script]
rlm@275 400 (if (= 0 quantity)
rlm@275 401 script
rlm@275 402 (let [after-initial-pause
rlm@275 403 (do-nothing 20 script)
rlm@275 404 move-to-item
rlm@275 405 (reduce (fn [script _]
rlm@275 406 (->> script
rlm@275 407 (play-moves [[:d]])
rlm@275 408 (do-nothing 3)))
rlm@275 409 after-initial-pause
rlm@275 410 (range n))
rlm@275 411 select-item
rlm@275 412 (play-moves [[:a]] move-to-item)
rlm@275 413 request-items
rlm@275 414 (reduce (fn [script _]
rlm@275 415 (->> script
rlm@275 416 (play-moves [[:u]])
rlm@275 417 (do-nothing 1)))
rlm@275 418 select-item
rlm@275 419 (range (dec quantity)))
rlm@275 420 buy-items
rlm@275 421 (->> request-items
rlm@284 422 (do-nothing 10)
rlm@275 423 (play-moves [[:a]])
rlm@275 424 (scroll-text)
rlm@275 425 (scroll-text)
rlm@284 426 (do-nothing 10)
rlm@275 427 (play-moves [[:a]])
rlm@275 428 (scroll-text))]
rlm@275 429 buy-items)))
rlm@275 430
rlm@275 431
rlm@275 432 (defn buy-items
rlm@275 433 "Given a list of [item-no quantity], buys the quantity
rlm@275 434 from the shop's list. Assumes that the item list is
rlm@275 435 already up."
rlm@275 436 [item-pairs script]
rlm@275 437 (let [item-lookup (into {0 0 1 0 2 0 3 0 4 0} item-pairs)
rlm@275 438 initial-purchase
rlm@275 439 (->> script
rlm@275 440 (buy-item 0 (item-lookup 0))
rlm@275 441 (buy-item 1 (item-lookup 1))
rlm@275 442 (buy-item 2 (item-lookup 2)))]
rlm@275 443 (cond
rlm@275 444 (and
rlm@275 445 (not= 0 (item-lookup 3))
rlm@275 446 (not= 0 (item-lookup 4)))
rlm@275 447 (->> initial-purchase
rlm@275 448 (do-nothing 20)
rlm@275 449 (play-moves [[:d]])
rlm@275 450 (do-nothing 3)
rlm@275 451 (play-moves [[:d]])
rlm@275 452 (do-nothing 3)
rlm@275 453 (play-moves [[:d]])
rlm@275 454 (do-nothing 10)
rlm@275 455 (buy-item 0 (item-lookup 3))
rlm@275 456 (do-nothing 20)
rlm@275 457 (play-moves [[:d]])
rlm@275 458 (do-nothing 3)
rlm@275 459 (play-moves [[:d]])
rlm@275 460 (do-nothing 3)
rlm@275 461 (play-moves [[:d]])
rlm@275 462 (do-nothing 10)
rlm@275 463 (buy-item 0 (item-lookup 4)))
rlm@275 464 (and (= 0 (item-lookup 3))
rlm@275 465 (not= 0 (item-lookup 4)))
rlm@275 466 (->> initial-purchase
rlm@275 467 (do-nothing 20)
rlm@275 468 (play-moves [[:d]])
rlm@275 469 (do-nothing 3)
rlm@275 470 (play-moves [[:d]])
rlm@275 471 (do-nothing 3)
rlm@275 472 (play-moves [[:d]])
rlm@275 473 (do-nothing 10)
rlm@275 474 (play-moves [[:d]])
rlm@275 475 (do-nothing 10)
rlm@275 476 (buy-item 0 (item-lookup 4)))
rlm@275 477 (and (not= 0 (item-lookup 3))
rlm@275 478 (= 0 (item-lookup 4)))
rlm@275 479 (->> initial-purchase
rlm@275 480 (do-nothing 20)
rlm@275 481 (play-moves [[:d]])
rlm@275 482 (do-nothing 3)
rlm@275 483 (play-moves [[:d]])
rlm@275 484 (do-nothing 3)
rlm@275 485 (play-moves [[:d]])
rlm@275 486 (do-nothing 10)
rlm@284 487 (buy-item 0 (item-lookup 3)))
rlm@284 488 (and (= 0 (item-lookup 3))
rlm@284 489 (= 0 (item-lookup 4)))
rlm@284 490 initial-purchase)))
rlm@275 491
rlm@275 492
rlm@275 493 (defn test-buy-items
rlm@277 494 ([] (test-buy-items
rlm@274 495 (walk-to-counter)))
rlm@274 496 ([script]
rlm@275 497 (->> [(first script) (set-money (second script)
rlm@275 498 999999)]
rlm@274 499 (play-moves
rlm@274 500 [[] [:a] []])
rlm@274 501 (scroll-text)
rlm@274 502 (do-nothing 100)
rlm@274 503 (play-moves [[:a]])
rlm@274 504 (do-nothing 100)
rlm@275 505 (buy-items
rlm@275 506 [[0 1]
rlm@275 507 [1 15]
rlm@275 508 [2 1]
rlm@275 509 [3 20]
rlm@275 510 [4 95]
rlm@275 511 ]))))
rlm@275 512
rlm@275 513 (defn-memo buy-initial-items
rlm@275 514 ([] (buy-initial-items
rlm@275 515 (walk-to-counter)))
rlm@275 516 ([script]
rlm@275 517 (->> script
rlm@275 518 (play-moves
rlm@275 519 [[] [:a] []])
rlm@274 520 (scroll-text)
rlm@274 521 (do-nothing 100)
rlm@274 522 (play-moves [[:a]])
rlm@274 523 (do-nothing 100)
rlm@275 524 (buy-items
rlm@275 525 [[0 1]
rlm@275 526 [1 1]
rlm@275 527 [2 1]
rlm@275 528 [3 1]
rlm@279 529 [4 1]])
rlm@279 530 (do-nothing 100)
rlm@279 531 (play-moves [[:b]])
rlm@279 532 (do-nothing 100)
rlm@279 533 (play-moves [[:b]])
rlm@279 534 (do-nothing 100)
rlm@284 535 (play-moves [[:b] []])
rlm@319 536 (first-difference [:b] [:b :start] AF))))
rlm@274 537
rlm@274 538
rlm@280 539 (defn-memo do-save-corruption
rlm@279 540 ([] (do-save-corruption
rlm@279 541 (buy-initial-items)))
rlm@279 542 ([script]
rlm@279 543 (->> script
rlm@319 544 (first-difference [] [:d] AF)
rlm@280 545 (play-moves [[] [] [] [:d]
rlm@280 546 [] [] [] [:d]
rlm@280 547 [] [] [] [:d]
rlm@280 548 [] [] [:a]])
rlm@280 549 scroll-text
rlm@280 550 (play-moves
rlm@280 551 ;; this section is copied from speedrun-2942 and corrupts
rlm@290 552 ;; the save so that the total number of pokemon is set to
rlm@290 553 ;; 0xFF, allowing manipulation of non-pokemon data in RAM
rlm@290 554 ;; via the pokemon interface.
rlm@280 555 [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@280 556 [] [] [] [] [] [] [] [] [] [] [] [:select] [:restart]])
rlm@280 557 (title)
rlm@319 558 (first-difference [] [:start] AF)
rlm@319 559 (first-difference [] [:a] AF)
rlm@319 560 (first-difference [:a] [:a :start] AF))))
rlm@319 561
rlm@319 562 (def menu do-nothing )
rlm@280 563
rlm@284 564 (defn-memo corrupt-item-list
rlm@284 565 ([] (corrupt-item-list
rlm@284 566 (do-save-corruption)))
rlm@284 567 ([script]
rlm@284 568 (->> script
rlm@284 569 (do-nothing 200)
rlm@284 570 (menu [↓ [:a]]) ; select "POKEMON" from
rlm@284 571 ; from main menu
rlm@284 572 (menu [↓ ↓ ↓ ↓ ↓ ↓ ; go to 6th pokemon
rlm@284 573 [:a] ↓ [:a] ; select "switch"
rlm@284 574 ↓ ↓ ↓ [:a]]) ; switch with 9th "pokemon"
rlm@284 575
rlm@284 576 (do-nothing 1))))
rlm@284 577
rlm@284 578 (defn-memo get-burn-heals
rlm@284 579 ([] (get-burn-heals
rlm@284 580 (corrupt-item-list)))
rlm@284 581 ([script]
rlm@284 582 (->> script
rlm@284 583 (menu [[:b] [:b]])
rlm@284 584 (menu [[:a]])
rlm@284 585 (do-nothing 100)
rlm@284 586 (menu [↓ [:a]])
rlm@284 587 (do-nothing 100)
rlm@284 588 (menu [[:a] ↓ [:a]])
rlm@284 589 (scroll-text)
rlm@284 590 (menu [[:b][:b]])
rlm@284 591 (menu [[:a]])
rlm@284 592
rlm@284 593 (do-nothing 50)
rlm@284 594 (buy-items [[0 1]])
rlm@284 595 (do-nothing 60)
rlm@284 596 (menu [[:a]])
rlm@284 597 (scroll-text)
rlm@284 598
rlm@284 599 (do-nothing 50)
rlm@284 600 (buy-items [[0 1]])
rlm@284 601 (do-nothing 60)
rlm@284 602 ;;(menu [[:a]])
rlm@284 603 ;;(scroll-text)
rlm@284 604
rlm@284 605 ;;(do-nothing 300)
rlm@284 606 ;;(menu [[:b] [:b]])
rlm@284 607 ;;(do-nothing 300)
rlm@284 608
rlm@284 609 (buy-items [[0 1]
rlm@284 610 [1 1]
rlm@284 611 [1 1]
rlm@284 612 [2 1]
rlm@284 613 [3 1]
rlm@284 614 [4 97]])
rlm@284 615
rlm@284 616 (do-nothing 10))))
rlm@284 617
rlm@284 618 (defn-memo corrupt-item-list-again
rlm@284 619 ([] (corrupt-item-list-again (get-burn-heals)))
rlm@284 620 ([script]
rlm@284 621 (->> script
rlm@284 622 (do-nothing 10)
rlm@284 623 (play-moves [[:b]])
rlm@284 624 (do-nothing 100)
rlm@284 625 (play-moves [[:b]])
rlm@284 626 (do-nothing 40)
rlm@284 627 (play-moves [[:b]])
rlm@319 628 (first-difference [:b] [:start :b] AF)
rlm@284 629 (menu [[:a] ↑ ↑ ↑ ↑ ↑ ; get fifth pokemon
rlm@284 630 [:a] ↓ [:a] ; and corrupt the
rlm@284 631 ↓ ↓ ↓ ↓ ↓ [:a]]) ; item list again by
rlm@284 632 ; switching it to
rlm@284 633 ))) ; tenth place.
rlm@284 634
rlm@290 635 (defn-memo viridian-store->viridian-poke-center
rlm@290 636 ([] (viridian-store->viridian-poke-center
rlm@290 637 (corrupt-item-list-again)))
rlm@290 638 ([script]
rlm@290 639 (->> script
rlm@290 640 (do-nothing 100)
rlm@290 641 (play-moves [[:b]])
rlm@290 642 (do-nothing 100)
rlm@290 643 (play-moves [[:b]])
rlm@290 644 (do-nothing 40)
rlm@290 645 ;; leave store
rlm@290 646 (walk [↓ ↓
rlm@290 647 → ↓ ↓])
rlm@290 648 (walk [← ← ← ←
rlm@290 649 ↓ ↓ ↓ ↓ ↓ ↓
rlm@290 650 ← ← ← ↑]))))
rlm@290 651
rlm@291 652 (defn-memo to-poke-center-computer
rlm@290 653 ([] (to-poke-center-computer
rlm@290 654 (viridian-store->viridian-poke-center)))
rlm@290 655 ([script]
rlm@290 656 (->> script
rlm@290 657 (walk [→ →
rlm@290 658 ↑ ↑ ↑
rlm@290 659 → → → → → → → → → ↑])
rlm@290 660 (do-nothing 1))))
rlm@291 661
rlm@291 662 (defn-memo begin-deposits
rlm@291 663 ([] (begin-deposits
rlm@291 664 (to-poke-center-computer)))
rlm@291 665 ([script]
rlm@291 666 (->> script
rlm@291 667 ;; access PC
rlm@291 668 (scroll-text 2)
rlm@291 669
rlm@291 670 ;; access item storage
rlm@291 671 (menu [[:a] [:d] [:a]])
rlm@291 672 (scroll-text 2)
rlm@291 673
rlm@291 674 ;; begin deposit
rlm@291 675 (menu [[:d] [:a]])
rlm@291 676 (do-nothing 40))))
rlm@291 677
rlm@293 678 (defn deposit-n-items
rlm@293 679 [n script]
rlm@293 680 (->> script
rlm@293 681 (do-nothing 100)
rlm@293 682 (play-moves [[:a]])
rlm@293 683 (do-nothing 80)
rlm@293 684 (multiple-times
rlm@293 685 (dec n)
rlm@293 686 (fn [script]
rlm@293 687 (->> script
rlm@293 688 (play-moves [[:u]])
rlm@293 689 (do-nothing 1))))
rlm@293 690 (play-moves [[:a]])
rlm@293 691 (scroll-text)))
rlm@296 692
rlm@296 693 (defn deposit-one-item
rlm@296 694 [script]
rlm@296 695 (->> script
rlm@296 696 (do-nothing 100)
rlm@296 697 (play-moves [[:a]])
rlm@296 698 (do-nothing 80)
rlm@296 699 (play-moves [[:a]])
rlm@296 700 (scroll-text)))
rlm@293 701
rlm@293 702 (defn-memo create-header
rlm@291 703 ([] (create-header (begin-deposits)))
rlm@291 704 ([script]
rlm@291 705 (->> script
rlm@293 706 (multiple-times 33 deposit-one-item)
rlm@291 707 (do-nothing 1))))
rlm@297 708
rlm@297 709 (defn bootstrap-init []
rlm@297 710 [(read-moves "bootstrap-init")
rlm@297 711 (read-state "bootstrap-init")])
rlm@296 712
rlm@296 713 (defn create-bootstrap-program
rlm@296 714 ([] (create-bootstrap-program
rlm@296 715 (create-header)))
rlm@296 716 ([script]
rlm@296 717 (->> script
rlm@296 718 (do-nothing 120)
rlm@296 719 (menu [↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@296 720 ;;(deposit-n-items 33)
rlm@296 721
rlm@296 722 (menu (repeat 17 ↓))
rlm@296 723
rlm@296 724
rlm@296 725
rlm@296 726 (do-nothing 1))))
rlm@296 727
rlm@297 728
rlm@302 729 (defn test-pc-item-program []
rlm@302 730 (-> (read-state "bootstrap-init")
rlm@302 731 (set-memory pc-item-list-start 50)
rlm@302 732 (set-memory-range
rlm@305 733 map-function-address-start [0x8B 0xD5])
rlm@304 734 (set-memory-range
rlm@302 735 (inc pc-item-list-start)
rlm@302 736 (flatten
rlm@304 737 [(repeat
rlm@303 738 28
rlm@302 739 [0xFF 0x01])
rlm@303 740 [;; second part of item manipulation program
rlm@303 741 0x00 ;; this starts at address 0xD56C
rlm@303 742 0x2A ;; save (HL)=(target) to A, increment HL
rlm@302 743
rlm@302 744 0x00
rlm@303 745 0x47 ;; save A to B
rlm@302 746
rlm@302 747 0x00
rlm@303 748 0x3A ;; save (target+1) to A, decrement HL
rlm@302 749
rlm@302 750 0x00
rlm@303 751 0x22 ;; A -> target, increment HL [(target+1) -> target]
rlm@302 752
rlm@303 753 0x00
rlm@303 754 0x70 ;; load B into target+1 [(target) -> target+1]
rlm@303 755
rlm@303 756 0x00
rlm@303 757 0xC3 ;; first part of absolute jump
rlm@303 758
rlm@303 759 0x0C ;; return control to pokemon kernel
rlm@302 760 0x5F]
rlm@302 761 (repeat
rlm@303 762 5
rlm@302 763 [0xFF 0x01])
rlm@302 764
rlm@303 765 [;; first part of item manipulation program
rlm@303 766 0x00
rlm@303 767 0x21 ;; load target into HL
rlm@302 768
rlm@303 769 0x94 ;; this is the target address
rlm@302 770 0xD5
rlm@302 771
rlm@303 772 0x00 ;; relative jump back to first part
rlm@303 773 0x18
rlm@302 774
rlm@303 775 0xE1 ;; of program
rlm@302 776 0x01
rlm@302 777
rlm@303 778 0xFF ;; spacer
rlm@302 779 0x01
rlm@302 780
rlm@303 781 0x04 ;; target ID (pokeball)
rlm@303 782 0x3E ;; target Quantity (lemonade)
rlm@302 783 ]]))))