Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_0.clj @ 271:3266bd0a6300

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
script: went back to viridian store.
author Robert McIntyre <rlm@mit.edu>
date Tue, 27 Mar 2012 00:33:07 -0500
parents 49096b8b99d5
children 210b465e4720
rev   line source
rlm@247 1 (ns com.aurellem.run.bootstrap-0
rlm@260 2 (:use (com.aurellem.gb gb-driver vbm characters))
rlm@250 3 (:use (com.aurellem.run title save-corruption))
rlm@264 4 (:use (com.aurellem.exp item-bridge))
rlm@264 5 (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@247 6
rlm@250 7 (defn-memo boot-root []
rlm@255 8 [ [] (root)])
rlm@247 9
rlm@255 10 (defn-memo to-rival-name
rlm@255 11 ([] (to-rival-name (boot-root)))
rlm@255 12 ([script]
rlm@255 13 (-> script
rlm@255 14 title
rlm@255 15 oak
rlm@255 16 name-entry-rlm
rlm@255 17 scroll-text
rlm@255 18 scroll-text
rlm@255 19 scroll-text
rlm@255 20 scroll-text
rlm@255 21 scroll-text
rlm@255 22 )))
rlm@247 23
rlm@255 24 (defn-memo name-rival-bootstrap
rlm@255 25 ([] (name-rival-bootstrap (to-rival-name)))
rlm@255 26 ([script]
rlm@255 27 (->> script
rlm@255 28 (advance [] [:a])
rlm@255 29 (advance [] [:r] DE)
rlm@255 30 (play-moves
rlm@255 31 [[]
rlm@255 32 [:r] [] [:r] [] [:r] [] [:r] []
rlm@255 33 [:r] [] [:r] [] [:r] [] [:d] []
rlm@255 34 [:d] [:a] ;; space
rlm@255 35 [:l] [] [:d] [:a] ;; [PK]
rlm@255 36 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
rlm@255 37 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
rlm@255 38 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
rlm@255 39 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
rlm@247 40
rlm@255 41 [:d] [] [:r] [:a] ;; finish
rlm@255 42 ]))))
rlm@255 43
rlm@255 44 (defn walk
rlm@255 45 "Move the character along the given directions."
rlm@255 46 [directions script]
rlm@255 47 (reduce (fn [script direction]
rlm@255 48 (move direction script))
rlm@255 49 script directions))
rlm@255 50
rlm@255 51 (def ↑ [:u])
rlm@255 52 (def ↓ [:d])
rlm@255 53 (def ← [:l])
rlm@255 54 (def → [:r])
rlm@255 55
rlm@255 56 (defn-memo leave-house
rlm@255 57 ([] (leave-house (name-rival-bootstrap)))
rlm@255 58 ([script]
rlm@255 59 (->> script
rlm@255 60 finish-title
rlm@255 61 start-walking
rlm@255 62 walk-to-stairs
rlm@255 63 walk-to-door
rlm@255 64 (walk [↓ ↓]))))
rlm@255 65
rlm@255 66 (defn-memo to-pallet-town-edge
rlm@255 67 ([] (to-pallet-town-edge (leave-house)))
rlm@255 68 ([script]
rlm@255 69 (->> script
rlm@255 70 start-walking
rlm@255 71 (walk [→ → → → →
rlm@255 72 ↑ ↑ ↑ ↑ ↑ ↑]))))
rlm@255 73
rlm@257 74 (defn end-text [script]
rlm@257 75 (->> script
rlm@257 76 (scroll-text)
rlm@257 77 (play-moves [[] [:a]])))
rlm@257 78
rlm@257 79 (defn-memo start-pikachu-battle
rlm@257 80 ([] (start-pikachu-battle
rlm@257 81 (to-pallet-town-edge)))
rlm@257 82 ([script]
rlm@257 83 (->> script
rlm@257 84 (advance [:b] [:b :a] DE)
rlm@257 85 (scroll-text)
rlm@257 86 (play-moves [[:b]])
rlm@257 87 (scroll-text)
rlm@257 88 (end-text) ;; battle begins
rlm@257 89 (scroll-text))))
rlm@257 90
rlm@257 91 (defn-memo capture-pikachu
rlm@257 92 ([] (capture-pikachu (start-pikachu-battle)))
rlm@257 93 ([script]
rlm@257 94 (->> script
rlm@257 95 (scroll-text 2)
rlm@257 96 (end-text))))
rlm@257 97
rlm@257 98 (defn-memo go-to-lab
rlm@257 99 ([] (go-to-lab (capture-pikachu)))
rlm@257 100 ([script]
rlm@257 101 (->> script
rlm@257 102 (scroll-text 5)
rlm@257 103 (end-text)
rlm@257 104 (scroll-text)
rlm@257 105 (end-text)
rlm@257 106 (scroll-text 8)
rlm@257 107 (end-text)
rlm@257 108 (scroll-text)
rlm@257 109 (end-text))))
rlm@257 110
rlm@257 111 (defn-memo obtain-pikachu
rlm@257 112 ([] (obtain-pikachu (go-to-lab)))
rlm@257 113 ([script]
rlm@257 114 (->> script
rlm@257 115 (scroll-text)
rlm@257 116 (play-moves
rlm@257 117 (concat
rlm@257 118 (repeat 51 [])
rlm@257 119 [[:a] []]))
rlm@257 120 (walk [↓ ↓ → → ↑])
rlm@258 121 (play-moves
rlm@258 122 (concat [[] [:a]]
rlm@258 123 (repeat 100 [])))
rlm@258 124 (scroll-text 9)
rlm@258 125 (end-text)
rlm@258 126 (scroll-text 7)
rlm@258 127
rlm@258 128 (play-moves
rlm@258 129 (concat
rlm@258 130 (repeat 42 [])
rlm@260 131 [[:b] [:b] [:b] [:b]])))))
rlm@258 132
rlm@258 133 (defn-memo begin-battle-with-rival
rlm@258 134 ([] (begin-battle-with-rival
rlm@258 135 (obtain-pikachu)))
rlm@258 136 ([script]
rlm@258 137 (->> script
rlm@260 138 (walk [↓ ↓ ↓ ↓])
rlm@260 139 (scroll-text 3)
rlm@260 140 (end-text)
rlm@260 141 (scroll-text))))
rlm@260 142
rlm@260 143 (defn search-string
rlm@260 144 [array string]
rlm@260 145 (let [codes
rlm@260 146 (str->character-codes string)
rlm@260 147 codes-length (count codes)
rlm@260 148 mem (vec array)
rlm@260 149 mem-length (count mem)]
rlm@260 150 (loop [idx 0]
rlm@260 151 (if (< (- mem-length idx) codes-length)
rlm@260 152 nil
rlm@260 153 (if (= (subvec mem idx (+ idx codes-length))
rlm@260 154 codes)
rlm@260 155 idx
rlm@260 156 (recur (inc idx)))))))
rlm@260 157
rlm@260 158 (defn critical-hit
rlm@260 159 "Put the cursor over the desired attack. This program will
rlm@260 160 determine the appropriate amount of blank frames to
rlm@260 161 insert before pressing [:a] to ensure that the attack is
rlm@260 162 a critical hit."
rlm@260 163 [script]
rlm@260 164 (loop [blanks 6]
rlm@260 165 (let [new-script
rlm@260 166 (->> script
rlm@260 167 (play-moves
rlm@260 168 (concat (repeat blanks [])
rlm@260 169 [[:a][]])))]
rlm@260 170 (if (let [future-state
rlm@260 171 (run-moves (second new-script)
rlm@260 172 (repeat 400 []))
rlm@260 173
rlm@260 174 result (search-string (memory future-state)
rlm@260 175 "Critical")]
rlm@260 176 (if result
rlm@260 177 (println "critical hit with" blanks "blank frames"))
rlm@260 178 result)
rlm@260 179 new-script
rlm@260 180 (recur (inc blanks))))))
rlm@260 181
rlm@260 182 (defn-memo battle-with-rival
rlm@260 183 ([] (battle-with-rival
rlm@260 184 (begin-battle-with-rival)))
rlm@260 185 ([script]
rlm@260 186 (->> script
rlm@260 187 (play-moves (repeat 381 []))
rlm@260 188 (play-moves [[:a]])
rlm@260 189 (critical-hit)
rlm@260 190 (play-moves (repeat 100 []))
rlm@260 191 (scroll-text)
rlm@258 192 (play-moves
rlm@260 193 (concat (repeat 275 []) [[:a]]))
rlm@260 194 (critical-hit)
rlm@260 195 (play-moves (repeat 100 []))
rlm@260 196 (scroll-text)
rlm@258 197 (play-moves
rlm@260 198 (concat (repeat 270 []) [[:a]]))
rlm@260 199 (play-moves [[][][][][][][][][:a]]))))
rlm@260 200
rlm@260 201 (defn-memo finish-rival-text
rlm@260 202 ([] (finish-rival-text
rlm@260 203 (battle-with-rival)))
rlm@260 204 ([script]
rlm@260 205 (->> script
rlm@260 206 (scroll-text 2)
rlm@260 207 (end-text)
rlm@260 208 (scroll-text 9)
rlm@260 209 (end-text))))
rlm@260 210
rlm@262 211 (defn do-nothing [n script]
rlm@262 212 (->> script
rlm@262 213 (play-moves
rlm@262 214 (repeat n []))))
rlm@260 215
rlm@262 216 (defn-memo pikachu-comes-out
rlm@262 217 ([] (pikachu-comes-out
rlm@262 218 (finish-rival-text)))
rlm@262 219 ([script]
rlm@262 220 (->> script
rlm@262 221 (do-nothing 177)
rlm@262 222 (end-text)
rlm@262 223 (scroll-text 7)
rlm@262 224 (end-text))))
rlm@260 225
rlm@262 226 (defn-memo leave-oaks-lab
rlm@262 227 ([] (leave-oaks-lab
rlm@262 228 (pikachu-comes-out)))
rlm@262 229 ([script]
rlm@262 230 (->> script
rlm@262 231 (walk [← ← ↓ ↓ ↓ ↓ ↓ ↓]))))
rlm@257 232
rlm@271 233 (defn-memo oaks-lab->pallet-town-edge
rlm@262 234 ([] (oaks-lab->pallet-town-edge
rlm@262 235 (leave-oaks-lab)))
rlm@262 236 ([script]
rlm@262 237 (->> script
rlm@262 238 (walk [← ← ← ←
rlm@262 239 ↑ ↑ ↑ ↑
rlm@262 240 ↑ ↑ ↑ ↑ ↑ ↑
rlm@262 241 → ↑]))))
rlm@264 242
rlm@264 243 (defn move-thru-grass
rlm@264 244 [direction script]
rlm@264 245 (loop [blanks 0]
rlm@264 246 (let [new-script
rlm@264 247 (->> script
rlm@264 248 (play-moves (repeat blanks []))
rlm@264 249 (move direction))
rlm@264 250
rlm@264 251 future-state
rlm@264 252 (run-moves (second new-script)
rlm@264 253 (repeat 600 []))
rlm@264 254
rlm@264 255 result (search-string (memory future-state)
rlm@264 256 "Wild")]
rlm@264 257 (if (nil? result)
rlm@264 258 new-script
rlm@264 259 (recur (inc blanks))))))
rlm@264 260
rlm@264 261 (defn walk-thru-grass
rlm@264 262 [directions script]
rlm@264 263 (reduce (fn [script direction]
rlm@264 264 (move-thru-grass direction script))
rlm@264 265 script directions))
rlm@264 266
rlm@264 267 (defn-memo pallet-edge->viridian-mart
rlm@271 268 ([] (pallet-edge->viridian-mart true
rlm@264 269 (oaks-lab->pallet-town-edge)))
rlm@271 270 ([dodge-stupid-guy? script]
rlm@271 271 (let [dodge-1 (if dodge-stupid-guy?
rlm@271 272 [→ →]
rlm@271 273 [→])
rlm@271 274 dodge-2 (if dodge-stupid-guy?
rlm@271 275 [↑ ↑ ←]
rlm@271 276 [↑ ↑ ←])]
rlm@271 277
rlm@271 278 (->> script
rlm@264 279 ;; leave straight grass
rlm@264 280 (walk-thru-grass
rlm@264 281 [↑ ↑ ↑ ↑ ↑])
rlm@264 282
rlm@264 283 (walk [↑ ↑ ↑ ↑])
rlm@264 284
rlm@264 285 (walk-thru-grass
rlm@264 286 [← ← ↑])
rlm@264 287 (walk [↑ ↑ ↑ ↑ → → → ])
rlm@264 288
rlm@264 289 (walk-thru-grass
rlm@264 290 [→ ↑ ↑ ←])
rlm@264 291
rlm@264 292 (walk
rlm@264 293 [← ←
rlm@264 294 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
rlm@264 295 → → → → ])
rlm@264 296
rlm@271 297 ;; this part is dependent on that
rlm@266 298 ;; stupid NPC in the grass patch
rlm@264 299 (walk-thru-grass
rlm@271 300 (concat dodge-1
rlm@271 301 [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ]))
rlm@271 302
rlm@264 303 (walk
rlm@271 304 (concat
rlm@271 305 dodge-2
rlm@271 306 [← ← ←
rlm@271 307 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
rlm@271 308 ← ←
rlm@271 309 ↑ ↑ ↑ ↑
rlm@271 310 → → → → → → → → → →
rlm@271 311 ↑ ↑ ↑ ↑ ↑ ↑ ↑]))))))
rlm@264 312
rlm@266 313 (defn-memo get-oaks-parcel
rlm@266 314 ([] (get-oaks-parcel
rlm@266 315 (pallet-edge->viridian-mart)))
rlm@266 316 ([script]
rlm@266 317 (->> script
rlm@266 318 (end-text)
rlm@266 319 (scroll-text 3)
rlm@266 320 (do-nothing 197)
rlm@266 321 (play-moves [[:a] []])
rlm@266 322 (walk [↓ ↓ → ↓]))))
rlm@266 323
rlm@269 324 (defn-memo viridian-store->oaks-lab
rlm@269 325 ([] (viridian-store->oaks-lab
rlm@269 326 (get-oaks-parcel)))
rlm@269 327 ([script]
rlm@269 328 (->> script
rlm@269 329 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269 330 ← ← ← ← ← ← ← ← ← ←
rlm@269 331 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269 332 ← ←
rlm@269 333 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269 334 ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269 335 → → → → → → → →
rlm@269 336 ↓ ↓ ↓ ↓
rlm@269 337 ← ← ← ← ←
rlm@269 338 ↓ ↓ ↓ ↓])
rlm@266 339
rlm@269 340 (walk-thru-grass
rlm@269 341 [↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@269 342
rlm@269 343 (walk [↓ ↓ ← ↓ ↓ ↓ ←
rlm@269 344 ↓ ↓ ↓ ↓ ↓
rlm@269 345 → → → ↑]))))
rlm@269 346
rlm@269 347 (defn-memo viridian-store->oaks-lab-like-a-boss
rlm@269 348 ([] (viridian-store->oaks-lab-like-a-boss
rlm@269 349 (get-oaks-parcel)))
rlm@269 350 ([script]
rlm@269 351 (->> script
rlm@269 352 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269 353 ← ← ← ← ← ← ← ← ← ←
rlm@269 354 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@269 355
rlm@269 356 (walk-thru-grass
rlm@269 357 [↓ ↓ ↓ ↓ ↓])
rlm@269 358
rlm@269 359 (walk
rlm@269 360 [↓ ↓ ← ↓
rlm@269 361 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269 362 → →])
rlm@269 363
rlm@269 364 (walk-thru-grass
rlm@269 365 [→ ↓ ↓ ↓])
rlm@269 366
rlm@269 367 (walk [↓ ← ← ↓ ↓ ↓ ↓ ↓ ↓])
rlm@269 368
rlm@269 369 (walk-thru-grass
rlm@269 370 [↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@269 371
rlm@269 372 (walk [↓ ↓ ← ↓ ↓ ↓ ←
rlm@269 373 ↓ ↓ ↓ ↓ ↓
rlm@269 374 → → → ↑]))))
rlm@270 375
rlm@270 376 (defn-memo deliver-oaks-parcel
rlm@270 377 ([] (deliver-oaks-parcel
rlm@270 378 (viridian-store->oaks-lab-like-a-boss)))
rlm@270 379 ([script]
rlm@270 380 (->> script
rlm@270 381 (walk [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
rlm@270 382 (play-moves [[:a]])
rlm@270 383 (scroll-text 11)
rlm@270 384 (end-text)
rlm@270 385 (end-text)
rlm@270 386 (do-nothing 200)
rlm@270 387 (end-text)
rlm@270 388 (scroll-text 3)
rlm@270 389 (end-text)
rlm@270 390 (scroll-text 2)
rlm@270 391 (end-text)
rlm@270 392 (scroll-text 5)
rlm@270 393 (end-text)
rlm@270 394 (scroll-text 2)
rlm@270 395 (end-text)
rlm@270 396 (scroll-text 9)
rlm@270 397 (end-text)
rlm@270 398 (scroll-text 7)
rlm@270 399 (end-text)
rlm@270 400
rlm@271 401 (walk [← ← ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓]))))
rlm@271 402
rlm@271 403 (defn-memo return-to-viridian-mart
rlm@271 404 ([] (return-to-viridian-mart
rlm@271 405 (deliver-oaks-parcel)))
rlm@271 406 ([script]
rlm@271 407 (->> script
rlm@271 408 oaks-lab->pallet-town-edge
rlm@271 409 (pallet-edge->viridian-mart false))))