Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_0.clj @ 330:ecff37d22293

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