diff clojure/com/aurellem/run/bootstrap_1.clj @ 372:998702f021e3

merged changes
author Dylan Holmes <ocsenave@gmail.com>
date Mon, 09 Apr 2012 01:44:19 -0500
parents 8d8023057b3c
children 79252378fd22
line wrap: on
line diff
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/clojure/com/aurellem/run/bootstrap_1.clj	Mon Apr 09 01:44:19 2012 -0500
     1.3 @@ -0,0 +1,570 @@
     1.4 +(ns com.aurellem.run.bootstrap-1
     1.5 +  (:use (com.aurellem.gb saves gb-driver util
     1.6 +                         items vbm characters money))
     1.7 +  (:use (com.aurellem.run util title save-corruption bootstrap-0))
     1.8 +  (:use (com.aurellem.exp item-bridge))
     1.9 +  (:import [com.aurellem.gb.gb_driver SaveState]))
    1.10 +
    1.11 +(defn pc-item-writer-program
    1.12 +  []
    1.13 +  (let [limit 201
    1.14 +        [target-high target-low] (disect-bytes-2 0xD162)]
    1.15 +    (flatten
    1.16 +     [[0x00  ;; (item-hack) set increment stack pointer no-op
    1.17 +       0x1E  ;; load limit into E
    1.18 +       limit
    1.19 +       0x3F  ;; (item-hack) set carry flag no-op
    1.20 +
    1.21 +       ;; load 2 into C.
    1.22 +       0x0E   ;; C == 1 means input-first nybble
    1.23 +       0x04   ;; C == 0 means input-second nybble
    1.24 +
    1.25 +       0x21 ;; load target into HL
    1.26 +       target-low
    1.27 +       target-high
    1.28 +       0x37 ;; (item-hack) set carry flag no-op
    1.29 +
    1.30 +       0x00 ;; (item-hack) no-op
    1.31 +       0x37 ;; (item-hack) set carry flag no-op
    1.32 +       
    1.33 +       0x00 ;; (item-hack) no-op
    1.34 +       0xF3 ;; disable interrupts
    1.35 +       ;; Input Section
    1.36 +
    1.37 +       0x3E ;; load 0x20 into A, to measure buttons
    1.38 +       0x10 
    1.39 +
    1.40 +       0x00 ;; (item-hack) no-op
    1.41 +       0xE0 ;; load A into [FF00]
    1.42 +       0x00
    1.43 +
    1.44 +       0xF0 ;; load 0xFF00 into A to get
    1.45 +       0x00 ;; button presses
    1.46 +       
    1.47 +       0xE6
    1.48 +       0x0F ;; select bottom four bits of A
    1.49 +       0x37 ;; (item-hack) set carry flag no-op
    1.50 +
    1.51 +       0x00 ;; (item-hack) no-op
    1.52 +       0xB8 ;; see if input is different (CP A B)
    1.53 +
    1.54 +       0x00 ;; (item-hack) (INC SP)
    1.55 +       0x28 ;; repeat above steps if input is not different
    1.56 +       ;; (jump relative backwards if B != A)
    1.57 +       0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)
    1.58 +
    1.59 +       0x47 ;; load A into B
    1.60 +       
    1.61 +       0x0D ;; dec C
    1.62 +       0x37 ;; (item-hack) set-carry flag
    1.63 +       ;; branch based on C:
    1.64 +       0x20 ;; JR NZ
    1.65 +       23 ;; skip "input second nybble" and "jump to target" below
    1.66 +       
    1.67 +       ;; input second nybble
    1.68 +
    1.69 +       0x0C ;; inc C
    1.70 +       0x0C ;; inc C
    1.71 +
    1.72 +       0x00 ;; (item-hack) no-op
    1.73 +       0xE6 ;; select bottom bits
    1.74 +       0x0F
    1.75 +       0x37 ;; (item-hack) set-carry flag no-op
    1.76 +
    1.77 +       0x00 ;; (item-hack) no-op
    1.78 +       0xB2 ;; (OR A D) -> A
    1.79 +
    1.80 +       0x22 ;; (do (A -> (HL)) (INC HL))
    1.81 +
    1.82 +       0x1D ;; (DEC E)
    1.83 +
    1.84 +       0x00 ;; (item-hack) 
    1.85 +       0x20 ;; jump back to input section if not done
    1.86 +       0xDA ;; literal -36 == TM 18 (counter)
    1.87 +       0x01 ;; (item-hack) set BC to literal (no-op)
    1.88 +
    1.89 +       ;; jump to target
    1.90 +       0x00  ;; (item-hack) these two bytes can be anything.
    1.91 +       0x01 
    1.92 +
    1.93 +       0x00   ;; (item-hack) no-op
    1.94 +       0xBF   ;; (CP A A) ensures Z
    1.95 +       
    1.96 +       0xCA   ;; (item-hack) jump if Z
    1.97 +       target-low
    1.98 +       target-high
    1.99 +       0x01   ;; (item-hack) will never be reached.
   1.100 +       
   1.101 +       ;; input first nybble
   1.102 +       0x00
   1.103 +       0xCB
   1.104 +       0x37  ;; swap nybbles on A
   1.105 +
   1.106 +       0x57  ;; A -> D
   1.107 +
   1.108 +       0x37  ;; (item-hack) set carry flag no-op
   1.109 +       0x18  ;; relative jump backwards
   1.110 +       0xCD  ;; literal -51 == TM05; go back to input section
   1.111 +       0x01  ;; (item-hack) will never reach this instruction
   1.112 +
   1.113 +       ]
   1.114 +      (repeat 8 [0x00 0x01])
   1.115 +
   1.116 +      [;; jump to actual program
   1.117 +       0x00
   1.118 +       0x37  ;; (item-hack) set carry flag no-op
   1.119 +
   1.120 +       0x2E  ;; 0x3A -> L
   1.121 +       0x3A
   1.122 +
   1.123 +
   1.124 +       0x00  ;; (item-hack) no-op
   1.125 +       0x26  ;; 0xD5 -> L
   1.126 +       0xD5  
   1.127 +       0x01  ;; (item-hack) set-carry BC
   1.128 +
   1.129 +       0x00  ;; (item-hack) these can be anything
   1.130 +       0x01  
   1.131 +
   1.132 +       0x00
   1.133 +       0xE9 ;; jump to (HL)
   1.134 +       ]])))
   1.135 +
   1.136 +(defn view-desired-item-layout []
   1.137 +  (clojure.pprint/pprint
   1.138 +   (raw-inventory->inventory (pc-item-writer-program))))
   1.139 +
   1.140 +(defn pc-item-writer-state []
   1.141 +    (-> (read-state "bootstrap-init")
   1.142 +      (set-memory pc-item-list-start 50)
   1.143 +      (set-memory-range
   1.144 +       map-function-address-start
   1.145 +       [0x8B 0xD5])
   1.146 +      (set-memory-range
   1.147 +       (inc pc-item-list-start)
   1.148 +       (pc-item-writer-program))))
   1.149 +
   1.150 +(defn test-pc-item-writer []
   1.151 +  (let [orig (read-state "pc-item-writer")]
   1.152 +    (-> orig
   1.153 +    (print-listing 0xD162 (+ 0xD162 20))
   1.154 +    (run-moves (reduce concat
   1.155 +                (repeat 10 [[:a :b :start :select] []])))
   1.156 +    ((fn [_] (println "===========") _))
   1.157 +    (print-listing 0xD162 (+ 0xD162 20)))))
   1.158 +
   1.159 +(defn close-all-menus [[moves state :as script]]
   1.160 +  (loop [s script]
   1.161 +    (let [depth (current-depth (second (do-nothing 50 s)))]
   1.162 +      (println "depth" depth)
   1.163 +      (if (= depth 1)
   1.164 +        s
   1.165 +        (recur (close-menu s))))))
   1.166 +
   1.167 +(defn-memo name-rival
   1.168 +  ([] (name-rival (to-rival-name)))
   1.169 +  ([script]
   1.170 +     (->> script
   1.171 +          (first-difference [] [:a] AF)
   1.172 +          (first-difference [] [:r] DE)
   1.173 +          (play-moves
   1.174 +           [[]
   1.175 +            [] [] [:r] [] [:d] [:a]           ;; L
   1.176 +            [:r] [] [:r] [] [:r] [] [:r] [] 
   1.177 +            [:r] [] [:d] [] [:d] [:a]         ;; [PK]
   1.178 +            [:d] [] [:r] [:a]
   1.179 +            ]))))
   1.180 +
   1.181 +(defn-memo to-room-pc
   1.182 +  ([] (to-room-pc (name-rival)))
   1.183 +  ([script]
   1.184 +     (->> script
   1.185 +          finish-title
   1.186 +          (walk [← ← ↑ ← ↑ ↑ ↑]))))
   1.187 +
   1.188 +(defn-memo bootstrap-corrupt-save
   1.189 +  ([] (bootstrap-corrupt-save (to-room-pc)))
   1.190 +  ([script]
   1.191 +   (->> script
   1.192 +        (do-save-corruption 2)
   1.193 +        (corrupt-item-list 0)
   1.194 +        close-all-menus)))
   1.195 +
   1.196 +(defn-memo begin-initial-deposits
   1.197 +  ([] (begin-initial-deposits
   1.198 +       (bootstrap-corrupt-save)))
   1.199 +  ([script]
   1.200 +     (->> script
   1.201 +          (first-difference [] [:a] AF)
   1.202 +          (scroll-text)
   1.203 +          (set-cursor 1)
   1.204 +          select-menu-entry)))
   1.205 +
   1.206 +(defn wait-for-quantity
   1.207 +  [[moves state :as script]]
   1.208 +  (if (not= (item-quantity-selected state) 1)
   1.209 +    (repeat-until-different [] item-quantity-selected script)
   1.210 +    script))
   1.211 +
   1.212 +(defn wait-for-cursor
   1.213 +  [[moves state :as script]]
   1.214 +  (if (not= (list-offset state) 0)
   1.215 +    (repeat-until-different [] list-offset script)
   1.216 +    script))
   1.217 +
   1.218 +(defn deposit-held-item [n quantity [moves state :as script]]
   1.219 +  (let [total-quantity (second (nth-item state n))]
   1.220 +    (println "total-quantity" total-quantity)
   1.221 +    (->> script
   1.222 +         (set-cursor n)
   1.223 +         (select-menu-entry 1)
   1.224 +         (wait-for-quantity)
   1.225 +         (set-quantity total-quantity quantity)
   1.226 +         (delayed-difference [] [:a] 100 #(search-string % "stored"))
   1.227 +         (scroll-text))))
   1.228 +
   1.229 +(defn sell-held-item [n quantity [moves state :as script]]
   1.230 +  (let [total-quantity (second (nth-item state n))]
   1.231 +    (->> script
   1.232 +         (wait-for-cursor)  ;; when selling, the cursor always
   1.233 +         (set-cursor n)     ;; returns to the top of the list.
   1.234 +         (select-menu-entry 1)
   1.235 +         (wait-for-quantity)
   1.236 +         (set-quantity total-quantity quantity)
   1.237 +         (delayed-difference [] [:a] 100 current-depth)
   1.238 +         (play-moves (repeat 20 [:b]))
   1.239 +         (delayed-difference [] [:a] 100 #(search-string % "What"))
   1.240 +         )))
   1.241 +
   1.242 +(defn widthdraw-pc-item [n quantity [moves state :as script]]
   1.243 +  (let [total-quantity (second (nth-pc-item state n))]
   1.244 +    (->> script
   1.245 +         (set-cursor n)
   1.246 +         (select-menu-entry 1)
   1.247 +         (wait-for-quantity)
   1.248 +         (set-quantity total-quantity quantity)
   1.249 +         (delayed-difference [] [:a] 100 #(search-string % "Withdrew"))
   1.250 +         (scroll-text))))
   1.251 +
   1.252 +(defn toss-held-item [n quantity [moves state :as script]]
   1.253 +  (let [total-quantity (second (nth-item state n))]
   1.254 +    (->> script
   1.255 +         (set-cursor n)
   1.256 +         (select-menu-entry 1)
   1.257 +         (set-cursor-relative 1)
   1.258 +         (select-menu-entry -1)
   1.259 +         (wait-for-quantity)
   1.260 +         (set-quantity total-quantity quantity)
   1.261 +         (play-moves [[:a]])
   1.262 +         (scroll-text)
   1.263 +         (delayed-difference [] [:a] 100 #(search-string % "Threw"))
   1.264 +         (scroll-text)
   1.265 +         )))
   1.266 +
   1.267 +(defn buy-item [n quantity [moves state :as script]]
   1.268 +  (->> script
   1.269 +       (set-cursor n)
   1.270 +       (purchase-item quantity)))
   1.271 +
   1.272 +
   1.273 +(def desired-zero-quantities
   1.274 +  (map second (filter (comp (partial = 0) first)
   1.275 +                      (partition 2 (pc-item-writer-program)))))
   1.276 +  
   1.277 +(defn-memo initial-deposits
   1.278 +  ([] (initial-deposits (begin-initial-deposits)))
   1.279 +  ([script]
   1.280 +     (->> script
   1.281 +          (deposit-held-item 0 0x1)
   1.282 +          ((fn [script]
   1.283 +             (reduce 
   1.284 +              (fn [script item] (deposit-held-item item 0xFF script))
   1.285 +              script
   1.286 +              (range 3 (+ 13 3)))))
   1.287 +          close-all-menus)))
   1.288 +
   1.289 +
   1.290 +(defn-memo prepare-celadon-warp
   1.291 +  ([] (prepare-celadon-warp (initial-deposits)))
   1.292 +  ([script]
   1.293 +     (->> script
   1.294 +          (activate-start-menu)
   1.295 +          (set-cursor-relative 1)
   1.296 +          (select-menu-entry)
   1.297 +          (toss-held-item 35 0xFA)
   1.298 +          (close-all-menus))))
   1.299 +
   1.300 +
   1.301 +;;0 -- 256
   1.302 +;;1 -- 254
   1.303 +;;2 -- 254
   1.304 +;;3 -- 255
   1.305 +
   1.306 +(defn-memo restore-items
   1.307 +  ([] (restore-items (prepare-celadon-warp)))
   1.308 +  ([script]
   1.309 +     (->> script
   1.310 +          (first-difference [] [:a] AF)
   1.311 +          (scroll-text)
   1.312 +          (select-menu-entry)
   1.313 +          (widthdraw-pc-item 0 1)
   1.314 +          ;;(widthdraw-pc-item 0 99)
   1.315 +          ;;(widthdraw-pc-item 1 1)
   1.316 +          (widthdraw-pc-item 13 255)
   1.317 +          (close-all-menus))))
   1.318 +
   1.319 +(defn-memo to-celadon
   1.320 +  ([] (to-celadon (restore-items)))
   1.321 +  ([script]
   1.322 +     (->> script
   1.323 +          (walk [→ → → → → → → ↑
   1.324 +                 ↓ ↓ ↓ ↓ ↓ ← ← ← ←
   1.325 +                 ↓ ↓]))))
   1.326 +
   1.327 +
   1.328 +;; celadon store inventory
   1.329 +
   1.330 +;; Floor 2
   1.331 +;;=====================================
   1.332 +;; Great Ball        TM32 (double-team)
   1.333 +;; Super Potion      TM33 (reflect)
   1.334 +;; Revive            TM02 (razor-wind)
   1.335 +;; Super Repel       TM07 (horn-drill)
   1.336 +;; Antidote          TM37 (egg-bomb)
   1.337 +;; Burn Heal         TM01 (mega-punch)
   1.338 +;; Ice Heal          TM05 (mega-kick)
   1.339 +;; Awakening         TM09 (take-down)
   1.340 +;; Parlyz Heal       TM17 (submission)
   1.341 +
   1.342 +
   1.343 +;; Floor 3
   1.344 +;;=====================================       
   1.345 +;; TM18 (counter)
   1.346 +
   1.347 +
   1.348 +;; Floor 4
   1.349 +;;=====================================
   1.350 +;; Poke Doll
   1.351 +;; Fire Stone
   1.352 +;; Thunder Stone
   1.353 +;; Water Stone
   1.354 +;; Leaf Stone
   1.355 +
   1.356 +;; Floor 5
   1.357 +;;=====================================
   1.358 +;; X Accuracy         HP UP
   1.359 +;; Guard Spec.        Protein
   1.360 +;; Dire Hit           Iron
   1.361 +;; X Attack           Carbos
   1.362 +;; X Defend           Calcium
   1.363 +;; X Speed            
   1.364 +;; X Special
   1.365 +
   1.366 +;; Roof
   1.367 +;;=====================================
   1.368 +;; Fresh Water        TM13 (ice-beam)
   1.369 +;; Soda Pop           TM48 (rock-slide)
   1.370 +;; Lemonade :)        TM49 (tri-attack)
   1.371 +
   1.372 +
   1.373 +(defn-memo go-to-floor-two
   1.374 +  ([] (go-to-floor-two (to-celadon)))
   1.375 +  ([script]
   1.376 +     (->> script
   1.377 +          (walk [↑ → → → → → → → → → → →
   1.378 +                 ↑ ↑ ↑ ↑ ↑ ↑
   1.379 +                 ← ← ← ← 
   1.380 +                 ↓ ↓ ↓
   1.381 +                 ← ←])
   1.382 +          (first-difference [] ↑ AF))))
   1.383 +
   1.384 +(defn talk
   1.385 +  "Assumes that you are facing something that initiates text and
   1.386 +   causes it to do so."
   1.387 +  [script]
   1.388 +  (->> script
   1.389 +       (delayed-difference [] [:a] 100
   1.390 +                           #(aget (memory %) text-address))))
   1.391 +
   1.392 +(defn-memo get-money-floor-two
   1.393 +  ([] (get-money-floor-two (go-to-floor-two)))
   1.394 +  ([script]
   1.395 +     (->> script
   1.396 +          talk
   1.397 +          (set-cursor 1)
   1.398 +          (select-menu-entry)
   1.399 +          (sell-held-item 0 1)
   1.400 +          (sell-held-item 0 1)
   1.401 +          (close-menu))))
   1.402 +
   1.403 +(defn-memo floor-two-TMs
   1.404 +  ([] (floor-two-TMs (get-money-floor-two)))
   1.405 +  ([script]
   1.406 +     (->> script
   1.407 +          (wait-for-cursor)
   1.408 +          (select-menu-entry)
   1.409 +          (buy-item 2 98)  ;; TM02 (razor-wind)
   1.410 +          (buy-item 4 71)  ;; TM37 (doubleteam)
   1.411 +          (buy-item 5 63)  ;; TM01 (mega-punch)
   1.412 +          (buy-item 6 1)   ;; TM05 (mega-kick)
   1.413 +          (buy-item 7 56)  ;; TM09 (take-down)
   1.414 +          (close-menu))))
   1.415 +
   1.416 +(defn end-shop-conversation
   1.417 +  [script]
   1.418 +  (->> script
   1.419 +       (wait-until scroll-text [:b])
   1.420 +       (play-moves [[] [:b]])
   1.421 +       close-menu))
   1.422 +
   1.423 +(defn-memo floor-two-more-money
   1.424 +  ([] (floor-two-more-money (floor-two-TMs)))
   1.425 +  ([script]
   1.426 +     (->> script
   1.427 +          (wait-for-cursor)
   1.428 +          (set-cursor 1)
   1.429 +          (select-menu-entry)
   1.430 +          (sell-held-item 0 1)
   1.431 +          (sell-held-item 0 1)
   1.432 +          close-menu
   1.433 +          end-shop-conversation)))
   1.434 +
   1.435 +(defn turn [direction script]
   1.436 +  (->> script
   1.437 +       (first-difference [] direction AF)))
   1.438 +
   1.439 +(defn-memo floor-two-items
   1.440 +  ([] (floor-two-items (floor-two-more-money)))
   1.441 +  ([script]
   1.442 +     (->> script
   1.443 +          (walk [←])
   1.444 +          (turn ↑)
   1.445 +          talk
   1.446 +          select-menu-entry
   1.447 +          (buy-item 5 12)  ;; burn heal
   1.448 +          (buy-item 6 55)  ;; ice heal
   1.449 +          (buy-item 7 4)   ;; awakening
   1.450 +          (buy-item 8 99)  ;; parlyz heal
   1.451 +          (buy-item 8 55)  ;; parlyz heal
   1.452 +          close-menu
   1.453 +          end-shop-conversation)))
   1.454 +
   1.455 +(defn-memo go-to-floor-three
   1.456 +  ([] (go-to-floor-three (floor-two-items)))
   1.457 +  ([script]
   1.458 +     (->> script
   1.459 +          (walk [→ → → → → → → → → → ↑ ↑ ↑
   1.460 +                   → ↑]))))
   1.461 +(defn-memo get-TM18
   1.462 +  ([] (get-TM18 (go-to-floor-three)))
   1.463 +  ([script]
   1.464 +     (->> script
   1.465 +          (walk [↓ ↓])
   1.466 +          talk
   1.467 +          (scroll-text 3)
   1.468 +          end-text)))
   1.469 +
   1.470 +(defn-memo go-to-floor-four
   1.471 +  ([] (go-to-floor-four (get-TM18)))
   1.472 +  ([script]
   1.473 +     (->> script
   1.474 +          (walk [← ← ← ← ↑ ↑
   1.475 +                 ↓ ← ← ↓ ↓ ↓
   1.476 +                 ← ← ← ← ←])
   1.477 +          (turn ↓))))
   1.478 +
   1.479 +(defn-memo floor-four-items
   1.480 +  ([] (floor-four-items (go-to-floor-four)))
   1.481 +  ([script]
   1.482 +     (->> script
   1.483 +          talk
   1.484 +          select-menu-entry
   1.485 +          (buy-item 1 23)  ;; Fire Stone
   1.486 +          (buy-item 2 98)  ;; Thunder Stone
   1.487 +          (buy-item 3 29)  ;; Water Stone
   1.488 +          close-menu
   1.489 +          end-shop-conversation)))
   1.490 +
   1.491 +(defn-memo go-to-floor-five
   1.492 +  ([] (go-to-floor-five (floor-four-items)))
   1.493 +  ([script]
   1.494 +     (->> script
   1.495 +          (walk [→ → → → → →
   1.496 +                 ↑ ↑ ↑
   1.497 +                 → → → → → ↑ ;; leave floor four
   1.498 +                 ↓ ← ← ← ← ← ← ← ←
   1.499 +                 ↓ ↓ ↓ ← ← ← ]);; go to five's clerk
   1.500 +          (turn ↑))))
   1.501 +                
   1.502 +(defn-memo floor-five-items
   1.503 +  ([] (floor-five-items (go-to-floor-five)))
   1.504 +  ([script]
   1.505 +     (->> script
   1.506 +          talk
   1.507 +          select-menu-entry
   1.508 +          (buy-item 0 58)   ;; X-Accuracy
   1.509 +          (buy-item 1 99)   ;; Guard Spec.
   1.510 +          (buy-item 1 24)   ;; Guard Spec.
   1.511 +          close-menu
   1.512 +          end-shop-conversation)))
   1.513 +
   1.514 +(defn-memo go-to-roof
   1.515 +  ([] (go-to-roof (floor-five-items)))
   1.516 +  ([script]
   1.517 +     (->> script
   1.518 +          (walk [→ → → → ↑ ↑ ↑ → → → ↑ ;; leave floor five
   1.519 +                 ↓ ← ← ←]) ;; walk to vending machine
   1.520 +          (turn ↑))))
   1.521 +
   1.522 +(defn buy-drink
   1.523 +  "Assumes you're in front of the vending machine. Buys the indicated
   1.524 +   drink."
   1.525 +  [n script]
   1.526 +  (->> script
   1.527 +       (do-nothing 20)
   1.528 +       (play-moves [[:a][:a]])
   1.529 +       scroll-text
   1.530 +       (wait-for-cursor)
   1.531 +       (set-cursor n)
   1.532 +       select-menu-entry
   1.533 +       close-menu))
   1.534 +
   1.535 +(defn-memo roof-drinks
   1.536 +  ([] (roof-drinks (go-to-roof)))
   1.537 +  ([script]
   1.538 +     (->> script
   1.539 +          (buy-drink 0) ;; fresh water (for TM13)
   1.540 +          ;; buy 16 lemonades
   1.541 +          ;; LEMONADE is the best item <3  :)
   1.542 +          (multiple-times 16 (partial buy-drink 2)))))
   1.543 +
   1.544 +(defn-memo get-TM13
   1.545 +  ([] (get-TM13 (roof-drinks)))
   1.546 +  ([script]
   1.547 +     (->> script
   1.548 +          (walk [← ← ← ← ← ← ↓])
   1.549 +          (play-moves [[][:a][:a][]])
   1.550 +          (scroll-text 3)
   1.551 +          select-menu-entry
   1.552 +          select-menu-entry
   1.553 +          (scroll-text 6)
   1.554 +          close-menu)))
   1.555 +
   1.556 +(defn to-celadon-poke-center
   1.557 +  ([] (to-celadon-poke-center (get-TM13)))
   1.558 +  ([script]
   1.559 +     (->> script
   1.560 +          (walk [↑ → → → → → → → → → ↑])       ; leave roof
   1.561 +          (walk [↓ ← ← ← ← ↓ ↓ ↓ ← ← ← ← ← 
   1.562 +                 ↑ ↑ ↑ ← ← ↑])                 ; to elevator
   1.563 +                 
   1.564 +          (walk [→ → ↑ ↑])                     ; to controls
   1.565 +          talk
   1.566 +          select-menu-entry                    ; to floor 1
   1.567 +          (walk [↓ ↓ ← ←])
   1.568 +          (walk [↓ → ↓ ↓ ↓ ↓ ↓ ↓])             ; leave store
   1.569 +          (walk [↓ → → → → → → → → → → ↑ ↑])
   1.570 +          (walk (repeat 23 →))
   1.571 +          (walk [↑ ↑ ↑ ↑])                     ; enter poke center
   1.572 +          (walk [↑ ↑ ↑ → → → → → → → → → →])   ; to computer
   1.573 +          (turn ↑))))