Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_0.clj @ 300:bc1f62b269b5

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