Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_1.clj @ 376:7c89fe478de4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
modifying dylan's assembly bootstrap program so that my primitive item-writer program can write it to memory.
author Robert McIntyre <rlm@mit.edu>
date Wed, 11 Apr 2012 09:14:51 -0500
parents abcc522a3242
children 1f14c1b8af7e
rev   line source
rlm@345 1 (ns com.aurellem.run.bootstrap-1
rlm@345 2 (:use (com.aurellem.gb saves gb-driver util
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@345 11 [target-high target-low] (disect-bytes-2 0xD162)]
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