Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_1.clj @ 593:daa3497bbe12

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
increased speed to travel to floor two of celadon dept. store.
author Robert McIntyre <rlm@mit.edu>
date Sat, 01 Sep 2012 12:38:26 -0500
parents cd557c922cec
children ea448eecb615
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@354 302 (sell-held-item 0 1)
rlm@354 303 (sell-held-item 0 1)
rlm@354 304 (close-menu))))
rlm@352 305
rlm@354 306 (defn-memo floor-two-TMs
rlm@354 307 ([] (floor-two-TMs (get-money-floor-two)))
rlm@354 308 ([script]
rlm@354 309 (->> script
rlm@369 310 (set-cursor 0)
rlm@354 311 (select-menu-entry)
rlm@354 312 (buy-item 2 98) ;; TM02 (razor-wind)
rlm@354 313 (buy-item 4 71) ;; TM37 (doubleteam)
rlm@354 314 (buy-item 5 63) ;; TM01 (mega-punch)
rlm@354 315 (buy-item 6 1) ;; TM05 (mega-kick)
rlm@354 316 (buy-item 7 56) ;; TM09 (take-down)
rlm@354 317 (close-menu))))
rlm@354 318
rlm@354 319 (defn end-shop-conversation
rlm@354 320 [script]
rlm@354 321 (->> script
rlm@354 322 (wait-until scroll-text [:b])
rlm@354 323 (play-moves [[] [:b]])
rlm@354 324 close-menu))
rlm@354 325
rlm@354 326 (defn-memo floor-two-more-money
rlm@354 327 ([] (floor-two-more-money (floor-two-TMs)))
rlm@354 328 ([script]
rlm@354 329 (->> script
rlm@354 330 (set-cursor 1)
rlm@354 331 (select-menu-entry)
rlm@354 332 (sell-held-item 0 1)
rlm@354 333 (sell-held-item 0 1)
rlm@354 334 close-menu
rlm@354 335 end-shop-conversation)))
rlm@354 336
rlm@354 337 (defn turn [direction script]
rlm@354 338 (->> script
rlm@354 339 (first-difference [] direction AF)))
rlm@352 340
rlm@355 341 (defn-memo floor-two-items
rlm@355 342 ([] (floor-two-items (floor-two-more-money)))
rlm@355 343 ([script]
rlm@355 344 (->> script
rlm@355 345 (walk [←])
rlm@355 346 (turn ↑)
rlm@355 347 talk
rlm@355 348 select-menu-entry
rlm@355 349 (buy-item 5 12) ;; burn heal
rlm@355 350 (buy-item 6 55) ;; ice heal
rlm@355 351 (buy-item 7 4) ;; awakening
rlm@355 352 (buy-item 8 99) ;; parlyz heal
rlm@355 353 (buy-item 8 55) ;; parlyz heal
rlm@355 354 close-menu
rlm@355 355 end-shop-conversation)))
rlm@352 356
rlm@356 357 (defn-memo go-to-floor-three
rlm@356 358 ([] (go-to-floor-three (floor-two-items)))
rlm@356 359 ([script]
rlm@356 360 (->> script
rlm@361 361 (walk [→ → → → → → → → → → ↑ ↑ ↑
rlm@361 362 → ↑]))))
rlm@357 363 (defn-memo get-TM18
rlm@356 364 ([] (get-TM18 (go-to-floor-three)))
rlm@356 365 ([script]
rlm@356 366 (->> script
rlm@356 367 (walk [↓ ↓])
rlm@356 368 talk
rlm@356 369 (scroll-text 3)
rlm@356 370 end-text)))
rlm@352 371
rlm@357 372 (defn-memo go-to-floor-four
rlm@357 373 ([] (go-to-floor-four (get-TM18)))
rlm@357 374 ([script]
rlm@357 375 (->> script
rlm@357 376 (walk [← ← ← ← ↑ ↑
rlm@357 377 ↓ ← ← ↓ ↓ ↓
rlm@357 378 ← ← ← ← ←])
rlm@357 379 (turn ↓))))
rlm@352 380
rlm@357 381 (defn-memo floor-four-items
rlm@357 382 ([] (floor-four-items (go-to-floor-four)))
rlm@357 383 ([script]
rlm@357 384 (->> script
rlm@357 385 talk
rlm@357 386 select-menu-entry
rlm@357 387 (buy-item 1 23) ;; Fire Stone
rlm@357 388 (buy-item 2 98) ;; Thunder Stone
rlm@357 389 (buy-item 3 29) ;; Water Stone
rlm@357 390 close-menu
rlm@357 391 end-shop-conversation)))
rlm@352 392
rlm@358 393 (defn-memo go-to-floor-five
rlm@358 394 ([] (go-to-floor-five (floor-four-items)))
rlm@358 395 ([script]
rlm@358 396 (->> script
rlm@358 397 (walk [→ → → → → →
rlm@358 398 ↑ ↑ ↑
rlm@358 399 → → → → → ↑ ;; leave floor four
rlm@358 400 ↓ ← ← ← ← ← ← ← ←
rlm@359 401 ↓ ↓ ↓ ← ← ← ]);; go to five's clerk
rlm@358 402 (turn ↑))))
rlm@358 403
rlm@358 404 (defn-memo floor-five-items
rlm@358 405 ([] (floor-five-items (go-to-floor-five)))
rlm@358 406 ([script]
rlm@358 407 (->> script
rlm@358 408 talk
rlm@358 409 select-menu-entry
rlm@358 410 (buy-item 0 58) ;; X-Accuracy
rlm@358 411 (buy-item 1 99) ;; Guard Spec.
rlm@358 412 (buy-item 1 24) ;; Guard Spec.
rlm@358 413 close-menu
rlm@358 414 end-shop-conversation)))
rlm@352 415
rlm@359 416 (defn-memo go-to-roof
rlm@359 417 ([] (go-to-roof (floor-five-items)))
rlm@359 418 ([script]
rlm@359 419 (->> script
rlm@359 420 (walk [→ → → → ↑ ↑ ↑ → → → ↑ ;; leave floor five
rlm@359 421 ↓ ← ← ←]) ;; walk to vending machine
rlm@359 422 (turn ↑))))
rlm@352 423
rlm@359 424 (defn buy-drink
rlm@359 425 "Assumes you're in front of the vending machine. Buys the indicated
rlm@359 426 drink."
rlm@359 427 [n script]
rlm@359 428 (->> script
rlm@361 429 (do-nothing 20)
rlm@361 430 (play-moves [[:a][:a]])
rlm@361 431 scroll-text
rlm@359 432 (set-cursor n)
rlm@359 433 select-menu-entry
rlm@359 434 close-menu))
rlm@359 435
rlm@359 436 (defn-memo roof-drinks
rlm@359 437 ([] (roof-drinks (go-to-roof)))
rlm@359 438 ([script]
rlm@359 439 (->> script
rlm@361 440 (buy-drink 0) ;; fresh water (for TM13)
rlm@359 441 ;; buy 16 lemonades
rlm@359 442 ;; LEMONADE is the best item <3 :)
rlm@361 443 (multiple-times 16 (partial buy-drink 2)))))
rlm@361 444
rlm@362 445 (defn-memo get-TM13
rlm@359 446 ([] (get-TM13 (roof-drinks)))
rlm@359 447 ([script]
rlm@359 448 (->> script
rlm@369 449 ;;(walk [← ← ← ← ← ← ↓])
rlm@369 450 (walk [↓ ↓ ↓ ← ← ← ← ← ←])
rlm@369 451 (play-moves [[][][][][:a][:a][]])
rlm@361 452 (scroll-text 3)
rlm@359 453 select-menu-entry
rlm@359 454 select-menu-entry
rlm@359 455 (scroll-text 6)
rlm@359 456 close-menu)))
rlm@362 457
rlm@363 458 (defn-memo to-celadon-poke-center
rlm@362 459 ([] (to-celadon-poke-center (get-TM13)))
rlm@362 460 ([script]
rlm@362 461 (->> script
rlm@369 462 ;;(walk [↑ → → → → → → → → → ↑]) ; leave roof
rlm@369 463 (walk [→ → → → → → → → → ↑ ↑ ↑ ↑])
rlm@362 464 (walk [↓ ← ← ← ← ↓ ↓ ↓ ← ← ← ← ←
rlm@362 465 ↑ ↑ ↑ ← ← ↑]) ; to elevator
rlm@362 466
rlm@362 467 (walk [→ → ↑ ↑]) ; to controls
rlm@362 468 talk
rlm@362 469 select-menu-entry ; to floor 1
rlm@362 470 (walk [↓ ↓ ← ←])
rlm@362 471 (walk [↓ → ↓ ↓ ↓ ↓ ↓ ↓]) ; leave store
rlm@362 472 (walk [↓ → → → → → → → → → → ↑ ↑])
rlm@362 473 (walk (repeat 23 →))
rlm@362 474 (walk [↑ ↑ ↑ ↑]) ; enter poke center
rlm@362 475 (walk [↑ ↑ ↑ → → → → → → → → → →]) ; to computer
rlm@362 476 (turn ↑))))
rlm@363 477
rlm@363 478 (defn activate-rlm-pc [script]
rlm@363 479 (->> script
rlm@363 480 talk
rlm@363 481 scroll-text
rlm@369 482 ;;wait-for-cursor
rlm@363 483 (set-cursor 1)
rlm@363 484 select-menu-entry
rlm@363 485 (scroll-text 2)))
rlm@363 486
rlm@363 487 (defn begin-deposit [script]
rlm@363 488 (->> script
rlm@363 489 (set-cursor 1)
rlm@363 490 select-menu-entry))
rlm@363 491
rlm@363 492 (defn begin-withdraw [script]
rlm@363 493 (->> script
rlm@363 494 (set-cursor 0)
rlm@363 495 (select-menu-entry)))
rlm@363 496
rlm@363 497 (defn deposit-held-item-named
rlm@363 498 [item-name quantity [moves state :as script]]
rlm@363 499 (let [index (count
rlm@363 500 (take-while
rlm@363 501 (fn [[name quant]]
rlm@363 502 (or (not= name item-name)
rlm@363 503 (< quant quantity)))
rlm@363 504 (inventory state)))]
rlm@363 505 (println "index" index)
rlm@363 506 (deposit-held-item index quantity script)))
rlm@363 507
rlm@369 508 (defn open-held-items
rlm@369 509 [script]
rlm@369 510 (->> script
rlm@369 511 select-menu-entry))
rlm@363 512
rlm@369 513 (defn to-held-items
rlm@369 514 [script]
rlm@369 515 (->> script
rlm@369 516 close-menu
rlm@369 517 close-menu
rlm@369 518 end-text;;; grr
rlm@369 519
rlm@369 520 activate-start-menu
rlm@369 521 open-held-items))
rlm@369 522
rlm@369 523 (defn toss-pc-item [n quantity [moves state :as script]]
rlm@369 524 (let [total-quantity (second (nth-pc-item state n))]
rlm@369 525 (->> script
rlm@369 526 (set-cursor n)
rlm@369 527 (select-menu-entry 1)
rlm@369 528 (set-quantity total-quantity quantity)
rlm@369 529 (delayed-difference [] [:a] 100 #(search-string % "Is"))
rlm@369 530 (scroll-text)
rlm@369 531 select-menu-entry
rlm@369 532 (scroll-text))))
rlm@369 533
rlm@369 534 (defn-memo hacking-1
rlm@369 535 ([] (hacking-1 (to-celadon-poke-center)))
rlm@363 536 ([script]
rlm@363 537 (->> script
rlm@363 538 activate-rlm-pc
rlm@363 539 begin-deposit
rlm@363 540 (deposit-held-item-named 0x00 30)
rlm@363 541 (deposit-held-item-named :TM01 63)
rlm@363 542 (deposit-held-item-named :awakening 4)
rlm@363 543 (deposit-held-item-named :thunderstone 98)
rlm@363 544 (deposit-held-item-named :TM09 55)
rlm@363 545 (deposit-held-item-named 0x00 55))))
rlm@363 546
rlm@363 547 (defn-memo hacking-2
rlm@369 548 ([] (hacking-2 (hacking-1)))
rlm@363 549 ([script]
rlm@363 550 (->> script
rlm@364 551 (to-held-items)
rlm@363 552 (toss-held-item 0 166) ;; discard cruft
rlm@363 553 close-menu
rlm@363 554 close-menu)))
rlm@363 555
rlm@363 556 (defn-memo hacking-3
rlm@363 557 ([] (hacking-3 (hacking-2)))
rlm@363 558 ([script]
rlm@363 559 (->> script
rlm@363 560 activate-rlm-pc
rlm@363 561 begin-withdraw
rlm@363 562 (widthdraw-pc-item 0 99)
rlm@363 563 (widthdraw-pc-item 0 1)
rlm@363 564 (widthdraw-pc-item 2 0xFE)
rlm@368 565 (widthdraw-pc-item 3 0xFE)
rlm@368 566 close-menu)))
rlm@363 567
rlm@364 568 (defn-memo hacking-4
rlm@364 569 ([] (hacking-4 (hacking-3)))
rlm@364 570 ([script]
rlm@364 571 (->> script
rlm@364 572 begin-deposit
rlm@364 573 (deposit-held-item 19 243)
rlm@364 574 (deposit-held-item-named :lemonade 16)
rlm@364 575 (deposit-held-item 18 224))))
rlm@364 576
rlm@364 577 (defn-memo hacking-5
rlm@364 578 "clean out the held-item list again"
rlm@364 579 ([] (hacking-5 (hacking-4)))
rlm@364 580 ([script]
rlm@364 581 (->> script
rlm@364 582 (to-held-items)
rlm@364 583 (toss-held-item 18 30)
rlm@364 584 (toss-held-item 17 1)
rlm@364 585 close-menu
rlm@364 586 close-menu)))
rlm@363 587
rlm@364 588 (defn-memo hacking-6
rlm@364 589 ([] (hacking-6 (hacking-5)))
rlm@364 590 ([script]
rlm@364 591 (->> script
rlm@364 592 activate-rlm-pc
rlm@364 593 begin-withdraw
rlm@364 594 (widthdraw-pc-item 4 0xFE)
rlm@364 595 (widthdraw-pc-item 5 0xFE)
rlm@365 596 (widthdraw-pc-item 6 0xFE)
rlm@365 597 close-menu)))
rlm@364 598
rlm@365 599 (defn-memo hacking-7
rlm@365 600 ([] (hacking-7 (hacking-6)))
rlm@365 601 ([script]
rlm@365 602 (->> script
rlm@365 603 begin-deposit
rlm@365 604 (deposit-held-item 19 240)
rlm@365 605 (deposit-held-item 18 230)
rlm@365 606 (deposit-held-item-named :parlyz-heal 55)
rlm@365 607 (deposit-held-item 17 184)
rlm@365 608 (deposit-held-item 17 40)
rlm@365 609 (deposit-held-item-named :TM37 71)
rlm@365 610 (deposit-held-item-named :ice-heal 55)
rlm@365 611 (deposit-held-item-named :fire-stone 23)
rlm@366 612 (deposit-held-item-named :burn-heal 12)
rlm@369 613 ;; as a special case, /don't/ close the menu.
rlm@369 614 )))
rlm@366 615
rlm@366 616 (defn-memo hacking-8
rlm@366 617 "Clear cruft away from held item list."
rlm@366 618 ([] (hacking-8 (hacking-7)))
rlm@366 619 ([script]
rlm@366 620 (->> script
rlm@366 621 to-held-items
rlm@366 622 (toss-held-item 15 1)
rlm@366 623 (toss-held-item 14 1)
rlm@366 624 (toss-held-item 13 1)
rlm@366 625 close-menu
rlm@366 626 close-menu)))
rlm@366 627
rlm@366 628 (defn-memo hacking-9
rlm@366 629 ([] (hacking-9 (hacking-8)))
rlm@366 630 ([script]
rlm@366 631 (->> script
rlm@366 632 activate-rlm-pc
rlm@366 633 begin-withdraw
rlm@366 634 (widthdraw-pc-item 7 0xFE)
rlm@366 635 (widthdraw-pc-item 8 0xFC)
rlm@366 636 (widthdraw-pc-item 8 1)
rlm@366 637 (widthdraw-pc-item 8 1)
rlm@366 638 (widthdraw-pc-item 9 0xFE)
rlm@366 639 (multiple-times
rlm@366 640 7
rlm@368 641 (partial combine-pc-items 2))
rlm@366 642 close-menu)))
rlm@366 643
rlm@366 644 (defn-memo hacking-10
rlm@366 645 ([] (hacking-10 (hacking-9)))
rlm@366 646 ([script]
rlm@366 647 (->> script
rlm@366 648 begin-deposit
rlm@366 649 (deposit-held-item 17 230)
rlm@366 650 (deposit-held-item-named :parlyz-heal 55)
rlm@366 651 (deposit-held-item 14 178)
rlm@366 652 (deposit-held-item-named :water-stone 29)
rlm@366 653 (deposit-held-item 14 32)
rlm@366 654 (deposit-held-item-named :TM18 1)
rlm@366 655 (deposit-held-item 13 1)
rlm@366 656 (deposit-held-item 13 191)
rlm@366 657 (deposit-held-item-named :TM02 98)
rlm@366 658 (deposit-held-item-named :TM09 1)
rlm@366 659 close-menu)))
rlm@366 660
rlm@366 661 (defn-memo hacking-11
rlm@366 662 ([] (hacking-11 (hacking-10)))
rlm@366 663 ([script]
rlm@366 664 (->> script
rlm@367 665 begin-withdraw
rlm@367 666 (widthdraw-pc-item 3 0xFE)
rlm@367 667 (widthdraw-pc-item 4 0xFE)
rlm@367 668 (widthdraw-pc-item 5 1)
rlm@367 669 (widthdraw-pc-item 5 1)
rlm@367 670 (widthdraw-pc-item 5 1)
rlm@367 671 (widthdraw-pc-item 5 0xFB)
rlm@367 672 (multiple-times
rlm@367 673 3
rlm@369 674 (partial combine-pc-items 2))
rlm@367 675 close-menu)))
rlm@367 676
rlm@367 677 (defn-memo hacking-12
rlm@367 678 ([] (hacking-12 (hacking-11)))
rlm@367 679 ([script]
rlm@367 680 (->> script
rlm@367 681 begin-deposit
rlm@367 682 (deposit-held-item 18 203)
rlm@367 683 (deposit-held-item-named :guard-spec 87)
rlm@367 684 (deposit-held-item-named :guard-spec 24)
rlm@367 685 (deposit-held-item-named :TM05 1)
rlm@367 686 (multiple-times
rlm@367 687 8
rlm@369 688 (partial deposit-held-item 14 1))
rlm@367 689 (deposit-held-item 14 55)
rlm@367 690 (deposit-held-item-named :x-accuracy 58)
rlm@367 691 (deposit-held-item 14 38)
rlm@367 692 (deposit-held-item-named :TM13 1)
rlm@367 693 (deposit-held-item 13 1)
rlm@367 694 (deposit-held-item 13 233)
rlm@366 695 close-menu)))
rlm@367 696
rlm@368 697 (defn-memo hacking-13
rlm@367 698 ([] (hacking-13 (hacking-12)))
rlm@367 699 ([script]
rlm@367 700 (->> script
rlm@367 701 (set-cursor-relative 1)
rlm@367 702 (select-menu-entry)
rlm@367 703 (toss-pc-item 1 1)
rlm@367 704 (toss-pc-item 0 156)
rlm@368 705 (toss-pc-item 0 11))))
rlm@368 706
rlm@368 707 (defn confirm-pattern []
rlm@368 708 (let [start-address (inc pc-item-list-start)
rlm@368 709 target-pattern (pc-item-writer-program)
rlm@368 710 actual-pattern
rlm@368 711 (subvec (vec (memory (second (hacking-13))))
rlm@368 712 start-address
rlm@368 713 (+ start-address (count target-pattern)))]
rlm@368 714 (println target-pattern)
rlm@368 715 (println actual-pattern)
rlm@368 716 (= target-pattern actual-pattern)))
rlm@368 717
rlm@368 718 (defn-memo go-to-mansion-for-the-lulz
rlm@368 719 ([] (go-to-mansion-for-the-lulz (hacking-13)))
rlm@368 720 ([script]
rlm@368 721 (->> script
rlm@368 722 close-menu
rlm@368 723 close-menu
rlm@368 724 end-text ;;grr
rlm@368 725 (walk [↓ ← ← ← ← ← ← ← ← ← ↓ ↓ ↓])
rlm@368 726 (walk (repeat 17 ←))
rlm@368 727 (walk [↑ → → → → ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
rlm@368 728 (walk [↓ ← ↑])
rlm@368 729 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@368 730 ← ← ← ← ↑ ↑ ↑ ← ↑])
rlm@368 731 (talk)
rlm@368 732 (scroll-text 2)
rlm@369 733 (do-nothing 100)
rlm@367 734 close-menu)))
rlm@367 735
rlm@368 736 (defn-memo launch-bootstrap-program
rlm@368 737 ([] (launch-bootstrap-program
rlm@368 738 (go-to-mansion-for-the-lulz)))
rlm@368 739 ([script]
rlm@368 740 (->> script
rlm@368 741 ;; must corrupt item list again by switching pokemon
rlm@369 742 activate-start-menu ;; \
rlm@369 743 (set-cursor 0) ;; |
rlm@369 744 select-menu-entry ;; |
rlm@369 745 select-menu-entry ;; |
rlm@369 746 (set-cursor 1) ;; | -- switch 9th pokemon
rlm@369 747 select-menu-entry ;; | with 4th pokemon
rlm@369 748 (set-cursor 3) ;; |
rlm@369 749 select-menu-entry ;; |
rlm@369 750 close-menu ;; /
rlm@369 751 ;; now, open items and set map-function to
rlm@369 752 ;; the program inside the item-computer.
rlm@368 753 (set-cursor 1)
rlm@368 754 (select-menu-entry)
rlm@368 755 (toss-held-item 22 12)
rlm@368 756 (switch-held-items 22 40)
rlm@368 757 close-all-menus)))
rlm@369 758
rlm@376 759 (defn regen-control-checkpoint!
rlm@376 760 [] (write-script! (launch-bootstrap-program) "control-checkpoint"))
rlm@376 761
rlm@376 762 (defn control-checkpoint []
rlm@376 763 (read-script "control-checkpoint"))
rlm@376 764
rlm@369 765 (def increasing-pattern [0x01 0x23 0x45 0x67 0x89 0xAB 0xCD 0xEF])
rlm@369 766
rlm@369 767 (defn test-pattern-writing
rlm@369 768 ([] (test-pattern-writing increasing-pattern))
rlm@369 769 ([pattern]
rlm@369 770 (let [moves (bootstrap-pattern pattern)
rlm@369 771 pattern-insertion
rlm@369 772 (->> (launch-bootstrap-program)
rlm@369 773 (play-moves
rlm@369 774 (take 100 moves)))]
rlm@369 775 (println "Input Pattern:")
rlm@369 776 (apply println (map #(format "0x%02X" %) pattern))
rlm@369 777 (println "\nMemory Listing:")
rlm@369 778 (print-listing (second pattern-insertion)
rlm@369 779 0xD162 (+ 0xD162 (count pattern)))
rlm@369 780 (= (subvec (vec (memory (second pattern-insertion)))
rlm@369 781 0xD162 (+ 0xD162 (count pattern)))
rlm@369 782 pattern))))
rlm@369 783
rlm@416 784 (defn-memo launch-main-bootstrap-program
rlm@414 785 ([] (launch-main-bootstrap-program
rlm@414 786 (control-checkpoint)
rlm@414 787 ;;(launch-bootstrap-program)
rlm@414 788 ))
rlm@414 789 ([script]
rlm@416 790 (->> script
rlm@416 791 (play-moves
rlm@416 792 (bootstrap-pattern (main-bootstrap-program)))
rlm@416 793 (play-moves
rlm@416 794 (take 253 (interleave (repeat 1000 [:b])
rlm@416 795 (repeat 1000 [])))))))
rlm@541 796 (def bootstrap-start pokemon-list-start)
rlm@369 797
rlm@415 798 (defn test-main-bootstrap-integrety
rlm@415 799 []
rlm@415 800 (assert
rlm@415 801 (= (main-bootstrap-program)
rlm@541 802 (subvec
rlm@541 803 (vec (memory (second (launch-main-bootstrap-program))))
rlm@541 804 pokemon-list-start
rlm@541 805 (+ pokemon-list-start (count (main-bootstrap-program)))))))
rlm@415 806
rlm@414 807 (defn set-target-address
rlm@414 808 "Assumes that the game is under control of the main-bootstrap
rlm@414 809 program in MODE-SELECT mode, and sets the target address to which
rlm@414 810 jumps/writes will occur."
rlm@414 811 [target-address script]
rlm@414 812 (let [[target-high target-low] (disect-bytes-2 target-address)]
rlm@414 813 (->> script
rlm@414 814 (play-moves
rlm@414 815 (map buttons
rlm@414 816 [set-H-mode target-high 0x00
rlm@414 817 set-L-mode target-low 0x00])))))
rlm@416 818
rlm@416 819 (defn write-RAM-segment
rlm@416 820 "Assumes that the game is under control of the main-bootstrap
rlm@416 821 program in MODE-SELECT mode and that target-address has been
rlm@416 822 appropriately set, and writes 255 bytes or less to RAM."
rlm@416 823 [segment script]
rlm@416 824 (->> script
rlm@416 825 (play-moves
rlm@416 826 (map buttons
rlm@416 827 [write-mode (count segment)]))
rlm@416 828 (play-moves (map buttons segment))
rlm@416 829 (play-moves [[]])))
rlm@416 830
rlm@414 831 (defn write-RAM
rlm@414 832 "Assumes that the game is under control of the main-bootstrap
rlm@414 833 program in MODE-SELECT mode, and rewrites RAM starting at
rlm@414 834 'start-address with 'new-ram."
rlm@414 835 [start-address new-ram script]
rlm@416 836 (loop [s (set-target-address start-address script)
rlm@416 837 to-write new-ram]
rlm@416 838 (if (< (count to-write) 0x100)
rlm@416 839 (write-RAM-segment to-write s)
rlm@416 840 (recur
rlm@416 841 (write-RAM-segment (take 0xFF to-write) s)
rlm@416 842 (drop 0xFF to-write)))))
rlm@416 843
rlm@414 844 (defn transfer-control
rlm@414 845 "Assumes that the game is under control of the main-bootstrap
rlm@414 846 program in MODE-SELECT mode, and jumps to the target-address."
rlm@414 847 [target-address script]
rlm@414 848 (->> script
rlm@414 849 (set-target-address target-address)
rlm@414 850 (play-moves [(buttons jump-mode)])))
rlm@414 851
rlm@541 852
rlm@541 853 (def relocated-bootstrap-start
rlm@541 854 (+ 90 pokemon-box-1-address))
rlm@416 855
rlm@416 856 (defn-memo relocate-main-bootstrap
rlm@414 857 ([] (relocate-main-bootstrap (launch-main-bootstrap-program)))
rlm@414 858 ([script]
rlm@541 859 (->> script
rlm@541 860 (do-nothing 2)
rlm@541 861 (write-RAM
rlm@541 862 relocated-bootstrap-start
rlm@541 863 (main-bootstrap-program
rlm@541 864 relocated-bootstrap-start))
rlm@541 865 (do-nothing 1)
rlm@541 866 (transfer-control relocated-bootstrap-start)
rlm@541 867 (do-nothing 1))))
rlm@414 868
rlm@417 869 (defn gen-new-kernel-checkpoint! []
rlm@417 870 (write-script! (do-nothing 10 (relocate-main-bootstrap))
rlm@417 871 "new-kernel"))
rlm@417 872
rlm@417 873 (defn new-kernel [] (read-script "new-kernel"))
rlm@417 874
rlm@414 875 (def mid-game-data
rlm@414 876 (subvec (vec (memory (mid-game)))
rlm@414 877 pokemon-list-start
rlm@416 878 (+ pokemon-list-start 697)))
rlm@414 879
rlm@414 880 (def mid-game-map-address 0x46BC)
rlm@414 881
rlm@417 882 (defn-memo set-mid-game-data
rlm@414 883 ([] (set-mid-game-data (relocate-main-bootstrap)))
rlm@414 884 ([script]
rlm@414 885 (->> script
rlm@415 886 (do-nothing 10)
rlm@416 887 (write-RAM pokemon-list-start
rlm@416 888 mid-game-data))))
rlm@416 889 (defn test-set-data
rlm@416 890 ([] (test-set-data (relocate-main-bootstrap)))
rlm@416 891 ([script]
rlm@416 892 (->> script
rlm@416 893 (do-nothing 10)
rlm@416 894 (write-RAM pokemon-list-start
rlm@416 895 (repeat 500 0xCC)))))
rlm@416 896
rlm@416 897 (defn test-mid-game-transfer []
rlm@416 898 (= (subvec (vec (memory (second (set-mid-game-data))))
rlm@416 899 pokemon-list-start
rlm@416 900 (+ pokemon-list-start 500))
rlm@416 901 (subvec (vec (memory (mid-game)))
rlm@416 902 pokemon-list-start
rlm@416 903 (+ pokemon-list-start 500))))
rlm@415 904
rlm@417 905 (defn-memo return-to-pokemon-kernel
rlm@416 906 ([] (return-to-pokemon-kernel (set-mid-game-data)))
rlm@416 907 ([script]
rlm@416 908 (let [scratch (+ 200 pokemon-box-1-address)
rlm@416 909 return-program
rlm@416 910 (flatten
rlm@416 911 [0xFB
rlm@416 912 0xC3
rlm@416 913 (reverse (disect-bytes-2 mid-game-map-address))])]
rlm@416 914 (->> script
rlm@416 915 (write-RAM scratch return-program)
rlm@416 916 (transfer-control scratch)
rlm@416 917 (do-nothing 1)))))
rlm@416 918
rlm@416 919
rlm@414 920
rlm@414 921
rlm@414 922