Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_0.clj @ 333:61a096a53330

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