Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_1.clj @ 536:c2ee7222a3c4

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