Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_1.clj @ 414:0162dd315814

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