Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_0.clj @ 332:5c2041d1cdda

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
solving problem with rival name becomming a key item.
author Robert McIntyre <rlm@mit.edu>
date Fri, 06 Apr 2012 13:52:08 -0500
parents 6ec288064d49
children 61a096a53330
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@332 31 [:u] [] [:l] [] [:l] [] [:l] []
rlm@332 32 [:l] [] [:l] [] [:a] ;; U
rlm@332 33 [:r] [] [:r] [] [:r] [] [:r] []
rlm@332 34 [: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@332 40 ;; (defn-memo name-rival-bootstrap
rlm@332 41 ;; ([] (name-rival-bootstrap (to-rival-name)))
rlm@332 42 ;; ([script]
rlm@332 43 ;; (->> script
rlm@332 44 ;; (first-difference [] [:a] AF)
rlm@332 45 ;; (first-difference [] [:r] DE)
rlm@332 46 ;; (play-moves
rlm@332 47 ;; [[]
rlm@332 48 ;; [] [] [:r] []
rlm@332 49 ;; [:r] [] [:r] [] [:r] [] [:r] []
rlm@332 50 ;; [:r] [] [:d] [] [:d] [] [:d] [:a];; PK
rlm@332 51 ;; [] [:a] ;; PK
rlm@332 52 ;; [:u] [] [:l] [] [:l] [] [:l] []
rlm@332 53 ;; [:l] [] [:l] [:a] ;; U
rlm@332 54 ;; [:d] [] [:r] [] [:r] [] [:r] []
rlm@332 55 ;; [:r] [] [:r] [:a] ;; PK
rlm@332 56 ;; [:u] [] [:l] [] [:l] [] [:l] []
rlm@332 57 ;; [:l] [] [:l] [] [:u] [:a] ;; L
rlm@332 58 ;; [:d] [] [:r] [] [:r] [] [:r] []
rlm@332 59 ;; [:r] [] [:r] [] [:d] [:a] ;; PK
rlm@332 60 ;; [:r] [] [:d] [:a] ;; END
rlm@332 61 ;; ]))))
rlm@332 62
rlm@255 63 (defn-memo leave-house
rlm@255 64 ([] (leave-house (name-rival-bootstrap)))
rlm@255 65 ([script]
rlm@255 66 (->> script
rlm@255 67 finish-title
rlm@255 68 walk-to-stairs
rlm@255 69 walk-to-door
rlm@255 70 (walk [↓ ↓]))))
rlm@255 71
rlm@255 72 (defn-memo to-pallet-town-edge
rlm@255 73 ([] (to-pallet-town-edge (leave-house)))
rlm@255 74 ([script]
rlm@255 75 (->> script
rlm@255 76 (walk [→ → → → →
rlm@255 77 ↑ ↑ ↑ ↑ ↑ ↑]))))
rlm@255 78
rlm@257 79 (defn-memo start-pikachu-battle
rlm@257 80 ([] (start-pikachu-battle
rlm@257 81 (to-pallet-town-edge)))
rlm@257 82 ([script]
rlm@257 83 (->> script
rlm@319 84 (first-difference [:b] [:b :a] DE)
rlm@319 85 scroll-text
rlm@319 86 (do-nothing 200)
rlm@319 87 (play-moves [[:b]]))))
rlm@257 88
rlm@257 89 (defn-memo capture-pikachu
rlm@257 90 ([] (capture-pikachu (start-pikachu-battle)))
rlm@257 91 ([script]
rlm@257 92 (->> script
rlm@319 93 (scroll-text 3))))
rlm@257 94
rlm@257 95 (defn-memo go-to-lab
rlm@257 96 ([] (go-to-lab (capture-pikachu)))
rlm@257 97 ([script]
rlm@257 98 (->> script
rlm@319 99 end-text
rlm@257 100 (scroll-text 5)
rlm@319 101 end-text
rlm@319 102 ;; oak walks you to his lab; no input required.
rlm@319 103 (do-nothing 400))))
rlm@319 104
rlm@319 105 (defn-memo talk-to-oak-in-lab
rlm@319 106 ([] (talk-to-oak-in-lab (go-to-lab)))
rlm@319 107 ([script]
rlm@319 108 (->> script
rlm@319 109 (scroll-text 14)
rlm@319 110 end-text)))
rlm@319 111
rlm@319 112 (defn-memo try-to-get-eevee
rlm@319 113 ([] (try-to-get-eevee (talk-to-oak-in-lab)))
rlm@319 114 ([script]
rlm@319 115 (->> script
rlm@319 116 ;; walk to pokeball
rlm@319 117 (walk [↓ → →])
rlm@319 118 ;; and try to grab it
rlm@319 119 (play-moves
rlm@319 120 (concat [↑ ↑ [:a]]
rlm@319 121 (repeat 100 [])))
rlm@319 122 (scroll-text 10)
rlm@257 123 (end-text))))
rlm@257 124
rlm@257 125 (defn-memo obtain-pikachu
rlm@319 126 ([] (obtain-pikachu (try-to-get-eevee)))
rlm@257 127 ([script]
rlm@257 128 (->> script
rlm@319 129 (scroll-text 6)
rlm@319 130 (end-text))))
rlm@319 131
rlm@319 132
rlm@258 133 (defn-memo begin-battle-with-rival
rlm@258 134 ([] (begin-battle-with-rival
rlm@258 135 (obtain-pikachu)))
rlm@258 136 ([script]
rlm@258 137 (->> script
rlm@319 138 (walk [↓ ↓ ↓])
rlm@260 139 (scroll-text 3)
rlm@260 140 (end-text)
rlm@260 141 (scroll-text))))
rlm@260 142
rlm@319 143 (defn-memo defeat-eevee
rlm@319 144 ([] (defeat-eevee
rlm@260 145 (begin-battle-with-rival)))
rlm@260 146 ([script]
rlm@260 147 (->> script
rlm@313 148 (do-nothing 400)
rlm@260 149 (play-moves [[:a]])
rlm@260 150 (critical-hit)
rlm@319 151 (do-nothing 200)
rlm@319 152 (scroll-text 2) ;; for eevee's tail-whip
rlm@319 153 (do-nothing 10)
rlm@313 154 (play-moves [[:a]])
rlm@260 155 (critical-hit)
rlm@319 156 (do-nothing 200)
rlm@319 157 (scroll-text 2) ;; tail whip again
rlm@319 158 (do-nothing 10)
rlm@313 159 (play-moves [[:a]])
rlm@313 160 (critical-hit)
rlm@319 161 (do-nothing 200))))
rlm@260 162
rlm@260 163 (defn-memo finish-rival-text
rlm@260 164 ([] (finish-rival-text
rlm@319 165 (defeat-eevee)))
rlm@260 166 ([script]
rlm@260 167 (->> script
rlm@319 168 (scroll-text 12)
rlm@260 169 (end-text))))
rlm@260 170
rlm@262 171 (defn-memo pikachu-comes-out
rlm@262 172 ([] (pikachu-comes-out
rlm@262 173 (finish-rival-text)))
rlm@262 174 ([script]
rlm@262 175 (->> script
rlm@319 176 (scroll-text 8)
rlm@262 177 (end-text))))
rlm@260 178
rlm@262 179 (defn-memo leave-oaks-lab
rlm@262 180 ([] (leave-oaks-lab
rlm@262 181 (pikachu-comes-out)))
rlm@262 182 ([script]
rlm@262 183 (->> script
rlm@319 184 (walk [↓ ↓ ↓ ↓ ↓ ↓]))))
rlm@257 185
rlm@271 186 (defn-memo oaks-lab->pallet-town-edge
rlm@262 187 ([] (oaks-lab->pallet-town-edge
rlm@262 188 (leave-oaks-lab)))
rlm@262 189 ([script]
rlm@262 190 (->> script
rlm@319 191 (walk [← ← ←
rlm@319 192 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ →]))))
rlm@264 193
rlm@264 194 (defn-memo pallet-edge->viridian-mart
rlm@271 195 ([] (pallet-edge->viridian-mart true
rlm@264 196 (oaks-lab->pallet-town-edge)))
rlm@271 197 ([dodge-stupid-guy? script]
rlm@271 198 (let [dodge-1 (if dodge-stupid-guy?
rlm@271 199 [→ →]
rlm@271 200 [→])
rlm@271 201 dodge-2 (if dodge-stupid-guy?
rlm@271 202 [↑ ↑ ←]
rlm@319 203 [↑ ↑])]
rlm@271 204
rlm@271 205 (->> script
rlm@264 206 ;; leave straight grass
rlm@264 207 (walk-thru-grass
rlm@264 208 [↑ ↑ ↑ ↑ ↑])
rlm@313 209
rlm@264 210 (walk [↑ ↑ ↑ ↑])
rlm@313 211
rlm@264 212 (walk-thru-grass
rlm@264 213 [← ← ↑])
rlm@313 214
rlm@264 215 (walk [↑ ↑ ↑ ↑ → → → ])
rlm@264 216
rlm@264 217 (walk-thru-grass
rlm@264 218 [→ ↑ ↑ ←])
rlm@264 219
rlm@264 220 (walk
rlm@264 221 [← ←
rlm@264 222 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
rlm@264 223 → → → → ])
rlm@264 224
rlm@271 225 ;; this part is dependent on that
rlm@266 226 ;; stupid NPC in the grass patch
rlm@264 227 (walk-thru-grass
rlm@271 228 (concat dodge-1
rlm@271 229 [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ]))
rlm@271 230
rlm@264 231 (walk
rlm@271 232 (concat
rlm@271 233 dodge-2
rlm@271 234 [← ← ←
rlm@271 235 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
rlm@271 236 ← ←
rlm@271 237 ↑ ↑ ↑ ↑
rlm@271 238 → → → → → → → → → →
rlm@271 239 ↑ ↑ ↑ ↑ ↑ ↑ ↑]))))))
rlm@264 240
rlm@266 241 (defn-memo get-oaks-parcel
rlm@266 242 ([] (get-oaks-parcel
rlm@266 243 (pallet-edge->viridian-mart)))
rlm@266 244 ([script]
rlm@266 245 (->> script
rlm@319 246 (do-nothing 50)
rlm@266 247 (end-text)
rlm@266 248 (scroll-text 3)
rlm@266 249 (do-nothing 197)
rlm@266 250 (play-moves [[:a] []])
rlm@266 251 (walk [↓ ↓ → ↓]))))
rlm@266 252
rlm@269 253 (defn-memo viridian-store->oaks-lab
rlm@269 254 ([] (viridian-store->oaks-lab
rlm@269 255 (get-oaks-parcel)))
rlm@269 256 ([script]
rlm@269 257 (->> script
rlm@269 258 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@319 259 ← ← ← ← ← ← ← ← ←
rlm@269 260 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269 261 ← ←
rlm@269 262 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269 263 ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269 264 → → → → → → → →
rlm@319 265 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@319 266 ← ← ← ← ←
rlm@269 267 ↓ ↓ ↓ ↓
rlm@319 268 ])
rlm@269 269 (walk-thru-grass
rlm@269 270 [↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@319 271 (walk [↓ ↓ ← ↓ ↓ ↓ ←
rlm@319 272 ↓ ↓ ↓ ↓ ↓ ↓
rlm@319 273 → → → ↑])
rlm@319 274
rlm@319 275 (do-nothing 1))))
rlm@269 276
rlm@269 277
rlm@269 278 (defn-memo viridian-store->oaks-lab-like-a-boss
rlm@269 279 ([] (viridian-store->oaks-lab-like-a-boss
rlm@269 280 (get-oaks-parcel)))
rlm@269 281 ([script]
rlm@269 282 (->> script
rlm@269 283 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@319 284 ← ← ← ← ← ← ← ← ←
rlm@269 285 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@269 286
rlm@269 287 (walk-thru-grass
rlm@269 288 [↓ ↓ ↓ ↓ ↓])
rlm@269 289
rlm@269 290 (walk
rlm@269 291 [↓ ↓ ← ↓
rlm@319 292 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@319 293 → → → ↓])
rlm@269 294
rlm@269 295 (walk-thru-grass
rlm@332 296 [↓ ↓ ↓ ↓])
rlm@269 297
rlm@332 298 (walk [← ← ↓ ↓ ↓ ↓ ↓ ↓])
rlm@269 299
rlm@269 300 (walk-thru-grass
rlm@319 301 [↓ ↓ ↓ ↓ ↓ ↓])
rlm@269 302
rlm@319 303 (walk [↓ ↓ ↓ ← ↓ ↓ ↓
rlm@269 304 ↓ ↓ ↓ ↓ ↓
rlm@269 305 → → → ↑]))))
rlm@270 306
rlm@270 307 (defn-memo deliver-oaks-parcel
rlm@270 308 ([] (deliver-oaks-parcel
rlm@270 309 (viridian-store->oaks-lab-like-a-boss)))
rlm@270 310 ([script]
rlm@270 311 (->> script
rlm@270 312 (walk [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
rlm@319 313 (play-moves [[] [:a]])
rlm@319 314 (scroll-text 13)
rlm@270 315 (end-text)
rlm@270 316 (do-nothing 200)
rlm@319 317 (scroll-text 2)
rlm@270 318 (end-text)
rlm@270 319 (scroll-text 2)
rlm@270 320 (end-text)
rlm@319 321 (scroll-text 8)
rlm@270 322 (end-text)
rlm@270 323 (scroll-text 9)
rlm@270 324 (end-text)
rlm@270 325 (scroll-text 7)
rlm@319 326 (end-text)
rlm@319 327 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓]))))
rlm@271 328
rlm@271 329 (defn-memo return-to-viridian-mart
rlm@271 330 ([] (return-to-viridian-mart
rlm@271 331 (deliver-oaks-parcel)))
rlm@271 332 ([script]
rlm@271 333 (->> script
rlm@271 334 oaks-lab->pallet-town-edge
rlm@274 335 (pallet-edge->viridian-mart false))))
rlm@274 336
rlm@274 337 (defn-memo walk-to-counter
rlm@274 338 ([] (walk-to-counter
rlm@274 339 (return-to-viridian-mart)))
rlm@274 340 ([script]
rlm@274 341 (->> script
rlm@319 342 (walk [↑ ↑ ←]))))
rlm@275 343
rlm@320 344
rlm@320 345
rlm@320 346 ;; useful addresses
rlm@320 347 52262 ;; --- current-cursor-offset
rlm@320 348 52278 ;; --- current screen-offset
rlm@320 349
rlm@320 350
rlm@320 351 (defn exp-item-list []
rlm@320 352 (clojure.pprint/pprint
rlm@320 353 (apply harmonic-compare
rlm@320 354 (map read-state
rlm@320 355 ["up-1" "down-1"
rlm@320 356 "up-2" "down-2"
rlm@320 357 "up-3" "down-3"
rlm@320 358 "up-4" "down-4"
rlm@320 359 "up-5" "down-5"
rlm@320 360 "up-6"]))))
rlm@321 361
rlm@322 362
rlm@323 363 ;; turns out that these addresses are the cursor position
rlm@323 364 ;; for all lists in the game (start list, pokemon list, shop
rlm@323 365 ;; lists, inventory lists, battle list, basically
rlm@323 366 ;; everything!)
rlm@322 367
rlm@323 368 (def list-cursor-offset-address 52262)
rlm@323 369 (def list-screen-offset-address 52278)
rlm@321 370
rlm@323 371 (defn list-offset
rlm@321 372 ([^SaveState state]
rlm@321 373 (let [mem (memory state)]
rlm@327 374 (+ (aget mem list-screen-offset-address)
rlm@327 375 (aget mem list-cursor-offset-address))))
rlm@327 376 ([] (list-offset @current-state)))
rlm@320 377
rlm@322 378 (defn exp-item-selection []
rlm@322 379 (clojure.pprint/pprint
rlm@322 380 (apply memory-compare
rlm@322 381 (map read-state
rlm@322 382 ["1-item"
rlm@322 383 "2-items"
rlm@322 384 "3-items"
rlm@322 385 "4-items"
rlm@322 386 ]))))
rlm@322 387
rlm@322 388 (def item-quantity-selected-address 65432)
rlm@322 389
rlm@322 390 (defn item-quantity-selected
rlm@322 391 ([^SaveState state]
rlm@329 392 (println "items:" (aget (memory state) item-quantity-selected-address))
rlm@322 393 (aget (memory state) item-quantity-selected-address))
rlm@322 394 ([] (item-quantity-selected @current-state)))
rlm@322 395
rlm@323 396 (defn set-cursor-relative
rlm@323 397 "Assumes the arrow keys currently control the cursor.
rlm@323 398 Moves the cursor n steps relative to its current
rlm@323 399 position."
rlm@323 400 [n script]
rlm@323 401 (let [key (if (< 0 n) ↓ ↑)]
rlm@323 402 (multiple-times
rlm@324 403 (Math/abs n)
rlm@325 404 (partial first-difference
rlm@325 405 [] key list-offset)
rlm@324 406 script)))
rlm@322 407
rlm@323 408 (defn set-cursor
rlm@323 409 "Assumes the arrow keys currently control the cursor. Sets
rlm@323 410 the cursor to the desired position. Works for any menu
rlm@323 411 that uses a cursor including the start menu, item menu,
rlm@323 412 pokemon menu, and battle menu."
rlm@323 413 [n [moves state :as script]]
rlm@323 414 (let [current-position (list-offset state)
rlm@323 415 difference (- n current-position)]
rlm@323 416 (println difference)
rlm@323 417 (set-cursor-relative difference script)))
rlm@329 418
rlm@329 419 (defn set-quantity
rlm@329 420 "Set the quantity of an item to buy or sell to the desired value
rlm@329 421 using the fewest possible button presses."
rlm@330 422 ([total-quantity desired-quantity [moves state :as script]]
rlm@330 423 (let [current-quantity (item-quantity-selected state)
rlm@330 424 loop-point (if (> total-quantity 99) 0xFF 99)
rlm@330 425 distance (- desired-quantity current-quantity)
rlm@330 426 loop-distance (int(* -1 (Math/signum (float distance))
rlm@330 427 (- loop-point (Math/abs distance))))
rlm@330 428 best-path (first (sort-by #(Math/abs %)
rlm@330 429 [distance loop-distance]))
rlm@330 430 direction (if (< 0 best-path) ↑ ↓)]
rlm@330 431 (println "best-path" best-path)
rlm@330 432 (reduce
rlm@330 433 (fn [script _]
rlm@330 434 (delayed-difference [] direction 5 item-quantity-selected
rlm@330 435 script))
rlm@330 436
rlm@330 437 script
rlm@330 438 (range (Math/abs best-path)))))
rlm@330 439 ([desired-quantity [moves state :as script]]
rlm@330 440 (set-quantity 99 desired-quantity script)))
rlm@275 441
rlm@331 442 (defn activate-start-menu [script]
rlm@331 443 (first-difference [:b] [:b :start] AF script))
rlm@331 444
rlm@332 445 (defn wait-until [script-fn script]
rlm@332 446 (let [wait-time
rlm@332 447 (- (dec (count (first (script-fn script))))
rlm@332 448 (count (first script)))]
rlm@332 449 (println "wait-time" wait-time)
rlm@332 450 (do-nothing wait-time script)))
rlm@332 451
rlm@332 452 (defn select-menu-entry [script]
rlm@332 453 (->> script
rlm@332 454 (wait-until (partial set-cursor-relative 1))
rlm@332 455 (play-moves [[:a] []])))
rlm@332 456
rlm@329 457 (defn-memo do-save-corruption
rlm@329 458 ([] (do-save-corruption
rlm@275 459 (walk-to-counter)))
rlm@275 460 ([script]
rlm@275 461 (->> script
rlm@331 462 activate-start-menu
rlm@329 463 (set-cursor 4)
rlm@331 464 select-menu-entry
rlm@331 465 select-menu-entry
rlm@280 466 (play-moves
rlm@280 467 ;; this section is copied from speedrun-2942 and corrupts
rlm@290 468 ;; the save so that the total number of pokemon is set to
rlm@290 469 ;; 0xFF, allowing manipulation of non-pokemon data in RAM
rlm@290 470 ;; via the pokemon interface.
rlm@280 471 [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@280 472 [] [] [] [] [] [] [] [] [] [] [] [:select] [:restart]])
rlm@280 473 (title)
rlm@319 474 (first-difference [] [:start] AF)
rlm@329 475 (first-difference [] [:a] AF))))
rlm@329 476
rlm@329 477 (defn gen-corrupted-checkpoint! []
rlm@329 478 (let [[cor-moves cor-save] (do-save-corruption)]
rlm@329 479 (write-moves! cor-moves "cor-checkpoint")
rlm@329 480 (write-state! cor-save "cor-checkpoint")))
rlm@329 481
rlm@329 482 (defn corrupted-checkpoint []
rlm@329 483 [(read-moves "cor-checkpoint")
rlm@329 484 (read-state "cor-checkpoint")])
rlm@319 485
rlm@319 486 (def menu do-nothing )
rlm@280 487
rlm@330 488 (defn close-menu [script]
rlm@330 489 (first-difference [] [:b] AF script))
rlm@330 490
rlm@332 491
rlm@330 492
rlm@330 493 ;; (defn select-menu-entry* [script]
rlm@330 494 ;; (let [wait-time
rlm@330 495 ;; (- (dec (count (first (set-cursor-relative 1 script))))
rlm@330 496 ;; (count (first script)))]
rlm@330 497 ;; (println "wait-time" wait-time)
rlm@330 498 ;; (play-moves (concat (repeat wait-time []) [[:a] []]) script)))
rlm@330 499
rlm@330 500
rlm@330 501 (defn purchase-item
rlm@330 502 "Assumes that the cursor is over the desired item, and purchases
rlm@330 503 quantity of that item."
rlm@330 504 [n script]
rlm@330 505 (->> script
rlm@330 506 select-menu-entry
rlm@330 507 (set-quantity n)
rlm@330 508 (first-difference [] [:a] AF)
rlm@330 509 scroll-text
rlm@330 510 select-menu-entry
rlm@330 511 scroll-text))
rlm@330 512
rlm@284 513 (defn-memo corrupt-item-list
rlm@329 514 "Corrupt the num-of-items variable by switching a corrupted pokemon
rlm@329 515 into out-of-bounds memory."
rlm@284 516 ([] (corrupt-item-list
rlm@331 517 ;;(corrupted-checkpoint)
rlm@331 518 (do-save-corruption)
rlm@331 519 ))
rlm@284 520 ([script]
rlm@284 521 (->> script
rlm@330 522 activate-start-menu
rlm@330 523 (set-cursor 1) ; select "POKEMON" from
rlm@330 524 select-menu-entry ; from main menu.
rlm@330 525 (set-cursor 5) ; select 6th pokemon
rlm@330 526 select-menu-entry
rlm@329 527 (set-cursor 1)
rlm@330 528 select-menu-entry
rlm@329 529 (repeat-until-different [] list-offset)
rlm@329 530 (set-cursor 9)
rlm@330 531 select-menu-entry ; switch 6th with 10th
rlm@330 532 close-menu
rlm@332 533 close-menu )))
rlm@329 534
rlm@330 535 (defn-memo get-lots-of-money
rlm@329 536 "Sell 0xFE cancel buttons to make a tremendous amount of money."
rlm@329 537 ([] (get-lots-of-money (corrupt-item-list)))
rlm@329 538 ([script]
rlm@329 539 (->> script
rlm@330 540 (first-difference [] [:a] AF) ; talk to shopkeep
rlm@329 541 (repeat-until-different [] list-offset)
rlm@329 542 (set-cursor 1)
rlm@330 543 select-menu-entry
rlm@329 544 (repeat-until-different [] list-offset)
rlm@330 545 select-menu-entry
rlm@332 546 (set-quantity 0xFF 0xF7)
rlm@332 547 (first-difference [] [:a] AF)
rlm@332 548 select-menu-entry
rlm@332 549 close-menu
rlm@332 550 )))
rlm@332 551
rlm@329 552
rlm@330 553 (defn note [str script]
rlm@330 554 (println str) script)
rlm@329 555
rlm@330 556 (defn-memo buy-bootstrapping-items
rlm@330 557 "Buy items that will become part of the bootstrapping
rlm@330 558 program."
rlm@330 559 ([] (buy-bootstrapping-items (get-lots-of-money)))
rlm@284 560 ([script]
rlm@284 561 (->> script
rlm@330 562 close-menu
rlm@330 563 select-menu-entry
rlm@330 564 (purchase-item 1) ; buying a pokeball overflows
rlm@330 565 ; the item-counter from 0xFF to 0x00
rlm@330 566 ; repairing the item-list.
rlm@330 567 (set-cursor 1)
rlm@330 568 (purchase-item 1) ; these other items are here to
rlm@330 569 ; protect the burn heals when the
rlm@330 570 (set-cursor 2) ; item list is corrupted again.
rlm@330 571 (purchase-item 1)
rlm@284 572
rlm@330 573 (set-cursor 3)
rlm@330 574 (purchase-item 1)
rlm@284 575
rlm@330 576 (set-cursor 4) ; 95 burn-heals spells out the
rlm@330 577 (purchase-item 96) ; return address to the pokemon
rlm@330 578 ; kernel. 96 so that they can be
rlm@330 579 ; deposited without causing a shift.
rlm@284 580
rlm@330 581 close-menu ; stop talking to shopkeep
rlm@330 582 (wait-until select-menu-entry)
rlm@330 583 (play-moves [[:b]])
rlm@330 584 end-text)))
rlm@330 585
rlm@331 586 (defn-memo corrupt-item-list-again
rlm@330 587 ([] (corrupt-item-list-again (buy-bootstrapping-items)))
rlm@284 588 ([script]
rlm@284 589 (->> script
rlm@330 590 activate-start-menu
rlm@330 591 (set-cursor-relative 0)
rlm@330 592 select-menu-entry
rlm@330 593
rlm@330 594 ;; repair list-offset for pokemon-list
rlm@330 595 (set-cursor-relative -1)
rlm@330 596
rlm@330 597 (set-cursor 4) ; switching it to
rlm@330 598 select-menu-entry ; tenth place.
rlm@330 599 (set-cursor 1)
rlm@330 600 select-menu-entry ; select "switch" on 5th
rlm@330 601
rlm@330 602 (repeat-until-different [] list-offset)
rlm@330 603 (set-cursor 9) ; goto 10th pokemon
rlm@330 604 select-menu-entry ; do switch
rlm@330 605 close-menu
rlm@331 606 close-menu)))
rlm@284 607
rlm@290 608 (defn-memo viridian-store->viridian-poke-center
rlm@290 609 ([] (viridian-store->viridian-poke-center
rlm@290 610 (corrupt-item-list-again)))
rlm@290 611 ([script]
rlm@290 612 (->> script
rlm@290 613 ;; leave store
rlm@290 614 (walk [↓ ↓
rlm@290 615 → ↓ ↓])
rlm@331 616 (walk [← ← ←
rlm@331 617 ↓ ↓ ↓ ↓ ↓
rlm@290 618 ← ← ← ↑]))))
rlm@290 619
rlm@291 620 (defn-memo to-poke-center-computer
rlm@290 621 ([] (to-poke-center-computer
rlm@290 622 (viridian-store->viridian-poke-center)))
rlm@290 623 ([script]
rlm@290 624 (->> script
rlm@290 625 (walk [→ →
rlm@290 626 ↑ ↑ ↑
rlm@331 627 → → → → → → → → →])
rlm@290 628 (do-nothing 1))))
rlm@291 629
rlm@291 630 (defn-memo begin-deposits
rlm@291 631 ([] (begin-deposits
rlm@291 632 (to-poke-center-computer)))
rlm@291 633 ([script]
rlm@291 634 (->> script
rlm@291 635 ;; access PC
rlm@291 636 (scroll-text 2)
rlm@291 637
rlm@291 638 ;; access item storage
rlm@291 639 (menu [[:a] [:d] [:a]])
rlm@291 640 (scroll-text 2)
rlm@291 641
rlm@291 642 ;; begin deposit
rlm@291 643 (menu [[:d] [:a]])
rlm@291 644 (do-nothing 40))))
rlm@291 645
rlm@293 646 (defn deposit-n-items
rlm@293 647 [n script]
rlm@293 648 (->> script
rlm@293 649 (do-nothing 100)
rlm@293 650 (play-moves [[:a]])
rlm@293 651 (do-nothing 80)
rlm@293 652 (multiple-times
rlm@293 653 (dec n)
rlm@293 654 (fn [script]
rlm@293 655 (->> script
rlm@293 656 (play-moves [[:u]])
rlm@293 657 (do-nothing 1))))
rlm@293 658 (play-moves [[:a]])
rlm@293 659 (scroll-text)))
rlm@296 660
rlm@296 661 (defn deposit-one-item
rlm@296 662 [script]
rlm@296 663 (->> script
rlm@296 664 (do-nothing 100)
rlm@296 665 (play-moves [[:a]])
rlm@296 666 (do-nothing 80)
rlm@296 667 (play-moves [[:a]])
rlm@296 668 (scroll-text)))
rlm@293 669
rlm@293 670 (defn-memo create-header
rlm@291 671 ([] (create-header (begin-deposits)))
rlm@291 672 ([script]
rlm@291 673 (->> script
rlm@293 674 (multiple-times 33 deposit-one-item)
rlm@291 675 (do-nothing 1))))
rlm@297 676
rlm@297 677 (defn bootstrap-init []
rlm@297 678 [(read-moves "bootstrap-init")
rlm@297 679 (read-state "bootstrap-init")])
rlm@296 680
rlm@296 681 (defn create-bootstrap-program
rlm@296 682 ([] (create-bootstrap-program
rlm@296 683 (create-header)))
rlm@296 684 ([script]
rlm@296 685 (->> script
rlm@296 686 (do-nothing 120)
rlm@296 687 (menu [↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@296 688 ;;(deposit-n-items 33)
rlm@296 689
rlm@296 690 (menu (repeat 17 ↓))
rlm@296 691
rlm@296 692
rlm@296 693
rlm@296 694 (do-nothing 1))))
rlm@296 695
rlm@297 696
rlm@302 697 (defn test-pc-item-program []
rlm@302 698 (-> (read-state "bootstrap-init")
rlm@302 699 (set-memory pc-item-list-start 50)
rlm@302 700 (set-memory-range
rlm@305 701 map-function-address-start [0x8B 0xD5])
rlm@304 702 (set-memory-range
rlm@302 703 (inc pc-item-list-start)
rlm@302 704 (flatten
rlm@304 705 [(repeat
rlm@303 706 28
rlm@302 707 [0xFF 0x01])
rlm@303 708 [;; second part of item manipulation program
rlm@303 709 0x00 ;; this starts at address 0xD56C
rlm@303 710 0x2A ;; save (HL)=(target) to A, increment HL
rlm@302 711
rlm@302 712 0x00
rlm@303 713 0x47 ;; save A to B
rlm@302 714
rlm@302 715 0x00
rlm@303 716 0x3A ;; save (target+1) to A, decrement HL
rlm@302 717
rlm@302 718 0x00
rlm@303 719 0x22 ;; A -> target, increment HL [(target+1) -> target]
rlm@302 720
rlm@303 721 0x00
rlm@303 722 0x70 ;; load B into target+1 [(target) -> target+1]
rlm@303 723
rlm@303 724 0x00
rlm@303 725 0xC3 ;; first part of absolute jump
rlm@303 726
rlm@303 727 0x0C ;; return control to pokemon kernel
rlm@302 728 0x5F]
rlm@302 729 (repeat
rlm@303 730 5
rlm@302 731 [0xFF 0x01])
rlm@302 732
rlm@303 733 [;; first part of item manipulation program
rlm@303 734 0x00
rlm@332 735 0x21 ;; load target + 1 into HL
rlm@302 736
rlm@332 737 0x95 ;; this is the target address + 1
rlm@302 738 0xD5
rlm@302 739
rlm@303 740 0x00 ;; relative jump back to first part
rlm@303 741 0x18
rlm@302 742
rlm@303 743 0xE1 ;; of program
rlm@302 744 0x01
rlm@302 745
rlm@303 746 0xFF ;; spacer
rlm@302 747 0x01
rlm@302 748
rlm@303 749 0x04 ;; target ID (pokeball)
rlm@303 750 0x3E ;; target Quantity (lemonade)
rlm@302 751 ]]))))