Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_0.clj @ 336:25b7bb7da3b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fixed two major bugs related to restart events which were causing desync. The entire video now syncs properly.
author Robert McIntyre <rlm@mit.edu>
date Sat, 07 Apr 2012 07:31:59 -0500
parents 57f4c57d2897
children 2dd40f6b6a1f
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@333 31 [:u] [] [:l] [] [:l] []
rlm@333 32 [:l] [] [:l] [] [:l] [:a] ;; U
rlm@333 33 [:r] [] [:r] [] [:r] []
rlm@333 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@333 273 [↓ ↓ ↓])
rlm@269 274
rlm@333 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@327 351 (+ (aget mem list-screen-offset-address)
rlm@327 352 (aget mem list-cursor-offset-address))))
rlm@327 353 ([] (list-offset @current-state)))
rlm@320 354
rlm@322 355 (defn exp-item-selection []
rlm@322 356 (clojure.pprint/pprint
rlm@322 357 (apply memory-compare
rlm@322 358 (map read-state
rlm@322 359 ["1-item"
rlm@322 360 "2-items"
rlm@322 361 "3-items"
rlm@322 362 "4-items"
rlm@322 363 ]))))
rlm@322 364
rlm@322 365 (def item-quantity-selected-address 65432)
rlm@322 366
rlm@322 367 (defn item-quantity-selected
rlm@322 368 ([^SaveState state]
rlm@329 369 (println "items:" (aget (memory state) item-quantity-selected-address))
rlm@322 370 (aget (memory state) item-quantity-selected-address))
rlm@322 371 ([] (item-quantity-selected @current-state)))
rlm@322 372
rlm@323 373 (defn set-cursor-relative
rlm@323 374 "Assumes the arrow keys currently control the cursor.
rlm@323 375 Moves the cursor n steps relative to its current
rlm@323 376 position."
rlm@323 377 [n script]
rlm@323 378 (let [key (if (< 0 n) ↓ ↑)]
rlm@323 379 (multiple-times
rlm@324 380 (Math/abs n)
rlm@325 381 (partial first-difference
rlm@325 382 [] key list-offset)
rlm@324 383 script)))
rlm@322 384
rlm@323 385 (defn set-cursor
rlm@323 386 "Assumes the arrow keys currently control the cursor. Sets
rlm@323 387 the cursor to the desired position. Works for any menu
rlm@323 388 that uses a cursor including the start menu, item menu,
rlm@323 389 pokemon menu, and battle menu."
rlm@323 390 [n [moves state :as script]]
rlm@323 391 (let [current-position (list-offset state)
rlm@323 392 difference (- n current-position)]
rlm@323 393 (println difference)
rlm@323 394 (set-cursor-relative difference script)))
rlm@329 395
rlm@329 396 (defn set-quantity
rlm@329 397 "Set the quantity of an item to buy or sell to the desired value
rlm@329 398 using the fewest possible button presses."
rlm@330 399 ([total-quantity desired-quantity [moves state :as script]]
rlm@330 400 (let [current-quantity (item-quantity-selected state)
rlm@330 401 loop-point (if (> total-quantity 99) 0xFF 99)
rlm@330 402 distance (- desired-quantity current-quantity)
rlm@330 403 loop-distance (int(* -1 (Math/signum (float distance))
rlm@330 404 (- loop-point (Math/abs distance))))
rlm@330 405 best-path (first (sort-by #(Math/abs %)
rlm@330 406 [distance loop-distance]))
rlm@330 407 direction (if (< 0 best-path) ↑ ↓)]
rlm@330 408 (println "best-path" best-path)
rlm@330 409 (reduce
rlm@330 410 (fn [script _]
rlm@330 411 (delayed-difference [] direction 5 item-quantity-selected
rlm@330 412 script))
rlm@330 413
rlm@330 414 script
rlm@330 415 (range (Math/abs best-path)))))
rlm@330 416 ([desired-quantity [moves state :as script]]
rlm@330 417 (set-quantity 99 desired-quantity script)))
rlm@275 418
rlm@331 419 (defn activate-start-menu [script]
rlm@331 420 (first-difference [:b] [:b :start] AF script))
rlm@331 421
rlm@332 422 (defn wait-until [script-fn script]
rlm@332 423 (let [wait-time
rlm@332 424 (- (dec (count (first (script-fn script))))
rlm@332 425 (count (first script)))]
rlm@332 426 (println "wait-time" wait-time)
rlm@332 427 (do-nothing wait-time script)))
rlm@332 428
rlm@332 429 (defn select-menu-entry [script]
rlm@332 430 (->> script
rlm@332 431 (wait-until (partial set-cursor-relative 1))
rlm@332 432 (play-moves [[:a] []])))
rlm@332 433
rlm@336 434 (defn restart
rlm@336 435 "Two button presses after a restart event are lost when converting to
rlm@336 436 VBM format. To compensate, step the state forward two steps."
rlm@336 437 [[moves state :as script]]
rlm@336 438 (->> [(concat moves [[:restart]])
rlm@336 439 (run-moves state [[:restart]
rlm@336 440
rlm@336 441
rlm@336 442 ;;[] []
rlm@336 443
rlm@336 444 ])]
rlm@336 445 (do-nothing 2)))
rlm@336 446
rlm@336 447 (defn restart
rlm@336 448 "The two button presses after a restart event are converted to
rlm@336 449 blanks. Due to weirdness with the VBM format. To compensate, ensure
rlm@336 450 that the two button presses after restart are both blanks."
rlm@336 451 [script]
rlm@336 452 (play-moves [[:restart] [] []] script))
rlm@336 453
rlm@336 454 (defn restart-wrong
rlm@336 455 [[moves state :as script]]
rlm@336 456 [(concat moves [[:restart] [] []])
rlm@336 457 (run-moves state [[:restart]])])
rlm@336 458
rlm@336 459 (defn do-save-corruption
rlm@329 460 ([] (do-save-corruption
rlm@275 461 (walk-to-counter)))
rlm@275 462 ([script]
rlm@275 463 (->> script
rlm@331 464 activate-start-menu
rlm@329 465 (set-cursor 4)
rlm@331 466 select-menu-entry
rlm@331 467 select-menu-entry
rlm@280 468 (play-moves
rlm@280 469 ;; this section is copied from speedrun-2942 and corrupts
rlm@290 470 ;; the save so that the total number of pokemon is set to
rlm@290 471 ;; 0xFF, allowing manipulation of non-pokemon data in RAM
rlm@290 472 ;; via the pokemon interface.
rlm@280 473 [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@336 474 [] [] [] [] [] [] [] [] [] [] [] []])
rlm@336 475 (restart)
rlm@280 476 (title)
rlm@319 477 (first-difference [] [:start] AF)
rlm@329 478 (first-difference [] [:a] AF))))
rlm@329 479
rlm@329 480 (defn gen-corrupted-checkpoint! []
rlm@329 481 (let [[cor-moves cor-save] (do-save-corruption)]
rlm@329 482 (write-moves! cor-moves "cor-checkpoint")
rlm@329 483 (write-state! cor-save "cor-checkpoint")))
rlm@329 484
rlm@329 485 (defn corrupted-checkpoint []
rlm@329 486 [(read-moves "cor-checkpoint")
rlm@329 487 (read-state "cor-checkpoint")])
rlm@319 488
rlm@319 489 (def menu do-nothing )
rlm@280 490
rlm@330 491 (defn close-menu [script]
rlm@330 492 (first-difference [] [:b] AF script))
rlm@330 493
rlm@330 494 (defn purchase-item
rlm@330 495 "Assumes that the cursor is over the desired item, and purchases
rlm@330 496 quantity of that item."
rlm@330 497 [n script]
rlm@330 498 (->> script
rlm@330 499 select-menu-entry
rlm@330 500 (set-quantity n)
rlm@330 501 (first-difference [] [:a] AF)
rlm@330 502 scroll-text
rlm@330 503 select-menu-entry
rlm@330 504 scroll-text))
rlm@330 505
rlm@336 506 (defn corrupt-item-list
rlm@329 507 "Corrupt the num-of-items variable by switching a corrupted pokemon
rlm@329 508 into out-of-bounds memory."
rlm@284 509 ([] (corrupt-item-list
rlm@336 510 ;;(corrupted-checkpoint)
rlm@336 511 (do-save-corruption)
rlm@331 512 ))
rlm@284 513 ([script]
rlm@284 514 (->> script
rlm@330 515 activate-start-menu
rlm@330 516 (set-cursor 1) ; select "POKEMON" from
rlm@330 517 select-menu-entry ; from main menu.
rlm@330 518 (set-cursor 5) ; select 6th pokemon
rlm@330 519 select-menu-entry
rlm@329 520 (set-cursor 1)
rlm@330 521 select-menu-entry
rlm@329 522 (repeat-until-different [] list-offset)
rlm@329 523 (set-cursor 9)
rlm@330 524 select-menu-entry ; switch 6th with 10th
rlm@330 525 close-menu
rlm@333 526 close-menu)))
rlm@329 527
rlm@336 528 (defn get-lots-of-money
rlm@329 529 "Sell 0xFE cancel buttons to make a tremendous amount of money."
rlm@329 530 ([] (get-lots-of-money (corrupt-item-list)))
rlm@329 531 ([script]
rlm@329 532 (->> script
rlm@330 533 (first-difference [] [:a] AF) ; talk to shopkeep
rlm@329 534 (repeat-until-different [] list-offset)
rlm@329 535 (set-cursor 1)
rlm@330 536 select-menu-entry
rlm@329 537 (repeat-until-different [] list-offset)
rlm@330 538 select-menu-entry
rlm@332 539 (set-quantity 0xFF 0xF7)
rlm@332 540 (first-difference [] [:a] AF)
rlm@332 541 select-menu-entry
rlm@333 542 close-menu)))
rlm@329 543
rlm@330 544 (defn note [str script]
rlm@330 545 (println str) script)
rlm@329 546
rlm@336 547 (defn buy-bootstrapping-items
rlm@330 548 "Buy items that will become part of the bootstrapping
rlm@330 549 program."
rlm@330 550 ([] (buy-bootstrapping-items (get-lots-of-money)))
rlm@284 551 ([script]
rlm@284 552 (->> script
rlm@330 553 close-menu
rlm@330 554 select-menu-entry
rlm@330 555 (purchase-item 1) ; buying a pokeball overflows
rlm@330 556 ; the item-counter from 0xFF to 0x00
rlm@330 557 ; repairing the item-list.
rlm@330 558 (set-cursor 1)
rlm@330 559 (purchase-item 1) ; these other items are here to
rlm@330 560 ; protect the burn heals when the
rlm@330 561 (set-cursor 2) ; item list is corrupted again.
rlm@330 562 (purchase-item 1)
rlm@284 563
rlm@330 564 (set-cursor 3)
rlm@330 565 (purchase-item 1)
rlm@284 566
rlm@330 567 (set-cursor 4) ; 95 burn-heals spells out the
rlm@330 568 (purchase-item 96) ; return address to the pokemon
rlm@330 569 ; kernel. 96 so that they can be
rlm@330 570 ; deposited without causing a shift.
rlm@284 571
rlm@330 572 close-menu ; stop talking to shopkeep
rlm@330 573 (wait-until select-menu-entry)
rlm@330 574 (play-moves [[:b]])
rlm@330 575 end-text)))
rlm@330 576
rlm@336 577 (defn corrupt-item-list-again
rlm@330 578 ([] (corrupt-item-list-again (buy-bootstrapping-items)))
rlm@284 579 ([script]
rlm@284 580 (->> script
rlm@330 581 activate-start-menu
rlm@330 582 (set-cursor-relative 0)
rlm@330 583 select-menu-entry
rlm@330 584
rlm@330 585 ;; repair list-offset for pokemon-list
rlm@330 586 (set-cursor-relative -1)
rlm@330 587
rlm@330 588 (set-cursor 4) ; switching it to
rlm@330 589 select-menu-entry ; tenth place.
rlm@330 590 (set-cursor 1)
rlm@330 591 select-menu-entry ; select "switch" on 5th
rlm@330 592
rlm@330 593 (repeat-until-different [] list-offset)
rlm@330 594 (set-cursor 9) ; goto 10th pokemon
rlm@330 595 select-menu-entry ; do switch
rlm@330 596 close-menu
rlm@331 597 close-menu)))
rlm@333 598
rlm@333 599 (defn leave-viridian-store
rlm@333 600 ([] (leave-viridian-store (corrupt-item-list-again)))
rlm@290 601 ([script]
rlm@290 602 (->> script
rlm@290 603 ;; leave store
rlm@336 604 (walk [↓ ↓ → ↓]))))
rlm@333 605
rlm@333 606 (defn force-encounter [direction script]
rlm@333 607 (delayed-improbability-search
rlm@333 608 600
rlm@333 609 #(search-string % "Wild")
rlm@333 610 (partial move direction) script))
rlm@333 611
rlm@336 612 (defn fight-wild-pokemon
rlm@333 613 ([] (fight-wild-pokemon (leave-viridian-store)))
rlm@333 614 ([script]
rlm@333 615 (->> script
rlm@333 616 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@333 617 ← ← ← ← ← ← ← ←
rlm@333 618 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@333 619 (force-encounter →))))
rlm@333 620
rlm@336 621 (defn run-from-pokemon
rlm@333 622 ([] (run-from-pokemon (fight-wild-pokemon)))
rlm@333 623 ([script]
rlm@333 624 (->> script
rlm@333 625 (scroll-text)
rlm@336 626 (play-moves [[:a]])
rlm@333 627 (wait-until select-menu-entry)
rlm@333 628 (set-cursor 1)
rlm@333 629 (first-difference [] → AF)
rlm@333 630 (scroll-text)
rlm@333 631 (scroll-text))))
rlm@290 632
rlm@336 633 29952
rlm@336 634
rlm@336 635 (defn to-poke-center-computer
rlm@290 636 ([] (to-poke-center-computer
rlm@333 637 (run-from-pokemon)))
rlm@290 638 ([script]
rlm@290 639 (->> script
rlm@336 640 (walk-thru-grass [→ → ↑])
rlm@333 641 (walk [↑ ← ← ←
rlm@333 642 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
rlm@333 643 ← ←
rlm@333 644 ↑ ↑ ↑ ↑
rlm@333 645 → → → → ↑])
rlm@333 646 (walk [→ →
rlm@290 647 ↑ ↑ ↑
rlm@334 648 → → → → → → → → →])
rlm@334 649 (first-difference [] ↑ AF))))
rlm@333 650
rlm@291 651 (defn-memo begin-deposits
rlm@291 652 ([] (begin-deposits
rlm@291 653 (to-poke-center-computer)))
rlm@291 654 ([script]
rlm@291 655 (->> script
rlm@291 656 ;; access PC
rlm@291 657 (scroll-text 2)
rlm@291 658
rlm@291 659 ;; access item storage
rlm@291 660 (menu [[:a] [:d] [:a]])
rlm@291 661 (scroll-text 2)
rlm@291 662
rlm@291 663 ;; begin deposit
rlm@291 664 (menu [[:d] [:a]])
rlm@291 665 (do-nothing 40))))
rlm@291 666
rlm@293 667 (defn deposit-n-items
rlm@293 668 [n script]
rlm@293 669 (->> script
rlm@293 670 (do-nothing 100)
rlm@293 671 (play-moves [[:a]])
rlm@293 672 (do-nothing 80)
rlm@293 673 (multiple-times
rlm@293 674 (dec n)
rlm@293 675 (fn [script]
rlm@293 676 (->> script
rlm@293 677 (play-moves [[:u]])
rlm@293 678 (do-nothing 1))))
rlm@293 679 (play-moves [[:a]])
rlm@293 680 (scroll-text)))
rlm@296 681
rlm@296 682 (defn deposit-one-item
rlm@296 683 [script]
rlm@296 684 (->> script
rlm@296 685 (do-nothing 100)
rlm@296 686 (play-moves [[:a]])
rlm@296 687 (do-nothing 80)
rlm@296 688 (play-moves [[:a]])
rlm@296 689 (scroll-text)))
rlm@293 690
rlm@293 691 (defn-memo create-header
rlm@291 692 ([] (create-header (begin-deposits)))
rlm@291 693 ([script]
rlm@291 694 (->> script
rlm@293 695 (multiple-times 33 deposit-one-item)
rlm@291 696 (do-nothing 1))))
rlm@297 697
rlm@297 698 (defn bootstrap-init []
rlm@297 699 [(read-moves "bootstrap-init")
rlm@297 700 (read-state "bootstrap-init")])
rlm@296 701
rlm@296 702 (defn create-bootstrap-program
rlm@296 703 ([] (create-bootstrap-program
rlm@296 704 (create-header)))
rlm@296 705 ([script]
rlm@296 706 (->> script
rlm@296 707 (do-nothing 120)
rlm@296 708 (menu [↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@296 709 ;;(deposit-n-items 33)
rlm@296 710
rlm@296 711 (menu (repeat 17 ↓))
rlm@296 712
rlm@296 713
rlm@296 714
rlm@296 715 (do-nothing 1))))
rlm@296 716
rlm@297 717
rlm@302 718 (defn test-pc-item-program []
rlm@302 719 (-> (read-state "bootstrap-init")
rlm@302 720 (set-memory pc-item-list-start 50)
rlm@302 721 (set-memory-range
rlm@305 722 map-function-address-start [0x8B 0xD5])
rlm@304 723 (set-memory-range
rlm@302 724 (inc pc-item-list-start)
rlm@302 725 (flatten
rlm@304 726 [(repeat
rlm@303 727 28
rlm@302 728 [0xFF 0x01])
rlm@303 729 [;; second part of item manipulation program
rlm@303 730 0x00 ;; this starts at address 0xD56C
rlm@303 731 0x2A ;; save (HL)=(target) to A, increment HL
rlm@302 732
rlm@302 733 0x00
rlm@303 734 0x47 ;; save A to B
rlm@302 735
rlm@302 736 0x00
rlm@303 737 0x3A ;; save (target+1) to A, decrement HL
rlm@302 738
rlm@302 739 0x00
rlm@303 740 0x22 ;; A -> target, increment HL [(target+1) -> target]
rlm@302 741
rlm@303 742 0x00
rlm@303 743 0x70 ;; load B into target+1 [(target) -> target+1]
rlm@303 744
rlm@303 745 0x00
rlm@303 746 0xC3 ;; first part of absolute jump
rlm@303 747
rlm@303 748 0x0C ;; return control to pokemon kernel
rlm@302 749 0x5F]
rlm@302 750 (repeat
rlm@303 751 5
rlm@302 752 [0xFF 0x01])
rlm@302 753
rlm@303 754 [;; first part of item manipulation program
rlm@303 755 0x00
rlm@333 756 0x21 ;; load target into HL
rlm@302 757
rlm@333 758 0x94 ;; this is the target address
rlm@302 759 0xD5
rlm@302 760
rlm@303 761 0x00 ;; relative jump back to first part
rlm@303 762 0x18
rlm@302 763
rlm@303 764 0xE1 ;; of program
rlm@302 765 0x01
rlm@302 766
rlm@303 767 0xFF ;; spacer
rlm@302 768 0x01
rlm@302 769
rlm@303 770 0x04 ;; target ID (pokeball)
rlm@303 771 0x3E ;; target Quantity (lemonade)
rlm@302 772 ]]))))