Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_0.clj @ 313:8e63b0bb8ea3

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