Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_1.clj @ 407:03ade2a04458

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