Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_1.clj @ 598:0b4ff504157d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge.
author Robert McIntyre <rlm@mit.edu>
date Sun, 02 Sep 2012 06:37:11 -0500
parents 747d47d96d2f
children 0e30fd920e6a
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@595 520 (defn close-celadon-computer-menu
rlm@595 521 [script]
rlm@595 522 ;; this part was determined via manual binary search
rlm@595 523 ;; because for some reason the current-depth RAM value
rlm@595 524 ;; is the same for both the final menu being either on
rlm@595 525 ;; or off.
rlm@595 526 (->> script
rlm@595 527 (play-moves
rlm@595 528 (concat (repeat 4 []) [[:b]]))))
rlm@595 529
rlm@369 530 (defn to-held-items
rlm@369 531 [script]
rlm@369 532 (->> script
rlm@369 533 close-menu
rlm@369 534 close-menu
rlm@595 535 close-celadon-computer-menu
rlm@369 536 activate-start-menu
rlm@369 537 open-held-items))
rlm@369 538
rlm@369 539 (defn toss-pc-item [n quantity [moves state :as script]]
rlm@369 540 (let [total-quantity (second (nth-pc-item state n))]
rlm@369 541 (->> script
rlm@369 542 (set-cursor n)
rlm@369 543 (select-menu-entry 1)
rlm@369 544 (set-quantity total-quantity quantity)
rlm@369 545 (delayed-difference [] [:a] 100 #(search-string % "Is"))
rlm@369 546 (scroll-text)
rlm@369 547 select-menu-entry
rlm@369 548 (scroll-text))))
rlm@369 549
rlm@369 550 (defn-memo hacking-1
rlm@369 551 ([] (hacking-1 (to-celadon-poke-center)))
rlm@363 552 ([script]
rlm@363 553 (->> script
rlm@363 554 activate-rlm-pc
rlm@363 555 begin-deposit
rlm@363 556 (deposit-held-item-named 0x00 30)
rlm@363 557 (deposit-held-item-named :TM01 63)
rlm@363 558 (deposit-held-item-named :awakening 4)
rlm@363 559 (deposit-held-item-named :thunderstone 98)
rlm@363 560 (deposit-held-item-named :TM09 55)
rlm@363 561 (deposit-held-item-named 0x00 55))))
rlm@363 562
rlm@595 563 (defn hacking-2
rlm@369 564 ([] (hacking-2 (hacking-1)))
rlm@363 565 ([script]
rlm@363 566 (->> script
rlm@364 567 (to-held-items)
rlm@363 568 (toss-held-item 0 166) ;; discard cruft
rlm@363 569 close-menu
rlm@363 570 close-menu)))
rlm@363 571
rlm@363 572 (defn-memo hacking-3
rlm@363 573 ([] (hacking-3 (hacking-2)))
rlm@363 574 ([script]
rlm@363 575 (->> script
rlm@363 576 activate-rlm-pc
rlm@363 577 begin-withdraw
rlm@363 578 (widthdraw-pc-item 0 99)
rlm@363 579 (widthdraw-pc-item 0 1)
rlm@363 580 (widthdraw-pc-item 2 0xFE)
rlm@368 581 (widthdraw-pc-item 3 0xFE)
rlm@368 582 close-menu)))
rlm@363 583
rlm@364 584 (defn-memo hacking-4
rlm@364 585 ([] (hacking-4 (hacking-3)))
rlm@364 586 ([script]
rlm@364 587 (->> script
rlm@364 588 begin-deposit
rlm@364 589 (deposit-held-item 19 243)
rlm@364 590 (deposit-held-item-named :lemonade 16)
rlm@364 591 (deposit-held-item 18 224))))
rlm@364 592
rlm@364 593 (defn-memo hacking-5
rlm@364 594 "clean out the held-item list again"
rlm@364 595 ([] (hacking-5 (hacking-4)))
rlm@364 596 ([script]
rlm@364 597 (->> script
rlm@364 598 (to-held-items)
rlm@364 599 (toss-held-item 18 30)
rlm@364 600 (toss-held-item 17 1)
rlm@364 601 close-menu
rlm@364 602 close-menu)))
rlm@363 603
rlm@364 604 (defn-memo hacking-6
rlm@364 605 ([] (hacking-6 (hacking-5)))
rlm@364 606 ([script]
rlm@364 607 (->> script
rlm@364 608 activate-rlm-pc
rlm@364 609 begin-withdraw
rlm@364 610 (widthdraw-pc-item 4 0xFE)
rlm@364 611 (widthdraw-pc-item 5 0xFE)
rlm@365 612 (widthdraw-pc-item 6 0xFE)
rlm@365 613 close-menu)))
rlm@364 614
rlm@365 615 (defn-memo hacking-7
rlm@365 616 ([] (hacking-7 (hacking-6)))
rlm@365 617 ([script]
rlm@365 618 (->> script
rlm@365 619 begin-deposit
rlm@365 620 (deposit-held-item 19 240)
rlm@365 621 (deposit-held-item 18 230)
rlm@365 622 (deposit-held-item-named :parlyz-heal 55)
rlm@365 623 (deposit-held-item 17 184)
rlm@365 624 (deposit-held-item 17 40)
rlm@365 625 (deposit-held-item-named :TM37 71)
rlm@365 626 (deposit-held-item-named :ice-heal 55)
rlm@365 627 (deposit-held-item-named :fire-stone 23)
rlm@366 628 (deposit-held-item-named :burn-heal 12)
rlm@369 629 ;; as a special case, /don't/ close the menu.
rlm@369 630 )))
rlm@366 631
rlm@366 632 (defn-memo hacking-8
rlm@366 633 "Clear cruft away from held item list."
rlm@366 634 ([] (hacking-8 (hacking-7)))
rlm@366 635 ([script]
rlm@366 636 (->> script
rlm@366 637 to-held-items
rlm@366 638 (toss-held-item 15 1)
rlm@366 639 (toss-held-item 14 1)
rlm@366 640 (toss-held-item 13 1)
rlm@366 641 close-menu
rlm@366 642 close-menu)))
rlm@366 643
rlm@366 644 (defn-memo hacking-9
rlm@366 645 ([] (hacking-9 (hacking-8)))
rlm@366 646 ([script]
rlm@366 647 (->> script
rlm@366 648 activate-rlm-pc
rlm@366 649 begin-withdraw
rlm@366 650 (widthdraw-pc-item 7 0xFE)
rlm@366 651 (widthdraw-pc-item 8 0xFC)
rlm@366 652 (widthdraw-pc-item 8 1)
rlm@366 653 (widthdraw-pc-item 8 1)
rlm@366 654 (widthdraw-pc-item 9 0xFE)
rlm@366 655 (multiple-times
rlm@366 656 7
rlm@368 657 (partial combine-pc-items 2))
rlm@366 658 close-menu)))
rlm@366 659
rlm@366 660 (defn-memo hacking-10
rlm@366 661 ([] (hacking-10 (hacking-9)))
rlm@366 662 ([script]
rlm@366 663 (->> script
rlm@366 664 begin-deposit
rlm@366 665 (deposit-held-item 17 230)
rlm@366 666 (deposit-held-item-named :parlyz-heal 55)
rlm@366 667 (deposit-held-item 14 178)
rlm@366 668 (deposit-held-item-named :water-stone 29)
rlm@366 669 (deposit-held-item 14 32)
rlm@366 670 (deposit-held-item-named :TM18 1)
rlm@366 671 (deposit-held-item 13 1)
rlm@366 672 (deposit-held-item 13 191)
rlm@366 673 (deposit-held-item-named :TM02 98)
rlm@366 674 (deposit-held-item-named :TM09 1)
rlm@366 675 close-menu)))
rlm@366 676
rlm@366 677 (defn-memo hacking-11
rlm@366 678 ([] (hacking-11 (hacking-10)))
rlm@366 679 ([script]
rlm@366 680 (->> script
rlm@367 681 begin-withdraw
rlm@367 682 (widthdraw-pc-item 3 0xFE)
rlm@367 683 (widthdraw-pc-item 4 0xFE)
rlm@367 684 (widthdraw-pc-item 5 1)
rlm@367 685 (widthdraw-pc-item 5 1)
rlm@367 686 (widthdraw-pc-item 5 1)
rlm@367 687 (widthdraw-pc-item 5 0xFB)
rlm@367 688 (multiple-times
rlm@367 689 3
rlm@369 690 (partial combine-pc-items 2))
rlm@367 691 close-menu)))
rlm@367 692
rlm@367 693 (defn-memo hacking-12
rlm@367 694 ([] (hacking-12 (hacking-11)))
rlm@367 695 ([script]
rlm@367 696 (->> script
rlm@367 697 begin-deposit
rlm@367 698 (deposit-held-item 18 203)
rlm@367 699 (deposit-held-item-named :guard-spec 87)
rlm@367 700 (deposit-held-item-named :guard-spec 24)
rlm@367 701 (deposit-held-item-named :TM05 1)
rlm@367 702 (multiple-times
rlm@367 703 8
rlm@369 704 (partial deposit-held-item 14 1))
rlm@367 705 (deposit-held-item 14 55)
rlm@367 706 (deposit-held-item-named :x-accuracy 58)
rlm@367 707 (deposit-held-item 14 38)
rlm@367 708 (deposit-held-item-named :TM13 1)
rlm@367 709 (deposit-held-item 13 1)
rlm@367 710 (deposit-held-item 13 233)
rlm@366 711 close-menu)))
rlm@367 712
rlm@368 713 (defn-memo hacking-13
rlm@367 714 ([] (hacking-13 (hacking-12)))
rlm@367 715 ([script]
rlm@367 716 (->> script
rlm@367 717 (set-cursor-relative 1)
rlm@367 718 (select-menu-entry)
rlm@367 719 (toss-pc-item 1 1)
rlm@367 720 (toss-pc-item 0 156)
rlm@368 721 (toss-pc-item 0 11))))
rlm@368 722
rlm@368 723 (defn confirm-pattern []
rlm@368 724 (let [start-address (inc pc-item-list-start)
rlm@368 725 target-pattern (pc-item-writer-program)
rlm@368 726 actual-pattern
rlm@368 727 (subvec (vec (memory (second (hacking-13))))
rlm@368 728 start-address
rlm@368 729 (+ start-address (count target-pattern)))]
rlm@368 730 (println target-pattern)
rlm@368 731 (println actual-pattern)
rlm@368 732 (= target-pattern actual-pattern)))
rlm@368 733
rlm@368 734 (defn-memo go-to-mansion-for-the-lulz
rlm@368 735 ([] (go-to-mansion-for-the-lulz (hacking-13)))
rlm@368 736 ([script]
rlm@595 737 (let [lulz-delay 50]
rlm@595 738 (->> script
rlm@595 739 close-menu
rlm@595 740 close-menu
rlm@595 741 close-celadon-computer-menu
rlm@595 742 (walk [← ← ← ← ← ← ← ← ← ↓ ↓ ↓ ↓])
rlm@595 743 (walk (repeat 17 ←))
rlm@595 744 (walk [↑ → → → → ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
rlm@595 745 (walk [↓ ← ↑])
rlm@595 746 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@595 747 ← ← ← ← ↑ ↑ ↑ ← ↑])
rlm@595 748 (talk)
rlm@595 749 (do-nothing lulz-delay)
rlm@595 750 (play-moves [[:a]])
rlm@595 751 (do-nothing lulz-delay)
rlm@595 752 (play-moves [[:a]])
rlm@595 753 close-menu))))
rlm@367 754
rlm@368 755 (defn-memo launch-bootstrap-program
rlm@368 756 ([] (launch-bootstrap-program
rlm@368 757 (go-to-mansion-for-the-lulz)))
rlm@368 758 ([script]
rlm@368 759 (->> script
rlm@368 760 ;; must corrupt item list again by switching pokemon
rlm@369 761 activate-start-menu ;; \
rlm@369 762 (set-cursor 0) ;; |
rlm@369 763 select-menu-entry ;; |
rlm@369 764 select-menu-entry ;; |
rlm@369 765 (set-cursor 1) ;; | -- switch 9th pokemon
rlm@369 766 select-menu-entry ;; | with 4th pokemon
rlm@369 767 (set-cursor 3) ;; |
rlm@369 768 select-menu-entry ;; |
rlm@369 769 close-menu ;; /
rlm@369 770 ;; now, open items and set map-function to
rlm@369 771 ;; the program inside the item-computer.
rlm@368 772 (set-cursor 1)
rlm@368 773 (select-menu-entry)
rlm@368 774 (toss-held-item 22 12)
rlm@368 775 (switch-held-items 22 40)
rlm@368 776 close-all-menus)))
rlm@369 777
rlm@376 778 (defn regen-control-checkpoint!
rlm@376 779 [] (write-script! (launch-bootstrap-program) "control-checkpoint"))
rlm@376 780
rlm@376 781 (defn control-checkpoint []
rlm@376 782 (read-script "control-checkpoint"))
rlm@376 783
rlm@369 784 (def increasing-pattern [0x01 0x23 0x45 0x67 0x89 0xAB 0xCD 0xEF])
rlm@369 785
rlm@369 786 (defn test-pattern-writing
rlm@369 787 ([] (test-pattern-writing increasing-pattern))
rlm@369 788 ([pattern]
rlm@369 789 (let [moves (bootstrap-pattern pattern)
rlm@369 790 pattern-insertion
rlm@369 791 (->> (launch-bootstrap-program)
rlm@369 792 (play-moves
rlm@369 793 (take 100 moves)))]
rlm@369 794 (println "Input Pattern:")
rlm@369 795 (apply println (map #(format "0x%02X" %) pattern))
rlm@369 796 (println "\nMemory Listing:")
rlm@369 797 (print-listing (second pattern-insertion)
rlm@369 798 0xD162 (+ 0xD162 (count pattern)))
rlm@369 799 (= (subvec (vec (memory (second pattern-insertion)))
rlm@369 800 0xD162 (+ 0xD162 (count pattern)))
rlm@369 801 pattern))))
rlm@369 802
rlm@596 803
rlm@596 804 (defn item-writer-test-script []
rlm@596 805 [[]
rlm@596 806 (-> (second (control-checkpoint))
rlm@596 807 (set-memory-range
rlm@596 808 (inc pc-item-list-start)
rlm@596 809 (pc-item-writer-program)))])
rlm@596 810
rlm@596 811
rlm@596 812 (defn launch-main-bootstrap-program
rlm@414 813 ([] (launch-main-bootstrap-program
rlm@595 814 ;;(control-checkpoint)
rlm@596 815 ;;(launch-bootstrap-program)
rlm@596 816 (item-writer-test-script)
rlm@414 817 ))
rlm@414 818 ([script]
rlm@596 819 (->> script
rlm@596 820 (play-moves
rlm@596 821 (bootstrap-pattern (main-bootstrap-program)))
rlm@596 822 ;; I'd like to just press b here, but I can't
rlm@596 823 ;; because the smallest item with item id >= 75 is
rlm@596 824 ;; TM01, which has value 201.
rlm@596 825 ;; (* 2 (- 201 75)) == 252, which plus 1 is 253 here :(
rlm@596 826 ;;(play-moves [[:b]])
rlm@596 827 (take 253 (interleave (repeat 1000 [:b])
rlm@596 828 (repeat 1000 []))))))
rlm@596 829
rlm@541 830 (def bootstrap-start pokemon-list-start)
rlm@369 831
rlm@415 832 (defn test-main-bootstrap-integrety
rlm@415 833 []
rlm@415 834 (assert
rlm@415 835 (= (main-bootstrap-program)
rlm@541 836 (subvec
rlm@541 837 (vec (memory (second (launch-main-bootstrap-program))))
rlm@541 838 pokemon-list-start
rlm@541 839 (+ pokemon-list-start (count (main-bootstrap-program)))))))
rlm@415 840
rlm@414 841 (defn set-target-address
rlm@414 842 "Assumes that the game is under control of the main-bootstrap
rlm@414 843 program in MODE-SELECT mode, and sets the target address to which
rlm@414 844 jumps/writes will occur."
rlm@414 845 [target-address script]
rlm@414 846 (let [[target-high target-low] (disect-bytes-2 target-address)]
rlm@414 847 (->> script
rlm@414 848 (play-moves
rlm@414 849 (map buttons
rlm@414 850 [set-H-mode target-high 0x00
rlm@414 851 set-L-mode target-low 0x00])))))
rlm@416 852
rlm@416 853 (defn write-RAM-segment
rlm@416 854 "Assumes that the game is under control of the main-bootstrap
rlm@416 855 program in MODE-SELECT mode and that target-address has been
rlm@416 856 appropriately set, and writes 255 bytes or less to RAM."
rlm@416 857 [segment script]
rlm@416 858 (->> script
rlm@416 859 (play-moves
rlm@416 860 (map buttons
rlm@416 861 [write-mode (count segment)]))
rlm@416 862 (play-moves (map buttons segment))
rlm@416 863 (play-moves [[]])))
rlm@416 864
rlm@414 865 (defn write-RAM
rlm@414 866 "Assumes that the game is under control of the main-bootstrap
rlm@414 867 program in MODE-SELECT mode, and rewrites RAM starting at
rlm@414 868 'start-address with 'new-ram."
rlm@414 869 [start-address new-ram script]
rlm@416 870 (loop [s (set-target-address start-address script)
rlm@416 871 to-write new-ram]
rlm@416 872 (if (< (count to-write) 0x100)
rlm@416 873 (write-RAM-segment to-write s)
rlm@416 874 (recur
rlm@416 875 (write-RAM-segment (take 0xFF to-write) s)
rlm@416 876 (drop 0xFF to-write)))))
rlm@416 877
rlm@414 878 (defn transfer-control
rlm@414 879 "Assumes that the game is under control of the main-bootstrap
rlm@414 880 program in MODE-SELECT mode, and jumps to the target-address."
rlm@414 881 [target-address script]
rlm@414 882 (->> script
rlm@414 883 (set-target-address target-address)
rlm@414 884 (play-moves [(buttons jump-mode)])))
rlm@414 885
rlm@541 886
rlm@541 887 (def relocated-bootstrap-start
rlm@541 888 (+ 90 pokemon-box-1-address))
rlm@416 889
rlm@416 890 (defn-memo relocate-main-bootstrap
rlm@414 891 ([] (relocate-main-bootstrap (launch-main-bootstrap-program)))
rlm@414 892 ([script]
rlm@541 893 (->> script
rlm@541 894 (do-nothing 2)
rlm@541 895 (write-RAM
rlm@541 896 relocated-bootstrap-start
rlm@541 897 (main-bootstrap-program
rlm@541 898 relocated-bootstrap-start))
rlm@541 899 (do-nothing 1)
rlm@541 900 (transfer-control relocated-bootstrap-start)
rlm@541 901 (do-nothing 1))))
rlm@414 902
rlm@417 903 (defn gen-new-kernel-checkpoint! []
rlm@417 904 (write-script! (do-nothing 10 (relocate-main-bootstrap))
rlm@417 905 "new-kernel"))
rlm@417 906
rlm@417 907 (defn new-kernel [] (read-script "new-kernel"))
rlm@417 908
rlm@414 909 (def mid-game-data
rlm@414 910 (subvec (vec (memory (mid-game)))
rlm@414 911 pokemon-list-start
rlm@416 912 (+ pokemon-list-start 697)))
rlm@414 913
rlm@414 914 (def mid-game-map-address 0x46BC)
rlm@414 915
rlm@417 916 (defn-memo set-mid-game-data
rlm@414 917 ([] (set-mid-game-data (relocate-main-bootstrap)))
rlm@414 918 ([script]
rlm@414 919 (->> script
rlm@415 920 (do-nothing 10)
rlm@416 921 (write-RAM pokemon-list-start
rlm@416 922 mid-game-data))))
rlm@416 923 (defn test-set-data
rlm@416 924 ([] (test-set-data (relocate-main-bootstrap)))
rlm@416 925 ([script]
rlm@416 926 (->> script
rlm@416 927 (do-nothing 10)
rlm@416 928 (write-RAM pokemon-list-start
rlm@416 929 (repeat 500 0xCC)))))
rlm@416 930
rlm@416 931 (defn test-mid-game-transfer []
rlm@416 932 (= (subvec (vec (memory (second (set-mid-game-data))))
rlm@416 933 pokemon-list-start
rlm@416 934 (+ pokemon-list-start 500))
rlm@416 935 (subvec (vec (memory (mid-game)))
rlm@416 936 pokemon-list-start
rlm@416 937 (+ pokemon-list-start 500))))
rlm@415 938
rlm@417 939 (defn-memo return-to-pokemon-kernel
rlm@416 940 ([] (return-to-pokemon-kernel (set-mid-game-data)))
rlm@416 941 ([script]
rlm@416 942 (let [scratch (+ 200 pokemon-box-1-address)
rlm@416 943 return-program
rlm@416 944 (flatten
rlm@416 945 [0xFB
rlm@416 946 0xC3
rlm@416 947 (reverse (disect-bytes-2 mid-game-map-address))])]
rlm@416 948 (->> script
rlm@416 949 (write-RAM scratch return-program)
rlm@416 950 (transfer-control scratch)
rlm@416 951 (do-nothing 1)))))
rlm@416 952
rlm@416 953
rlm@414 954
rlm@414 955
rlm@414 956