Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_1.clj @ 594:ea448eecb615

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
improved route from celadon dept. store to celadon pokemon center.
author Robert McIntyre <rlm@mit.edu>
date Sat, 01 Sep 2012 12:52:46 -0500
parents daa3497bbe12
children 96ee9d72aeb9
rev   line source
rlm@345 1 (ns com.aurellem.run.bootstrap-1
rlm@377 2 (:use (com.aurellem.gb saves gb-driver util constants
rlm@414 3 items vbm characters money
rlm@414 4 rlm-assembly))
rlm@345 5 (:use (com.aurellem.run util title save-corruption bootstrap-0))
rlm@345 6 (:use (com.aurellem.exp item-bridge))
rlm@345 7 (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@345 8
rlm@415 9 (def hex #(printf "0x%02X\n" %))
rlm@345 10
rlm@367 11 (defn print-desired-item-layout []
rlm@345 12 (clojure.pprint/pprint
rlm@345 13 (raw-inventory->inventory (pc-item-writer-program))))
rlm@345 14
rlm@345 15 (defn pc-item-writer-state []
rlm@345 16 (-> (read-state "bootstrap-init")
rlm@345 17 (set-memory pc-item-list-start 50)
rlm@345 18 (set-memory-range
rlm@345 19 map-function-address-start
rlm@345 20 [0x8B 0xD5])
rlm@345 21 (set-memory-range
rlm@345 22 (inc pc-item-list-start)
rlm@345 23 (pc-item-writer-program))))
rlm@345 24
rlm@345 25 (defn test-pc-item-writer []
rlm@345 26 (let [orig (read-state "pc-item-writer")]
rlm@345 27 (-> orig
rlm@345 28 (print-listing 0xD162 (+ 0xD162 20))
rlm@345 29 (run-moves (reduce concat
rlm@345 30 (repeat 10 [[:a :b :start :select] []])))
rlm@345 31 ((fn [_] (println "===========") _))
rlm@345 32 (print-listing 0xD162 (+ 0xD162 20)))))
rlm@345 33
rlm@345 34 (defn close-all-menus [[moves state :as script]]
rlm@345 35 (loop [s script]
rlm@345 36 (let [depth (current-depth (second (do-nothing 50 s)))]
rlm@345 37 (println "depth" depth)
rlm@345 38 (if (= depth 1)
rlm@345 39 s
rlm@345 40 (recur (close-menu s))))))
rlm@345 41
rlm@345 42 (defn-memo name-rival
rlm@345 43 ([] (name-rival (to-rival-name)))
rlm@345 44 ([script]
rlm@345 45 (->> script
rlm@345 46 (first-difference [] [:a] AF)
rlm@345 47 (first-difference [] [:r] DE)
rlm@345 48 (play-moves
rlm@345 49 [[]
rlm@345 50 [] [] [:r] [] [:d] [:a] ;; L
rlm@345 51 [:r] [] [:r] [] [:r] [] [:r] []
rlm@345 52 [:r] [] [:d] [] [:d] [:a] ;; [PK]
rlm@345 53 [:d] [] [:r] [:a]
rlm@345 54 ]))))
rlm@345 55
rlm@345 56 (defn-memo to-room-pc
rlm@345 57 ([] (to-room-pc (name-rival)))
rlm@345 58 ([script]
rlm@345 59 (->> script
rlm@345 60 finish-title
rlm@345 61 (walk [← ← ↑ ← ↑ ↑ ↑]))))
rlm@345 62
rlm@369 63 ;; (defn wait-for-quantity
rlm@369 64 ;; [[moves state :as script]]
rlm@369 65 ;; (if (not= (item-quantity-selected state) 1)
rlm@369 66 ;; (repeat-until-different [] item-quantity-selected script)
rlm@369 67 ;; script))
rlm@353 68
rlm@368 69 ;; TODO use this:
rlm@368 70 ;;(wait-until (partial set-cursor-relative 1))
rlm@368 71
rlm@369 72 ;; (defn wait-for-cursor
rlm@369 73 ;; [[moves state :as script]]
rlm@369 74 ;; (if (not= (list-offset state) 0)
rlm@369 75 ;; (repeat-until-different [] list-offset script)
rlm@369 76 ;; script))
rlm@353 77
rlm@345 78 (defn deposit-held-item [n quantity [moves state :as script]]
rlm@345 79 (let [total-quantity (second (nth-item state n))]
rlm@345 80 (println "total-quantity" total-quantity)
rlm@345 81 (->> script
rlm@345 82 (set-cursor n)
rlm@345 83 (select-menu-entry 1)
rlm@369 84 ;;(wait-for-quantity)
rlm@345 85 (set-quantity total-quantity quantity)
rlm@345 86 (delayed-difference [] [:a] 100 #(search-string % "stored"))
rlm@345 87 (scroll-text))))
rlm@345 88
rlm@353 89 (defn sell-held-item [n quantity [moves state :as script]]
rlm@353 90 (let [total-quantity (second (nth-item state n))]
rlm@353 91 (->> script
rlm@369 92 ;;(wait-for-cursor) ;; when selling, the cursor always
rlm@353 93 (set-cursor n) ;; returns to the top of the list.
rlm@353 94 (select-menu-entry 1)
rlm@369 95 ;;(wait-for-quantity)
rlm@353 96 (set-quantity total-quantity quantity)
rlm@353 97 (delayed-difference [] [:a] 100 current-depth)
rlm@353 98 (play-moves (repeat 20 [:b]))
rlm@353 99 (delayed-difference [] [:a] 100 #(search-string % "What"))
rlm@353 100 )))
rlm@353 101
rlm@345 102 (defn widthdraw-pc-item [n quantity [moves state :as script]]
rlm@345 103 (let [total-quantity (second (nth-pc-item state n))]
rlm@345 104 (->> script
rlm@345 105 (set-cursor n)
rlm@345 106 (select-menu-entry 1)
rlm@369 107 ;;(wait-for-quantity)
rlm@345 108 (set-quantity total-quantity quantity)
rlm@345 109 (delayed-difference [] [:a] 100 #(search-string % "Withdrew"))
rlm@345 110 (scroll-text))))
rlm@345 111
rlm@345 112 (defn toss-held-item [n quantity [moves state :as script]]
rlm@353 113 (let [total-quantity (second (nth-item state n))]
rlm@345 114 (->> script
rlm@345 115 (set-cursor n)
rlm@345 116 (select-menu-entry 1)
rlm@345 117 (set-cursor-relative 1)
rlm@345 118 (select-menu-entry -1)
rlm@369 119 ;;(wait-for-quantity)
rlm@345 120 (set-quantity total-quantity quantity)
rlm@345 121 (play-moves [[:a]])
rlm@345 122 (scroll-text)
rlm@345 123 (delayed-difference [] [:a] 100 #(search-string % "Threw"))
rlm@345 124 (scroll-text)
rlm@345 125 )))
rlm@345 126
rlm@354 127 (defn buy-item [n quantity [moves state :as script]]
rlm@354 128 (->> script
rlm@354 129 (set-cursor n)
rlm@354 130 (purchase-item quantity)))
rlm@354 131
rlm@369 132 (defn switch-items [item-fn idx-1 idx-2 script]
rlm@369 133 (->> script
rlm@369 134 (wait-until select-menu-entry)
rlm@369 135 (set-cursor idx-1)
rlm@369 136 (wait-until select-menu-entry)
rlm@369 137 (play-moves [[][:select][]])
rlm@369 138 (set-cursor idx-2)
rlm@369 139 (delayed-difference [] [:select] 100
rlm@369 140 #(item-fn % (list-offset %)))))
rlm@369 141
rlm@369 142 (def switch-pc-items (partial switch-items nth-pc-item))
rlm@369 143 (def switch-held-items (partial switch-items nth-item))
rlm@369 144
rlm@369 145 (defn combine-pc-items [idx-1 script]
rlm@369 146 (->> script
rlm@369 147 (switch-pc-items idx-1 (inc idx-1))))
rlm@345 148
rlm@345 149 (def desired-zero-quantities
rlm@345 150 (map second (filter (comp (partial = 0) first)
rlm@345 151 (partition 2 (pc-item-writer-program)))))
rlm@369 152
rlm@593 153 (defn bootstrap-corrupt-save
rlm@369 154 ([] (bootstrap-corrupt-save (to-room-pc)))
rlm@369 155 ([script]
rlm@369 156 (->> script
rlm@369 157 (do-save-corruption 3)
rlm@369 158 (corrupt-item-list 0)
rlm@369 159 close-all-menus)))
rlm@369 160
rlm@369 161 (defn-memo prepare-celadon-warp
rlm@369 162 ([] (prepare-celadon-warp (bootstrap-corrupt-save)))
rlm@369 163 ([script]
rlm@369 164 (->> script
rlm@369 165 (activate-start-menu)
rlm@369 166 (set-cursor-relative 1)
rlm@369 167 (select-menu-entry)
rlm@369 168 ;; vastly increase text speed while we're here.
rlm@369 169 (switch-held-items 21 27)
rlm@369 170 (toss-held-item 35 0xFA)
rlm@369 171 (close-all-menus))))
rlm@369 172
rlm@369 173 (defn-memo begin-initial-deposits
rlm@369 174 ([] (begin-initial-deposits
rlm@369 175 (prepare-celadon-warp)))
rlm@369 176 ([script]
rlm@369 177 (->> script
rlm@369 178 (first-difference [] [:a] AF)
rlm@369 179 (scroll-text)
rlm@369 180 (set-cursor 1)
rlm@369 181 select-menu-entry)))
rlm@369 182
rlm@345 183 (defn-memo initial-deposits
rlm@345 184 ([] (initial-deposits (begin-initial-deposits)))
rlm@345 185 ([script]
rlm@345 186 (->> script
rlm@354 187 (deposit-held-item 0 0x1)
rlm@345 188 ((fn [script]
rlm@345 189 (reduce
rlm@345 190 (fn [script item] (deposit-held-item item 0xFF script))
rlm@345 191 script
rlm@360 192 (range 3 (+ 13 3)))))
rlm@345 193 close-all-menus)))
rlm@345 194
rlm@345 195
rlm@345 196 ;;0 -- 256
rlm@345 197 ;;1 -- 254
rlm@345 198 ;;2 -- 254
rlm@345 199 ;;3 -- 255
rlm@345 200
rlm@369 201 (defn activate-home-pc
rlm@369 202 [script]
rlm@369 203 (->> script
rlm@369 204 (delayed-difference [] [:a]
rlm@369 205 200 first-character)
rlm@369 206 (scroll-text)))
rlm@369 207
rlm@345 208 (defn-memo restore-items
rlm@369 209 ([] (restore-items (initial-deposits)))
rlm@345 210 ([script]
rlm@345 211 (->> script
rlm@369 212 activate-home-pc
rlm@345 213 (select-menu-entry)
rlm@345 214 (widthdraw-pc-item 0 1)
rlm@354 215 ;;(widthdraw-pc-item 0 99)
rlm@354 216 ;;(widthdraw-pc-item 1 1)
rlm@360 217 (widthdraw-pc-item 13 255)
rlm@345 218 (close-all-menus))))
rlm@345 219
rlm@345 220 (defn-memo to-celadon
rlm@345 221 ([] (to-celadon (restore-items)))
rlm@345 222 ([script]
rlm@345 223 (->> script
rlm@345 224 (walk [→ → → → → → → ↑
rlm@345 225 ↓ ↓ ↓ ↓ ↓ ← ← ← ←
rlm@345 226 ↓ ↓]))))
rlm@345 227
rlm@345 228
rlm@351 229 ;; celadon store inventory
rlm@345 230
rlm@351 231 ;; Floor 2
rlm@351 232 ;;=====================================
rlm@351 233 ;; Great Ball TM32 (double-team)
rlm@351 234 ;; Super Potion TM33 (reflect)
rlm@351 235 ;; Revive TM02 (razor-wind)
rlm@351 236 ;; Super Repel TM07 (horn-drill)
rlm@351 237 ;; Antidote TM37 (egg-bomb)
rlm@351 238 ;; Burn Heal TM01 (mega-punch)
rlm@351 239 ;; Ice Heal TM05 (mega-kick)
rlm@351 240 ;; Awakening TM09 (take-down)
rlm@351 241 ;; Parlyz Heal TM17 (submission)
rlm@345 242
rlm@345 243
rlm@351 244 ;; Floor 3
rlm@351 245 ;;=====================================
rlm@351 246 ;; TM18 (counter)
rlm@345 247
rlm@351 248
rlm@351 249 ;; Floor 4
rlm@351 250 ;;=====================================
rlm@351 251 ;; Poke Doll
rlm@351 252 ;; Fire Stone
rlm@351 253 ;; Thunder Stone
rlm@351 254 ;; Water Stone
rlm@351 255 ;; Leaf Stone
rlm@351 256
rlm@351 257 ;; Floor 5
rlm@351 258 ;;=====================================
rlm@351 259 ;; X Accuracy HP UP
rlm@351 260 ;; Guard Spec. Protein
rlm@351 261 ;; Dire Hit Iron
rlm@351 262 ;; X Attack Carbos
rlm@351 263 ;; X Defend Calcium
rlm@351 264 ;; X Speed
rlm@351 265 ;; X Special
rlm@351 266
rlm@351 267 ;; Roof
rlm@351 268 ;;=====================================
rlm@351 269 ;; Fresh Water TM13 (ice-beam)
rlm@351 270 ;; Soda Pop TM48 (rock-slide)
rlm@352 271 ;; Lemonade :) TM49 (tri-attack)
rlm@352 272
rlm@352 273
rlm@353 274 (defn-memo go-to-floor-two
rlm@352 275 ([] (go-to-floor-two (to-celadon)))
rlm@352 276 ([script]
rlm@352 277 (->> script
rlm@593 278 (walk [→ → ↑
rlm@593 279 ↑ ↑ ↑ ↑
rlm@593 280 ← ← ← ←
rlm@593 281 ↑ ↑
rlm@352 282 ← ← ← ←
rlm@352 283 ↓ ↓ ↓
rlm@352 284 ← ←])
rlm@352 285 (first-difference [] ↑ AF))))
rlm@352 286
rlm@353 287 (defn talk
rlm@360 288 "Assumes that you are facing something that initiates text and
rlm@360 289 causes it to do so."
rlm@360 290 [script]
rlm@360 291 (->> script
rlm@360 292 (delayed-difference [] [:a] 100
rlm@368 293 first-character)))
rlm@353 294
rlm@354 295 (defn-memo get-money-floor-two
rlm@353 296 ([] (get-money-floor-two (go-to-floor-two)))
rlm@353 297 ([script]
rlm@353 298 (->> script
rlm@353 299 talk
rlm@353 300 (set-cursor 1)
rlm@353 301 (select-menu-entry)
rlm@594 302
rlm@594 303 ;; These glitch items have to be sold one at a time
rlm@594 304 ;; because the game will only award up to 500000 at
rlm@594 305 ;; a time for selling them.
rlm@354 306 (sell-held-item 0 1)
rlm@354 307 (sell-held-item 0 1)
rlm@594 308
rlm@354 309 (close-menu))))
rlm@352 310
rlm@354 311 (defn-memo floor-two-TMs
rlm@354 312 ([] (floor-two-TMs (get-money-floor-two)))
rlm@354 313 ([script]
rlm@354 314 (->> script
rlm@369 315 (set-cursor 0)
rlm@354 316 (select-menu-entry)
rlm@354 317 (buy-item 2 98) ;; TM02 (razor-wind)
rlm@354 318 (buy-item 4 71) ;; TM37 (doubleteam)
rlm@354 319 (buy-item 5 63) ;; TM01 (mega-punch)
rlm@354 320 (buy-item 6 1) ;; TM05 (mega-kick)
rlm@354 321 (buy-item 7 56) ;; TM09 (take-down)
rlm@354 322 (close-menu))))
rlm@354 323
rlm@354 324 (defn end-shop-conversation
rlm@354 325 [script]
rlm@354 326 (->> script
rlm@354 327 (wait-until scroll-text [:b])
rlm@354 328 (play-moves [[] [:b]])
rlm@354 329 close-menu))
rlm@354 330
rlm@354 331 (defn-memo floor-two-more-money
rlm@354 332 ([] (floor-two-more-money (floor-two-TMs)))
rlm@354 333 ([script]
rlm@354 334 (->> script
rlm@354 335 (set-cursor 1)
rlm@354 336 (select-menu-entry)
rlm@354 337 (sell-held-item 0 1)
rlm@354 338 (sell-held-item 0 1)
rlm@354 339 close-menu
rlm@354 340 end-shop-conversation)))
rlm@354 341
rlm@354 342 (defn turn [direction script]
rlm@354 343 (->> script
rlm@354 344 (first-difference [] direction AF)))
rlm@352 345
rlm@355 346 (defn-memo floor-two-items
rlm@355 347 ([] (floor-two-items (floor-two-more-money)))
rlm@355 348 ([script]
rlm@355 349 (->> script
rlm@355 350 (walk [←])
rlm@355 351 (turn ↑)
rlm@355 352 talk
rlm@355 353 select-menu-entry
rlm@355 354 (buy-item 5 12) ;; burn heal
rlm@355 355 (buy-item 6 55) ;; ice heal
rlm@355 356 (buy-item 7 4) ;; awakening
rlm@355 357 (buy-item 8 99) ;; parlyz heal
rlm@355 358 (buy-item 8 55) ;; parlyz heal
rlm@355 359 close-menu
rlm@355 360 end-shop-conversation)))
rlm@352 361
rlm@356 362 (defn-memo go-to-floor-three
rlm@356 363 ([] (go-to-floor-three (floor-two-items)))
rlm@356 364 ([script]
rlm@356 365 (->> script
rlm@361 366 (walk [→ → → → → → → → → → ↑ ↑ ↑
rlm@361 367 → ↑]))))
rlm@357 368 (defn-memo get-TM18
rlm@356 369 ([] (get-TM18 (go-to-floor-three)))
rlm@356 370 ([script]
rlm@356 371 (->> script
rlm@356 372 (walk [↓ ↓])
rlm@356 373 talk
rlm@356 374 (scroll-text 3)
rlm@356 375 end-text)))
rlm@352 376
rlm@357 377 (defn-memo go-to-floor-four
rlm@357 378 ([] (go-to-floor-four (get-TM18)))
rlm@357 379 ([script]
rlm@357 380 (->> script
rlm@357 381 (walk [← ← ← ← ↑ ↑
rlm@357 382 ↓ ← ← ↓ ↓ ↓
rlm@357 383 ← ← ← ← ←])
rlm@357 384 (turn ↓))))
rlm@352 385
rlm@357 386 (defn-memo floor-four-items
rlm@357 387 ([] (floor-four-items (go-to-floor-four)))
rlm@357 388 ([script]
rlm@357 389 (->> script
rlm@357 390 talk
rlm@357 391 select-menu-entry
rlm@357 392 (buy-item 1 23) ;; Fire Stone
rlm@357 393 (buy-item 2 98) ;; Thunder Stone
rlm@357 394 (buy-item 3 29) ;; Water Stone
rlm@357 395 close-menu
rlm@357 396 end-shop-conversation)))
rlm@352 397
rlm@358 398 (defn-memo go-to-floor-five
rlm@358 399 ([] (go-to-floor-five (floor-four-items)))
rlm@358 400 ([script]
rlm@358 401 (->> script
rlm@358 402 (walk [→ → → → → →
rlm@358 403 ↑ ↑ ↑
rlm@358 404 → → → → → ↑ ;; leave floor four
rlm@358 405 ↓ ← ← ← ← ← ← ← ←
rlm@359 406 ↓ ↓ ↓ ← ← ← ]);; go to five's clerk
rlm@358 407 (turn ↑))))
rlm@358 408
rlm@358 409 (defn-memo floor-five-items
rlm@358 410 ([] (floor-five-items (go-to-floor-five)))
rlm@358 411 ([script]
rlm@358 412 (->> script
rlm@358 413 talk
rlm@358 414 select-menu-entry
rlm@358 415 (buy-item 0 58) ;; X-Accuracy
rlm@358 416 (buy-item 1 99) ;; Guard Spec.
rlm@358 417 (buy-item 1 24) ;; Guard Spec.
rlm@358 418 close-menu
rlm@358 419 end-shop-conversation)))
rlm@352 420
rlm@359 421 (defn-memo go-to-roof
rlm@359 422 ([] (go-to-roof (floor-five-items)))
rlm@359 423 ([script]
rlm@359 424 (->> script
rlm@359 425 (walk [→ → → → ↑ ↑ ↑ → → → ↑ ;; leave floor five
rlm@359 426 ↓ ← ← ←]) ;; walk to vending machine
rlm@359 427 (turn ↑))))
rlm@352 428
rlm@359 429 (defn buy-drink
rlm@359 430 "Assumes you're in front of the vending machine. Buys the indicated
rlm@359 431 drink."
rlm@359 432 [n script]
rlm@359 433 (->> script
rlm@361 434 (do-nothing 20)
rlm@361 435 (play-moves [[:a][:a]])
rlm@361 436 scroll-text
rlm@359 437 (set-cursor n)
rlm@359 438 select-menu-entry
rlm@359 439 close-menu))
rlm@359 440
rlm@359 441 (defn-memo roof-drinks
rlm@359 442 ([] (roof-drinks (go-to-roof)))
rlm@359 443 ([script]
rlm@359 444 (->> script
rlm@361 445 (buy-drink 0) ;; fresh water (for TM13)
rlm@359 446 ;; buy 16 lemonades
rlm@359 447 ;; LEMONADE is the best item <3 :)
rlm@361 448 (multiple-times 16 (partial buy-drink 2)))))
rlm@361 449
rlm@362 450 (defn-memo get-TM13
rlm@359 451 ([] (get-TM13 (roof-drinks)))
rlm@359 452 ([script]
rlm@359 453 (->> script
rlm@594 454 ;; alternate route depending on girl's motions
rlm@369 455 ;;(walk [← ← ← ← ← ← ↓])
rlm@369 456 (walk [↓ ↓ ↓ ← ← ← ← ← ←])
rlm@369 457 (play-moves [[][][][][:a][:a][]])
rlm@361 458 (scroll-text 3)
rlm@359 459 select-menu-entry
rlm@359 460 select-menu-entry
rlm@359 461 (scroll-text 6)
rlm@359 462 close-menu)))
rlm@362 463
rlm@363 464 (defn-memo to-celadon-poke-center
rlm@362 465 ([] (to-celadon-poke-center (get-TM13)))
rlm@362 466 ([script]
rlm@362 467 (->> script
rlm@594 468 ;; alternate route depending on girl's motions
rlm@369 469 ;;(walk [↑ → → → → → → → → → ↑]) ; leave roof
rlm@369 470 (walk [→ → → → → → → → → ↑ ↑ ↑ ↑])
rlm@362 471 (walk [↓ ← ← ← ← ↓ ↓ ↓ ← ← ← ← ←
rlm@362 472 ↑ ↑ ↑ ← ← ↑]) ; to elevator
rlm@362 473
rlm@362 474 (walk [→ → ↑ ↑]) ; to controls
rlm@362 475 talk
rlm@362 476 select-menu-entry ; to floor 1
rlm@594 477 (walk [↓ ↓ ←])
rlm@362 478 (walk [↓ → ↓ ↓ ↓ ↓ ↓ ↓]) ; leave store
rlm@594 479 (walk [→ → → → → → → → → → ↑])
rlm@362 480 (walk (repeat 23 →))
rlm@362 481 (walk [↑ ↑ ↑ ↑]) ; enter poke center
rlm@362 482 (walk [↑ ↑ ↑ → → → → → → → → → →]) ; to computer
rlm@362 483 (turn ↑))))
rlm@363 484
rlm@363 485 (defn activate-rlm-pc [script]
rlm@363 486 (->> script
rlm@363 487 talk
rlm@363 488 scroll-text
rlm@369 489 ;;wait-for-cursor
rlm@363 490 (set-cursor 1)
rlm@363 491 select-menu-entry
rlm@363 492 (scroll-text 2)))
rlm@363 493
rlm@363 494 (defn begin-deposit [script]
rlm@363 495 (->> script
rlm@363 496 (set-cursor 1)
rlm@363 497 select-menu-entry))
rlm@363 498
rlm@363 499 (defn begin-withdraw [script]
rlm@363 500 (->> script
rlm@363 501 (set-cursor 0)
rlm@363 502 (select-menu-entry)))
rlm@363 503
rlm@363 504 (defn deposit-held-item-named
rlm@363 505 [item-name quantity [moves state :as script]]
rlm@363 506 (let [index (count
rlm@363 507 (take-while
rlm@363 508 (fn [[name quant]]
rlm@363 509 (or (not= name item-name)
rlm@363 510 (< quant quantity)))
rlm@363 511 (inventory state)))]
rlm@363 512 (println "index" index)
rlm@363 513 (deposit-held-item index quantity script)))
rlm@363 514
rlm@369 515 (defn open-held-items
rlm@369 516 [script]
rlm@369 517 (->> script
rlm@369 518 select-menu-entry))
rlm@363 519
rlm@369 520 (defn to-held-items
rlm@369 521 [script]
rlm@369 522 (->> script
rlm@369 523 close-menu
rlm@369 524 close-menu
rlm@369 525 end-text;;; grr
rlm@369 526
rlm@369 527 activate-start-menu
rlm@369 528 open-held-items))
rlm@369 529
rlm@369 530 (defn toss-pc-item [n quantity [moves state :as script]]
rlm@369 531 (let [total-quantity (second (nth-pc-item state n))]
rlm@369 532 (->> script
rlm@369 533 (set-cursor n)
rlm@369 534 (select-menu-entry 1)
rlm@369 535 (set-quantity total-quantity quantity)
rlm@369 536 (delayed-difference [] [:a] 100 #(search-string % "Is"))
rlm@369 537 (scroll-text)
rlm@369 538 select-menu-entry
rlm@369 539 (scroll-text))))
rlm@369 540
rlm@369 541 (defn-memo hacking-1
rlm@369 542 ([] (hacking-1 (to-celadon-poke-center)))
rlm@363 543 ([script]
rlm@363 544 (->> script
rlm@363 545 activate-rlm-pc
rlm@363 546 begin-deposit
rlm@363 547 (deposit-held-item-named 0x00 30)
rlm@363 548 (deposit-held-item-named :TM01 63)
rlm@363 549 (deposit-held-item-named :awakening 4)
rlm@363 550 (deposit-held-item-named :thunderstone 98)
rlm@363 551 (deposit-held-item-named :TM09 55)
rlm@363 552 (deposit-held-item-named 0x00 55))))
rlm@363 553
rlm@363 554 (defn-memo hacking-2
rlm@369 555 ([] (hacking-2 (hacking-1)))
rlm@363 556 ([script]
rlm@363 557 (->> script
rlm@364 558 (to-held-items)
rlm@363 559 (toss-held-item 0 166) ;; discard cruft
rlm@363 560 close-menu
rlm@363 561 close-menu)))
rlm@363 562
rlm@363 563 (defn-memo hacking-3
rlm@363 564 ([] (hacking-3 (hacking-2)))
rlm@363 565 ([script]
rlm@363 566 (->> script
rlm@363 567 activate-rlm-pc
rlm@363 568 begin-withdraw
rlm@363 569 (widthdraw-pc-item 0 99)
rlm@363 570 (widthdraw-pc-item 0 1)
rlm@363 571 (widthdraw-pc-item 2 0xFE)
rlm@368 572 (widthdraw-pc-item 3 0xFE)
rlm@368 573 close-menu)))
rlm@363 574
rlm@364 575 (defn-memo hacking-4
rlm@364 576 ([] (hacking-4 (hacking-3)))
rlm@364 577 ([script]
rlm@364 578 (->> script
rlm@364 579 begin-deposit
rlm@364 580 (deposit-held-item 19 243)
rlm@364 581 (deposit-held-item-named :lemonade 16)
rlm@364 582 (deposit-held-item 18 224))))
rlm@364 583
rlm@364 584 (defn-memo hacking-5
rlm@364 585 "clean out the held-item list again"
rlm@364 586 ([] (hacking-5 (hacking-4)))
rlm@364 587 ([script]
rlm@364 588 (->> script
rlm@364 589 (to-held-items)
rlm@364 590 (toss-held-item 18 30)
rlm@364 591 (toss-held-item 17 1)
rlm@364 592 close-menu
rlm@364 593 close-menu)))
rlm@363 594
rlm@364 595 (defn-memo hacking-6
rlm@364 596 ([] (hacking-6 (hacking-5)))
rlm@364 597 ([script]
rlm@364 598 (->> script
rlm@364 599 activate-rlm-pc
rlm@364 600 begin-withdraw
rlm@364 601 (widthdraw-pc-item 4 0xFE)
rlm@364 602 (widthdraw-pc-item 5 0xFE)
rlm@365 603 (widthdraw-pc-item 6 0xFE)
rlm@365 604 close-menu)))
rlm@364 605
rlm@365 606 (defn-memo hacking-7
rlm@365 607 ([] (hacking-7 (hacking-6)))
rlm@365 608 ([script]
rlm@365 609 (->> script
rlm@365 610 begin-deposit
rlm@365 611 (deposit-held-item 19 240)
rlm@365 612 (deposit-held-item 18 230)
rlm@365 613 (deposit-held-item-named :parlyz-heal 55)
rlm@365 614 (deposit-held-item 17 184)
rlm@365 615 (deposit-held-item 17 40)
rlm@365 616 (deposit-held-item-named :TM37 71)
rlm@365 617 (deposit-held-item-named :ice-heal 55)
rlm@365 618 (deposit-held-item-named :fire-stone 23)
rlm@366 619 (deposit-held-item-named :burn-heal 12)
rlm@369 620 ;; as a special case, /don't/ close the menu.
rlm@369 621 )))
rlm@366 622
rlm@366 623 (defn-memo hacking-8
rlm@366 624 "Clear cruft away from held item list."
rlm@366 625 ([] (hacking-8 (hacking-7)))
rlm@366 626 ([script]
rlm@366 627 (->> script
rlm@366 628 to-held-items
rlm@366 629 (toss-held-item 15 1)
rlm@366 630 (toss-held-item 14 1)
rlm@366 631 (toss-held-item 13 1)
rlm@366 632 close-menu
rlm@366 633 close-menu)))
rlm@366 634
rlm@366 635 (defn-memo hacking-9
rlm@366 636 ([] (hacking-9 (hacking-8)))
rlm@366 637 ([script]
rlm@366 638 (->> script
rlm@366 639 activate-rlm-pc
rlm@366 640 begin-withdraw
rlm@366 641 (widthdraw-pc-item 7 0xFE)
rlm@366 642 (widthdraw-pc-item 8 0xFC)
rlm@366 643 (widthdraw-pc-item 8 1)
rlm@366 644 (widthdraw-pc-item 8 1)
rlm@366 645 (widthdraw-pc-item 9 0xFE)
rlm@366 646 (multiple-times
rlm@366 647 7
rlm@368 648 (partial combine-pc-items 2))
rlm@366 649 close-menu)))
rlm@366 650
rlm@366 651 (defn-memo hacking-10
rlm@366 652 ([] (hacking-10 (hacking-9)))
rlm@366 653 ([script]
rlm@366 654 (->> script
rlm@366 655 begin-deposit
rlm@366 656 (deposit-held-item 17 230)
rlm@366 657 (deposit-held-item-named :parlyz-heal 55)
rlm@366 658 (deposit-held-item 14 178)
rlm@366 659 (deposit-held-item-named :water-stone 29)
rlm@366 660 (deposit-held-item 14 32)
rlm@366 661 (deposit-held-item-named :TM18 1)
rlm@366 662 (deposit-held-item 13 1)
rlm@366 663 (deposit-held-item 13 191)
rlm@366 664 (deposit-held-item-named :TM02 98)
rlm@366 665 (deposit-held-item-named :TM09 1)
rlm@366 666 close-menu)))
rlm@366 667
rlm@366 668 (defn-memo hacking-11
rlm@366 669 ([] (hacking-11 (hacking-10)))
rlm@366 670 ([script]
rlm@366 671 (->> script
rlm@367 672 begin-withdraw
rlm@367 673 (widthdraw-pc-item 3 0xFE)
rlm@367 674 (widthdraw-pc-item 4 0xFE)
rlm@367 675 (widthdraw-pc-item 5 1)
rlm@367 676 (widthdraw-pc-item 5 1)
rlm@367 677 (widthdraw-pc-item 5 1)
rlm@367 678 (widthdraw-pc-item 5 0xFB)
rlm@367 679 (multiple-times
rlm@367 680 3
rlm@369 681 (partial combine-pc-items 2))
rlm@367 682 close-menu)))
rlm@367 683
rlm@367 684 (defn-memo hacking-12
rlm@367 685 ([] (hacking-12 (hacking-11)))
rlm@367 686 ([script]
rlm@367 687 (->> script
rlm@367 688 begin-deposit
rlm@367 689 (deposit-held-item 18 203)
rlm@367 690 (deposit-held-item-named :guard-spec 87)
rlm@367 691 (deposit-held-item-named :guard-spec 24)
rlm@367 692 (deposit-held-item-named :TM05 1)
rlm@367 693 (multiple-times
rlm@367 694 8
rlm@369 695 (partial deposit-held-item 14 1))
rlm@367 696 (deposit-held-item 14 55)
rlm@367 697 (deposit-held-item-named :x-accuracy 58)
rlm@367 698 (deposit-held-item 14 38)
rlm@367 699 (deposit-held-item-named :TM13 1)
rlm@367 700 (deposit-held-item 13 1)
rlm@367 701 (deposit-held-item 13 233)
rlm@366 702 close-menu)))
rlm@367 703
rlm@368 704 (defn-memo hacking-13
rlm@367 705 ([] (hacking-13 (hacking-12)))
rlm@367 706 ([script]
rlm@367 707 (->> script
rlm@367 708 (set-cursor-relative 1)
rlm@367 709 (select-menu-entry)
rlm@367 710 (toss-pc-item 1 1)
rlm@367 711 (toss-pc-item 0 156)
rlm@368 712 (toss-pc-item 0 11))))
rlm@368 713
rlm@368 714 (defn confirm-pattern []
rlm@368 715 (let [start-address (inc pc-item-list-start)
rlm@368 716 target-pattern (pc-item-writer-program)
rlm@368 717 actual-pattern
rlm@368 718 (subvec (vec (memory (second (hacking-13))))
rlm@368 719 start-address
rlm@368 720 (+ start-address (count target-pattern)))]
rlm@368 721 (println target-pattern)
rlm@368 722 (println actual-pattern)
rlm@368 723 (= target-pattern actual-pattern)))
rlm@368 724
rlm@368 725 (defn-memo go-to-mansion-for-the-lulz
rlm@368 726 ([] (go-to-mansion-for-the-lulz (hacking-13)))
rlm@368 727 ([script]
rlm@368 728 (->> script
rlm@368 729 close-menu
rlm@368 730 close-menu
rlm@368 731 end-text ;;grr
rlm@368 732 (walk [↓ ← ← ← ← ← ← ← ← ← ↓ ↓ ↓])
rlm@368 733 (walk (repeat 17 ←))
rlm@368 734 (walk [↑ → → → → ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
rlm@368 735 (walk [↓ ← ↑])
rlm@368 736 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@368 737 ← ← ← ← ↑ ↑ ↑ ← ↑])
rlm@368 738 (talk)
rlm@368 739 (scroll-text 2)
rlm@369 740 (do-nothing 100)
rlm@367 741 close-menu)))
rlm@367 742
rlm@368 743 (defn-memo launch-bootstrap-program
rlm@368 744 ([] (launch-bootstrap-program
rlm@368 745 (go-to-mansion-for-the-lulz)))
rlm@368 746 ([script]
rlm@368 747 (->> script
rlm@368 748 ;; must corrupt item list again by switching pokemon
rlm@369 749 activate-start-menu ;; \
rlm@369 750 (set-cursor 0) ;; |
rlm@369 751 select-menu-entry ;; |
rlm@369 752 select-menu-entry ;; |
rlm@369 753 (set-cursor 1) ;; | -- switch 9th pokemon
rlm@369 754 select-menu-entry ;; | with 4th pokemon
rlm@369 755 (set-cursor 3) ;; |
rlm@369 756 select-menu-entry ;; |
rlm@369 757 close-menu ;; /
rlm@369 758 ;; now, open items and set map-function to
rlm@369 759 ;; the program inside the item-computer.
rlm@368 760 (set-cursor 1)
rlm@368 761 (select-menu-entry)
rlm@368 762 (toss-held-item 22 12)
rlm@368 763 (switch-held-items 22 40)
rlm@368 764 close-all-menus)))
rlm@369 765
rlm@376 766 (defn regen-control-checkpoint!
rlm@376 767 [] (write-script! (launch-bootstrap-program) "control-checkpoint"))
rlm@376 768
rlm@376 769 (defn control-checkpoint []
rlm@376 770 (read-script "control-checkpoint"))
rlm@376 771
rlm@369 772 (def increasing-pattern [0x01 0x23 0x45 0x67 0x89 0xAB 0xCD 0xEF])
rlm@369 773
rlm@369 774 (defn test-pattern-writing
rlm@369 775 ([] (test-pattern-writing increasing-pattern))
rlm@369 776 ([pattern]
rlm@369 777 (let [moves (bootstrap-pattern pattern)
rlm@369 778 pattern-insertion
rlm@369 779 (->> (launch-bootstrap-program)
rlm@369 780 (play-moves
rlm@369 781 (take 100 moves)))]
rlm@369 782 (println "Input Pattern:")
rlm@369 783 (apply println (map #(format "0x%02X" %) pattern))
rlm@369 784 (println "\nMemory Listing:")
rlm@369 785 (print-listing (second pattern-insertion)
rlm@369 786 0xD162 (+ 0xD162 (count pattern)))
rlm@369 787 (= (subvec (vec (memory (second pattern-insertion)))
rlm@369 788 0xD162 (+ 0xD162 (count pattern)))
rlm@369 789 pattern))))
rlm@369 790
rlm@416 791 (defn-memo launch-main-bootstrap-program
rlm@414 792 ([] (launch-main-bootstrap-program
rlm@414 793 (control-checkpoint)
rlm@414 794 ;;(launch-bootstrap-program)
rlm@414 795 ))
rlm@414 796 ([script]
rlm@416 797 (->> script
rlm@416 798 (play-moves
rlm@416 799 (bootstrap-pattern (main-bootstrap-program)))
rlm@416 800 (play-moves
rlm@416 801 (take 253 (interleave (repeat 1000 [:b])
rlm@416 802 (repeat 1000 [])))))))
rlm@541 803 (def bootstrap-start pokemon-list-start)
rlm@369 804
rlm@415 805 (defn test-main-bootstrap-integrety
rlm@415 806 []
rlm@415 807 (assert
rlm@415 808 (= (main-bootstrap-program)
rlm@541 809 (subvec
rlm@541 810 (vec (memory (second (launch-main-bootstrap-program))))
rlm@541 811 pokemon-list-start
rlm@541 812 (+ pokemon-list-start (count (main-bootstrap-program)))))))
rlm@415 813
rlm@414 814 (defn set-target-address
rlm@414 815 "Assumes that the game is under control of the main-bootstrap
rlm@414 816 program in MODE-SELECT mode, and sets the target address to which
rlm@414 817 jumps/writes will occur."
rlm@414 818 [target-address script]
rlm@414 819 (let [[target-high target-low] (disect-bytes-2 target-address)]
rlm@414 820 (->> script
rlm@414 821 (play-moves
rlm@414 822 (map buttons
rlm@414 823 [set-H-mode target-high 0x00
rlm@414 824 set-L-mode target-low 0x00])))))
rlm@416 825
rlm@416 826 (defn write-RAM-segment
rlm@416 827 "Assumes that the game is under control of the main-bootstrap
rlm@416 828 program in MODE-SELECT mode and that target-address has been
rlm@416 829 appropriately set, and writes 255 bytes or less to RAM."
rlm@416 830 [segment script]
rlm@416 831 (->> script
rlm@416 832 (play-moves
rlm@416 833 (map buttons
rlm@416 834 [write-mode (count segment)]))
rlm@416 835 (play-moves (map buttons segment))
rlm@416 836 (play-moves [[]])))
rlm@416 837
rlm@414 838 (defn write-RAM
rlm@414 839 "Assumes that the game is under control of the main-bootstrap
rlm@414 840 program in MODE-SELECT mode, and rewrites RAM starting at
rlm@414 841 'start-address with 'new-ram."
rlm@414 842 [start-address new-ram script]
rlm@416 843 (loop [s (set-target-address start-address script)
rlm@416 844 to-write new-ram]
rlm@416 845 (if (< (count to-write) 0x100)
rlm@416 846 (write-RAM-segment to-write s)
rlm@416 847 (recur
rlm@416 848 (write-RAM-segment (take 0xFF to-write) s)
rlm@416 849 (drop 0xFF to-write)))))
rlm@416 850
rlm@414 851 (defn transfer-control
rlm@414 852 "Assumes that the game is under control of the main-bootstrap
rlm@414 853 program in MODE-SELECT mode, and jumps to the target-address."
rlm@414 854 [target-address script]
rlm@414 855 (->> script
rlm@414 856 (set-target-address target-address)
rlm@414 857 (play-moves [(buttons jump-mode)])))
rlm@414 858
rlm@541 859
rlm@541 860 (def relocated-bootstrap-start
rlm@541 861 (+ 90 pokemon-box-1-address))
rlm@416 862
rlm@416 863 (defn-memo relocate-main-bootstrap
rlm@414 864 ([] (relocate-main-bootstrap (launch-main-bootstrap-program)))
rlm@414 865 ([script]
rlm@541 866 (->> script
rlm@541 867 (do-nothing 2)
rlm@541 868 (write-RAM
rlm@541 869 relocated-bootstrap-start
rlm@541 870 (main-bootstrap-program
rlm@541 871 relocated-bootstrap-start))
rlm@541 872 (do-nothing 1)
rlm@541 873 (transfer-control relocated-bootstrap-start)
rlm@541 874 (do-nothing 1))))
rlm@414 875
rlm@417 876 (defn gen-new-kernel-checkpoint! []
rlm@417 877 (write-script! (do-nothing 10 (relocate-main-bootstrap))
rlm@417 878 "new-kernel"))
rlm@417 879
rlm@417 880 (defn new-kernel [] (read-script "new-kernel"))
rlm@417 881
rlm@414 882 (def mid-game-data
rlm@414 883 (subvec (vec (memory (mid-game)))
rlm@414 884 pokemon-list-start
rlm@416 885 (+ pokemon-list-start 697)))
rlm@414 886
rlm@414 887 (def mid-game-map-address 0x46BC)
rlm@414 888
rlm@417 889 (defn-memo set-mid-game-data
rlm@414 890 ([] (set-mid-game-data (relocate-main-bootstrap)))
rlm@414 891 ([script]
rlm@414 892 (->> script
rlm@415 893 (do-nothing 10)
rlm@416 894 (write-RAM pokemon-list-start
rlm@416 895 mid-game-data))))
rlm@416 896 (defn test-set-data
rlm@416 897 ([] (test-set-data (relocate-main-bootstrap)))
rlm@416 898 ([script]
rlm@416 899 (->> script
rlm@416 900 (do-nothing 10)
rlm@416 901 (write-RAM pokemon-list-start
rlm@416 902 (repeat 500 0xCC)))))
rlm@416 903
rlm@416 904 (defn test-mid-game-transfer []
rlm@416 905 (= (subvec (vec (memory (second (set-mid-game-data))))
rlm@416 906 pokemon-list-start
rlm@416 907 (+ pokemon-list-start 500))
rlm@416 908 (subvec (vec (memory (mid-game)))
rlm@416 909 pokemon-list-start
rlm@416 910 (+ pokemon-list-start 500))))
rlm@415 911
rlm@417 912 (defn-memo return-to-pokemon-kernel
rlm@416 913 ([] (return-to-pokemon-kernel (set-mid-game-data)))
rlm@416 914 ([script]
rlm@416 915 (let [scratch (+ 200 pokemon-box-1-address)
rlm@416 916 return-program
rlm@416 917 (flatten
rlm@416 918 [0xFB
rlm@416 919 0xC3
rlm@416 920 (reverse (disect-bytes-2 mid-game-map-address))])]
rlm@416 921 (->> script
rlm@416 922 (write-RAM scratch return-program)
rlm@416 923 (transfer-control scratch)
rlm@416 924 (do-nothing 1)))))
rlm@416 925
rlm@416 926
rlm@414 927
rlm@414 928
rlm@414 929