view clojure/com/aurellem/run/bootstrap_0.clj @ 266:c85549460218

script: got oak's parcel
author Robert McIntyre <rlm@mit.edu>
date Mon, 26 Mar 2012 23:04:12 -0500
parents 0297d315b574
children d68a191997ca
line wrap: on
line source
1 (ns com.aurellem.run.bootstrap-0
2 (: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-name
11 ([] (to-rival-name (boot-root)))
12 ([script]
13 (-> script
14 title
15 oak
16 name-entry-rlm
17 scroll-text
18 scroll-text
19 scroll-text
20 scroll-text
21 scroll-text
22 )))
24 (defn-memo name-rival-bootstrap
25 ([] (name-rival-bootstrap (to-rival-name)))
26 ([script]
27 (->> script
28 (advance [] [:a])
29 (advance [] [:r] DE)
30 (play-moves
31 [[]
32 [:r] [] [:r] [] [:r] [] [:r] []
33 [:r] [] [:r] [] [:r] [] [:d] []
34 [:d] [:a] ;; space
35 [:l] [] [:d] [:a] ;; [PK]
36 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
37 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
38 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
39 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
41 [:d] [] [:r] [:a] ;; finish
42 ]))))
44 (defn walk
45 "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-house
57 ([] (leave-house (name-rival-bootstrap)))
58 ([script]
59 (->> script
60 finish-title
61 start-walking
62 walk-to-stairs
63 walk-to-door
64 (walk [↓ ↓]))))
66 (defn-memo to-pallet-town-edge
67 ([] (to-pallet-town-edge (leave-house)))
68 ([script]
69 (->> script
70 start-walking
71 (walk [→ → → → →
72 ↑ ↑ ↑ ↑ ↑ ↑]))))
74 (defn end-text [script]
75 (->> script
76 (scroll-text)
77 (play-moves [[] [:a]])))
79 (defn-memo start-pikachu-battle
80 ([] (start-pikachu-battle
81 (to-pallet-town-edge)))
82 ([script]
83 (->> script
84 (advance [:b] [:b :a] DE)
85 (scroll-text)
86 (play-moves [[:b]])
87 (scroll-text)
88 (end-text) ;; battle begins
89 (scroll-text))))
91 (defn-memo capture-pikachu
92 ([] (capture-pikachu (start-pikachu-battle)))
93 ([script]
94 (->> script
95 (scroll-text 2)
96 (end-text))))
98 (defn-memo go-to-lab
99 ([] (go-to-lab (capture-pikachu)))
100 ([script]
101 (->> script
102 (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-pikachu
112 ([] (obtain-pikachu (go-to-lab)))
113 ([script]
114 (->> script
115 (scroll-text)
116 (play-moves
117 (concat
118 (repeat 51 [])
119 [[:a] []]))
120 (walk [↓ ↓ → → ↑])
121 (play-moves
122 (concat [[] [:a]]
123 (repeat 100 [])))
124 (scroll-text 9)
125 (end-text)
126 (scroll-text 7)
128 (play-moves
129 (concat
130 (repeat 42 [])
131 [[:b] [:b] [:b] [:b]])))))
133 (defn-memo begin-battle-with-rival
134 ([] (begin-battle-with-rival
135 (obtain-pikachu)))
136 ([script]
137 (->> script
138 (walk [↓ ↓ ↓ ↓])
139 (scroll-text 3)
140 (end-text)
141 (scroll-text))))
143 (defn search-string
144 [array string]
145 (let [codes
146 (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 nil
153 (if (= (subvec mem idx (+ idx codes-length))
154 codes)
155 idx
156 (recur (inc idx)))))))
158 (defn critical-hit
159 "Put the cursor over the desired attack. This program will
160 determine the appropriate amount of blank frames to
161 insert before pressing [:a] to ensure that the attack is
162 a critical hit."
163 [script]
164 (loop [blanks 6]
165 (let [new-script
166 (->> script
167 (play-moves
168 (concat (repeat blanks [])
169 [[:a][]])))]
170 (if (let [future-state
171 (run-moves (second new-script)
172 (repeat 400 []))
174 result (search-string (memory future-state)
175 "Critical")]
176 (if result
177 (println "critical hit with" blanks "blank frames"))
178 result)
179 new-script
180 (recur (inc blanks))))))
182 (defn-memo battle-with-rival
183 ([] (battle-with-rival
184 (begin-battle-with-rival)))
185 ([script]
186 (->> script
187 (play-moves (repeat 381 []))
188 (play-moves [[:a]])
189 (critical-hit)
190 (play-moves (repeat 100 []))
191 (scroll-text)
192 (play-moves
193 (concat (repeat 275 []) [[:a]]))
194 (critical-hit)
195 (play-moves (repeat 100 []))
196 (scroll-text)
197 (play-moves
198 (concat (repeat 270 []) [[:a]]))
199 (play-moves [[][][][][][][][][:a]]))))
201 (defn-memo finish-rival-text
202 ([] (finish-rival-text
203 (battle-with-rival)))
204 ([script]
205 (->> script
206 (scroll-text 2)
207 (end-text)
208 (scroll-text 9)
209 (end-text))))
211 (defn do-nothing [n script]
212 (->> script
213 (play-moves
214 (repeat n []))))
216 (defn-memo pikachu-comes-out
217 ([] (pikachu-comes-out
218 (finish-rival-text)))
219 ([script]
220 (->> script
221 (do-nothing 177)
222 (end-text)
223 (scroll-text 7)
224 (end-text))))
226 (defn-memo leave-oaks-lab
227 ([] (leave-oaks-lab
228 (pikachu-comes-out)))
229 ([script]
230 (->> script
231 (walk [← ← ↓ ↓ ↓ ↓ ↓ ↓]))))
233 (defn-memo oaks-lab->pallet-town-edge
234 ([] (oaks-lab->pallet-town-edge
235 (leave-oaks-lab)))
236 ([script]
237 (->> script
238 (walk [← ← ← ←
239 ↑ ↑ ↑ ↑
240 ↑ ↑ ↑ ↑ ↑ ↑
241 → ↑]))))
244 (defn move-thru-grass
245 [direction script]
246 (loop [blanks 0]
247 (let [new-script
248 (->> script
249 (play-moves (repeat blanks []))
250 (move direction))
252 future-state
253 (run-moves (second new-script)
254 (repeat 600 []))
256 result (search-string (memory future-state)
257 "Wild")]
258 (if (nil? result)
259 new-script
260 (recur (inc blanks))))))
262 (defn walk-thru-grass
263 [directions script]
264 (reduce (fn [script direction]
265 (move-thru-grass direction script))
266 script directions))
268 (defn-memo pallet-edge->viridian-mart
269 ([] (pallet-edge->viridian-mart
270 (oaks-lab->pallet-town-edge)))
271 ([script]
272 (->> script
273 ;; leave straight grass
274 (walk-thru-grass
275 [↑ ↑ ↑ ↑ ↑])
277 (walk [↑ ↑ ↑ ↑])
279 (walk-thru-grass
280 [← ← ↑])
281 (walk [↑ ↑ ↑ ↑ → → → ])
283 (walk-thru-grass
284 [→ ↑ ↑ ←])
286 (walk
287 [← ←
288 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
289 → → → → ])
291 ;; this part it dependent on that
292 ;; stupid NPC in the grass patch
293 (walk-thru-grass
294 [→ →
295 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ])
297 (walk
298 [↑ ↑
299 ← ← ← ←
300 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
301 ← ←
302 ↑ ↑ ↑ ↑
303 → → → → → → → → → →
304 ↑ ↑ ↑ ↑ ↑ ↑ ↑]))))
306 (defn-memo get-oaks-parcel
307 ([] (get-oaks-parcel
308 (pallet-edge->viridian-mart)))
309 ([script]
310 (->> script
311 (end-text)
312 (scroll-text 3)
313 (do-nothing 197)
314 (play-moves [[:a] []])
315 (walk [↓ ↓ → ↓]))))