Mercurial > vba-clojure
view clojure/com/aurellem/run/bootstrap_0.clj @ 272:a60ea8632ff4
beginning work on hxc-pokemon-base, the collection of base stats, battle sprite data, etc.
author | Dylan Holmes <ocsenave@gmail.com> |
---|---|
date | Tue, 27 Mar 2012 00:59:43 -0500 |
parents | 3266bd0a6300 |
children | 210b465e4720 |
line wrap: on
line source
1 (ns com.aurellem.run.bootstrap-02 (:use (com.aurellem.gb gb-driver vbm characters))3 (:use (com.aurellem.run title save-corruption))4 (:use (com.aurellem.exp item-bridge))5 (:import [com.aurellem.gb.gb_driver SaveState]))7 (defn-memo boot-root []8 [ [] (root)])10 (defn-memo to-rival-name11 ([] (to-rival-name (boot-root)))12 ([script]13 (-> script14 title15 oak16 name-entry-rlm17 scroll-text18 scroll-text19 scroll-text20 scroll-text21 scroll-text22 )))24 (defn-memo name-rival-bootstrap25 ([] (name-rival-bootstrap (to-rival-name)))26 ([script]27 (->> script28 (advance [] [:a])29 (advance [] [:r] DE)30 (play-moves31 [[]32 [:r] [] [:r] [] [:r] [] [:r] []33 [:r] [] [:r] [] [:r] [] [:d] []34 [:d] [:a] ;; space35 [:l] [] [:d] [:a] ;; [PK]36 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G37 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]38 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G39 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]41 [:d] [] [:r] [:a] ;; finish42 ]))))44 (defn walk45 "Move the character along the given directions."46 [directions script]47 (reduce (fn [script direction]48 (move direction script))49 script directions))51 (def ↑ [:u])52 (def ↓ [:d])53 (def ← [:l])54 (def → [:r])56 (defn-memo leave-house57 ([] (leave-house (name-rival-bootstrap)))58 ([script]59 (->> script60 finish-title61 start-walking62 walk-to-stairs63 walk-to-door64 (walk [↓ ↓]))))66 (defn-memo to-pallet-town-edge67 ([] (to-pallet-town-edge (leave-house)))68 ([script]69 (->> script70 start-walking71 (walk [→ → → → →72 ↑ ↑ ↑ ↑ ↑ ↑]))))74 (defn end-text [script]75 (->> script76 (scroll-text)77 (play-moves [[] [:a]])))79 (defn-memo start-pikachu-battle80 ([] (start-pikachu-battle81 (to-pallet-town-edge)))82 ([script]83 (->> script84 (advance [:b] [:b :a] DE)85 (scroll-text)86 (play-moves [[:b]])87 (scroll-text)88 (end-text) ;; battle begins89 (scroll-text))))91 (defn-memo capture-pikachu92 ([] (capture-pikachu (start-pikachu-battle)))93 ([script]94 (->> script95 (scroll-text 2)96 (end-text))))98 (defn-memo go-to-lab99 ([] (go-to-lab (capture-pikachu)))100 ([script]101 (->> script102 (scroll-text 5)103 (end-text)104 (scroll-text)105 (end-text)106 (scroll-text 8)107 (end-text)108 (scroll-text)109 (end-text))))111 (defn-memo obtain-pikachu112 ([] (obtain-pikachu (go-to-lab)))113 ([script]114 (->> script115 (scroll-text)116 (play-moves117 (concat118 (repeat 51 [])119 [[:a] []]))120 (walk [↓ ↓ → → ↑])121 (play-moves122 (concat [[] [:a]]123 (repeat 100 [])))124 (scroll-text 9)125 (end-text)126 (scroll-text 7)128 (play-moves129 (concat130 (repeat 42 [])131 [[:b] [:b] [:b] [:b]])))))133 (defn-memo begin-battle-with-rival134 ([] (begin-battle-with-rival135 (obtain-pikachu)))136 ([script]137 (->> script138 (walk [↓ ↓ ↓ ↓])139 (scroll-text 3)140 (end-text)141 (scroll-text))))143 (defn search-string144 [array string]145 (let [codes146 (str->character-codes string)147 codes-length (count codes)148 mem (vec array)149 mem-length (count mem)]150 (loop [idx 0]151 (if (< (- mem-length idx) codes-length)152 nil153 (if (= (subvec mem idx (+ idx codes-length))154 codes)155 idx156 (recur (inc idx)))))))158 (defn critical-hit159 "Put the cursor over the desired attack. This program will160 determine the appropriate amount of blank frames to161 insert before pressing [:a] to ensure that the attack is162 a critical hit."163 [script]164 (loop [blanks 6]165 (let [new-script166 (->> script167 (play-moves168 (concat (repeat blanks [])169 [[:a][]])))]170 (if (let [future-state171 (run-moves (second new-script)172 (repeat 400 []))174 result (search-string (memory future-state)175 "Critical")]176 (if result177 (println "critical hit with" blanks "blank frames"))178 result)179 new-script180 (recur (inc blanks))))))182 (defn-memo battle-with-rival183 ([] (battle-with-rival184 (begin-battle-with-rival)))185 ([script]186 (->> script187 (play-moves (repeat 381 []))188 (play-moves [[:a]])189 (critical-hit)190 (play-moves (repeat 100 []))191 (scroll-text)192 (play-moves193 (concat (repeat 275 []) [[:a]]))194 (critical-hit)195 (play-moves (repeat 100 []))196 (scroll-text)197 (play-moves198 (concat (repeat 270 []) [[:a]]))199 (play-moves [[][][][][][][][][:a]]))))201 (defn-memo finish-rival-text202 ([] (finish-rival-text203 (battle-with-rival)))204 ([script]205 (->> script206 (scroll-text 2)207 (end-text)208 (scroll-text 9)209 (end-text))))211 (defn do-nothing [n script]212 (->> script213 (play-moves214 (repeat n []))))216 (defn-memo pikachu-comes-out217 ([] (pikachu-comes-out218 (finish-rival-text)))219 ([script]220 (->> script221 (do-nothing 177)222 (end-text)223 (scroll-text 7)224 (end-text))))226 (defn-memo leave-oaks-lab227 ([] (leave-oaks-lab228 (pikachu-comes-out)))229 ([script]230 (->> script231 (walk [← ← ↓ ↓ ↓ ↓ ↓ ↓]))))233 (defn-memo oaks-lab->pallet-town-edge234 ([] (oaks-lab->pallet-town-edge235 (leave-oaks-lab)))236 ([script]237 (->> script238 (walk [← ← ← ←239 ↑ ↑ ↑ ↑240 ↑ ↑ ↑ ↑ ↑ ↑241 → ↑]))))243 (defn move-thru-grass244 [direction script]245 (loop [blanks 0]246 (let [new-script247 (->> script248 (play-moves (repeat blanks []))249 (move direction))251 future-state252 (run-moves (second new-script)253 (repeat 600 []))255 result (search-string (memory future-state)256 "Wild")]257 (if (nil? result)258 new-script259 (recur (inc blanks))))))261 (defn walk-thru-grass262 [directions script]263 (reduce (fn [script direction]264 (move-thru-grass direction script))265 script directions))267 (defn-memo pallet-edge->viridian-mart268 ([] (pallet-edge->viridian-mart true269 (oaks-lab->pallet-town-edge)))270 ([dodge-stupid-guy? script]271 (let [dodge-1 (if dodge-stupid-guy?272 [→ →]273 [→])274 dodge-2 (if dodge-stupid-guy?275 [↑ ↑ ←]276 [↑ ↑ ←])]278 (->> script279 ;; leave straight grass280 (walk-thru-grass281 [↑ ↑ ↑ ↑ ↑])283 (walk [↑ ↑ ↑ ↑])285 (walk-thru-grass286 [← ← ↑])287 (walk [↑ ↑ ↑ ↑ → → → ])289 (walk-thru-grass290 [→ ↑ ↑ ←])292 (walk293 [← ←294 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑295 → → → → ])297 ;; this part is dependent on that298 ;; stupid NPC in the grass patch299 (walk-thru-grass300 (concat dodge-1301 [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ]))303 (walk304 (concat305 dodge-2306 [← ← ←307 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑308 ← ←309 ↑ ↑ ↑ ↑310 → → → → → → → → → →311 ↑ ↑ ↑ ↑ ↑ ↑ ↑]))))))313 (defn-memo get-oaks-parcel314 ([] (get-oaks-parcel315 (pallet-edge->viridian-mart)))316 ([script]317 (->> script318 (end-text)319 (scroll-text 3)320 (do-nothing 197)321 (play-moves [[:a] []])322 (walk [↓ ↓ → ↓]))))324 (defn-memo viridian-store->oaks-lab325 ([] (viridian-store->oaks-lab326 (get-oaks-parcel)))327 ([script]328 (->> script329 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓330 ← ← ← ← ← ← ← ← ← ←331 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓332 ← ←333 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓334 ↓ ↓ ↓ ↓ ↓ ↓ ↓335 → → → → → → → →336 ↓ ↓ ↓ ↓337 ← ← ← ← ←338 ↓ ↓ ↓ ↓])340 (walk-thru-grass341 [↓ ↓ ↓ ↓ ↓ ↓ ↓])343 (walk [↓ ↓ ← ↓ ↓ ↓ ←344 ↓ ↓ ↓ ↓ ↓345 → → → ↑]))))347 (defn-memo viridian-store->oaks-lab-like-a-boss348 ([] (viridian-store->oaks-lab-like-a-boss349 (get-oaks-parcel)))350 ([script]351 (->> script352 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓353 ← ← ← ← ← ← ← ← ← ←354 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])356 (walk-thru-grass357 [↓ ↓ ↓ ↓ ↓])359 (walk360 [↓ ↓ ← ↓361 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓362 → →])364 (walk-thru-grass365 [→ ↓ ↓ ↓])367 (walk [↓ ← ← ↓ ↓ ↓ ↓ ↓ ↓])369 (walk-thru-grass370 [↓ ↓ ↓ ↓ ↓ ↓ ↓])372 (walk [↓ ↓ ← ↓ ↓ ↓ ←373 ↓ ↓ ↓ ↓ ↓374 → → → ↑]))))376 (defn-memo deliver-oaks-parcel377 ([] (deliver-oaks-parcel378 (viridian-store->oaks-lab-like-a-boss)))379 ([script]380 (->> script381 (walk [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])382 (play-moves [[:a]])383 (scroll-text 11)384 (end-text)385 (end-text)386 (do-nothing 200)387 (end-text)388 (scroll-text 3)389 (end-text)390 (scroll-text 2)391 (end-text)392 (scroll-text 5)393 (end-text)394 (scroll-text 2)395 (end-text)396 (scroll-text 9)397 (end-text)398 (scroll-text 7)399 (end-text)401 (walk [← ← ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓]))))403 (defn-memo return-to-viridian-mart404 ([] (return-to-viridian-mart405 (deliver-oaks-parcel)))406 ([script]407 (->> script408 oaks-lab->pallet-town-edge409 (pallet-edge->viridian-mart false))))