view clojure/com/aurellem/run/bootstrap_0.clj @ 275:68f4e87c8f51

added script to automatically buy any combination of items from a store's inventory.
author Robert McIntyre <rlm@mit.edu>
date Tue, 27 Mar 2012 12:36:48 -0500
parents 210b465e4720
children 710bfbb1e048
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)))
23 (defn-memo name-rival-bootstrap
24 ([] (name-rival-bootstrap (to-rival-name)))
25 ([script]
26 (->> script
27 (advance [] [:a])
28 (advance [] [:r] DE)
29 (play-moves
30 [[]
31 [:r] [] [:r] [] [:r] [] [:r] []
32 [:r] [] [:r] [] [:r] [] [:d] []
33 [:d] [:a] ;; space
34 [:l] [] [:d] [:a] ;; [PK]
35 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
36 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
37 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
38 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
40 [:d] [] [:r] [:a] ;; finish
41 ]))))
43 (defn walk
44 "Move the character along the given directions."
45 [directions script]
46 (reduce (fn [script direction]
47 (move direction script))
48 script directions))
50 (def ↑ [:u])
51 (def ↓ [:d])
52 (def ← [:l])
53 (def → [:r])
55 (defn-memo leave-house
56 ([] (leave-house (name-rival-bootstrap)))
57 ([script]
58 (->> script
59 finish-title
60 start-walking
61 walk-to-stairs
62 walk-to-door
63 (walk [↓ ↓]))))
65 (defn-memo to-pallet-town-edge
66 ([] (to-pallet-town-edge (leave-house)))
67 ([script]
68 (->> script
69 start-walking
70 (walk [→ → → → →
71 ↑ ↑ ↑ ↑ ↑ ↑]))))
73 (defn end-text [script]
74 (->> script
75 (scroll-text)
76 (play-moves [[] [:a]])))
78 (defn-memo start-pikachu-battle
79 ([] (start-pikachu-battle
80 (to-pallet-town-edge)))
81 ([script]
82 (->> script
83 (advance [:b] [:b :a] DE)
84 (scroll-text)
85 (play-moves [[:b]])
86 (scroll-text)
87 (end-text) ;; battle begins
88 (scroll-text))))
90 (defn-memo capture-pikachu
91 ([] (capture-pikachu (start-pikachu-battle)))
92 ([script]
93 (->> script
94 (scroll-text 2)
95 (end-text))))
97 (defn-memo go-to-lab
98 ([] (go-to-lab (capture-pikachu)))
99 ([script]
100 (->> script
101 (scroll-text 5)
102 (end-text)
103 (scroll-text)
104 (end-text)
105 (scroll-text 8)
106 (end-text)
107 (scroll-text)
108 (end-text))))
110 (defn-memo obtain-pikachu
111 ([] (obtain-pikachu (go-to-lab)))
112 ([script]
113 (->> script
114 (scroll-text)
115 (play-moves
116 (concat
117 (repeat 51 [])
118 [[:a] []]))
119 (walk [↓ ↓ → → ↑])
120 (play-moves
121 (concat [[] [:a]]
122 (repeat 100 [])))
123 (scroll-text 9)
124 (end-text)
125 (scroll-text 7)
127 (play-moves
128 (concat
129 (repeat 42 [])
130 [[:b] [:b] [:b] [:b]])))))
132 (defn-memo begin-battle-with-rival
133 ([] (begin-battle-with-rival
134 (obtain-pikachu)))
135 ([script]
136 (->> script
137 (walk [↓ ↓ ↓ ↓])
138 (scroll-text 3)
139 (end-text)
140 (scroll-text))))
142 (defn search-string
143 [array string]
144 (let [codes
145 (str->character-codes string)
146 codes-length (count codes)
147 mem (vec array)
148 mem-length (count mem)]
149 (loop [idx 0]
150 (if (< (- mem-length idx) codes-length)
151 nil
152 (if (= (subvec mem idx (+ idx codes-length))
153 codes)
154 idx
155 (recur (inc idx)))))))
157 (defn critical-hit
158 "Put the cursor over the desired attack. This program will
159 determine the appropriate amount of blank frames to
160 insert before pressing [:a] to ensure that the attack is
161 a critical hit."
162 [script]
163 (loop [blanks 6]
164 (let [new-script
165 (->> script
166 (play-moves
167 (concat (repeat blanks [])
168 [[:a][]])))]
169 (if (let [future-state
170 (run-moves (second new-script)
171 (repeat 400 []))
173 result (search-string (memory future-state)
174 "Critical")]
175 (if result
176 (println "critical hit with" blanks "blank frames"))
177 result)
178 new-script
179 (recur (inc blanks))))))
181 (defn-memo battle-with-rival
182 ([] (battle-with-rival
183 (begin-battle-with-rival)))
184 ([script]
185 (->> script
186 (play-moves (repeat 381 []))
187 (play-moves [[:a]])
188 (critical-hit)
189 (play-moves (repeat 100 []))
190 (scroll-text)
191 (play-moves
192 (concat (repeat 275 []) [[:a]]))
193 (critical-hit)
194 (play-moves (repeat 100 []))
195 (scroll-text)
196 (play-moves
197 (concat (repeat 270 []) [[:a]]))
198 (play-moves [[][][][][][][][][:a]]))))
200 (defn-memo finish-rival-text
201 ([] (finish-rival-text
202 (battle-with-rival)))
203 ([script]
204 (->> script
205 (scroll-text 2)
206 (end-text)
207 (scroll-text 9)
208 (end-text))))
210 (defn do-nothing [n script]
211 (->> script
212 (play-moves
213 (repeat n []))))
215 (defn-memo pikachu-comes-out
216 ([] (pikachu-comes-out
217 (finish-rival-text)))
218 ([script]
219 (->> script
220 (do-nothing 177)
221 (end-text)
222 (scroll-text 7)
223 (end-text))))
225 (defn-memo leave-oaks-lab
226 ([] (leave-oaks-lab
227 (pikachu-comes-out)))
228 ([script]
229 (->> script
230 (walk [← ← ↓ ↓ ↓ ↓ ↓ ↓]))))
232 (defn-memo oaks-lab->pallet-town-edge
233 ([] (oaks-lab->pallet-town-edge
234 (leave-oaks-lab)))
235 ([script]
236 (->> script
237 (walk [← ← ← ←
238 ↑ ↑ ↑ ↑
239 ↑ ↑ ↑ ↑ ↑ ↑
240 → ↑]))))
242 (defn move-thru-grass
243 [direction script]
244 (loop [blanks 0]
245 (let [new-script
246 (->> script
247 (play-moves (repeat blanks []))
248 (move direction))
250 future-state
251 (run-moves (second new-script)
252 (repeat 600 []))
254 result (search-string (memory future-state)
255 "Wild")]
256 (if (nil? result)
257 new-script
258 (recur (inc blanks))))))
260 (defn walk-thru-grass
261 [directions script]
262 (reduce (fn [script direction]
263 (move-thru-grass direction script))
264 script directions))
266 (defn-memo pallet-edge->viridian-mart
267 ([] (pallet-edge->viridian-mart true
268 (oaks-lab->pallet-town-edge)))
269 ([dodge-stupid-guy? script]
270 (let [dodge-1 (if dodge-stupid-guy?
271 [→ →]
272 [→])
273 dodge-2 (if dodge-stupid-guy?
274 [↑ ↑ ←]
275 [↑ ↑ ←])]
277 (->> script
278 ;; leave straight grass
279 (walk-thru-grass
280 [↑ ↑ ↑ ↑ ↑])
282 (walk [↑ ↑ ↑ ↑])
284 (walk-thru-grass
285 [← ← ↑])
286 (walk [↑ ↑ ↑ ↑ → → → ])
288 (walk-thru-grass
289 [→ ↑ ↑ ←])
291 (walk
292 [← ←
293 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
294 → → → → ])
296 ;; this part is dependent on that
297 ;; stupid NPC in the grass patch
298 (walk-thru-grass
299 (concat dodge-1
300 [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ]))
302 (walk
303 (concat
304 dodge-2
305 [← ← ←
306 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
307 ← ←
308 ↑ ↑ ↑ ↑
309 → → → → → → → → → →
310 ↑ ↑ ↑ ↑ ↑ ↑ ↑]))))))
312 (defn-memo get-oaks-parcel
313 ([] (get-oaks-parcel
314 (pallet-edge->viridian-mart)))
315 ([script]
316 (->> script
317 (end-text)
318 (scroll-text 3)
319 (do-nothing 197)
320 (play-moves [[:a] []])
321 (walk [↓ ↓ → ↓]))))
323 (defn-memo viridian-store->oaks-lab
324 ([] (viridian-store->oaks-lab
325 (get-oaks-parcel)))
326 ([script]
327 (->> script
328 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
329 ← ← ← ← ← ← ← ← ← ←
330 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
331 ← ←
332 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
333 ↓ ↓ ↓ ↓ ↓ ↓ ↓
334 → → → → → → → →
335 ↓ ↓ ↓ ↓
336 ← ← ← ← ←
337 ↓ ↓ ↓ ↓])
339 (walk-thru-grass
340 [↓ ↓ ↓ ↓ ↓ ↓ ↓])
342 (walk [↓ ↓ ← ↓ ↓ ↓ ←
343 ↓ ↓ ↓ ↓ ↓
344 → → → ↑]))))
346 (defn-memo viridian-store->oaks-lab-like-a-boss
347 ([] (viridian-store->oaks-lab-like-a-boss
348 (get-oaks-parcel)))
349 ([script]
350 (->> script
351 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
352 ← ← ← ← ← ← ← ← ← ←
353 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])
355 (walk-thru-grass
356 [↓ ↓ ↓ ↓ ↓])
358 (walk
359 [↓ ↓ ← ↓
360 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
361 → →])
363 (walk-thru-grass
364 [→ ↓ ↓ ↓])
366 (walk [↓ ← ← ↓ ↓ ↓ ↓ ↓ ↓])
368 (walk-thru-grass
369 [↓ ↓ ↓ ↓ ↓ ↓ ↓])
371 (walk [↓ ↓ ← ↓ ↓ ↓ ←
372 ↓ ↓ ↓ ↓ ↓
373 → → → ↑]))))
375 (defn-memo deliver-oaks-parcel
376 ([] (deliver-oaks-parcel
377 (viridian-store->oaks-lab-like-a-boss)))
378 ([script]
379 (->> script
380 (walk [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
381 (play-moves [[:a]])
382 (scroll-text 11)
383 (end-text)
384 (end-text)
385 (do-nothing 200)
386 (end-text)
387 (scroll-text 3)
388 (end-text)
389 (scroll-text 2)
390 (end-text)
391 (scroll-text 5)
392 (end-text)
393 (scroll-text 2)
394 (end-text)
395 (scroll-text 9)
396 (end-text)
397 (scroll-text 7)
398 (end-text)
399 (walk [← ← ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓]))))
401 (defn-memo return-to-viridian-mart
402 ([] (return-to-viridian-mart
403 (deliver-oaks-parcel)))
404 ([script]
405 (->> script
406 oaks-lab->pallet-town-edge
407 (pallet-edge->viridian-mart false))))
409 (defn-memo walk-to-counter
410 ([] (walk-to-counter
411 (return-to-viridian-mart)))
412 ([script]
413 (->> script
414 (walk [↑ ↑ ← ←]))))
416 (defn buy-item
417 "Assumes that the main item-screen is up, and buys
418 quantity of the nth item in the list, assuming that you
419 have enough money."
420 [n quantity script]
421 (if (= 0 quantity)
422 script
423 (let [after-initial-pause
424 (do-nothing 20 script)
425 move-to-item
426 (reduce (fn [script _]
427 (->> script
428 (play-moves [[:d]])
429 (do-nothing 3)))
430 after-initial-pause
431 (range n))
432 select-item
433 (play-moves [[:a]] move-to-item)
434 request-items
435 (reduce (fn [script _]
436 (->> script
437 (play-moves [[:u]])
438 (do-nothing 1)))
439 select-item
440 (range (dec quantity)))
441 buy-items
442 (->> request-items
443 (do-nothing 3)
444 (play-moves [[:a]])
445 (scroll-text)
446 (scroll-text)
447 (play-moves [[:a]])
448 (scroll-text))]
449 buy-items)))
452 (defn buy-items
453 "Given a list of [item-no quantity], buys the quantity
454 from the shop's list. Assumes that the item list is
455 already up."
456 [item-pairs script]
457 (let [item-lookup (into {0 0 1 0 2 0 3 0 4 0} item-pairs)
458 initial-purchase
459 (->> script
460 (buy-item 0 (item-lookup 0))
461 (buy-item 1 (item-lookup 1))
462 (buy-item 2 (item-lookup 2)))]
463 (cond
464 (and
465 (not= 0 (item-lookup 3))
466 (not= 0 (item-lookup 4)))
467 (->> initial-purchase
468 (do-nothing 20)
469 (play-moves [[:d]])
470 (do-nothing 3)
471 (play-moves [[:d]])
472 (do-nothing 3)
473 (play-moves [[:d]])
474 (do-nothing 10)
475 (buy-item 0 (item-lookup 3))
476 (do-nothing 20)
477 (play-moves [[:d]])
478 (do-nothing 3)
479 (play-moves [[:d]])
480 (do-nothing 3)
481 (play-moves [[:d]])
482 (do-nothing 10)
483 (buy-item 0 (item-lookup 4)))
484 (and (= 0 (item-lookup 3))
485 (not= 0 (item-lookup 4)))
486 (->> initial-purchase
487 (do-nothing 20)
488 (play-moves [[:d]])
489 (do-nothing 3)
490 (play-moves [[:d]])
491 (do-nothing 3)
492 (play-moves [[:d]])
493 (do-nothing 10)
494 (play-moves [[:d]])
495 (do-nothing 10)
496 (buy-item 0 (item-lookup 4)))
497 (and (not= 0 (item-lookup 3))
498 (= 0 (item-lookup 4)))
499 (->> initial-purchase
500 (do-nothing 20)
501 (play-moves [[:d]])
502 (do-nothing 3)
503 (play-moves [[:d]])
504 (do-nothing 3)
505 (play-moves [[:d]])
506 (do-nothing 10)
507 (buy-item 0 (item-lookup 3))))))
510 (defn test-buy-items
511 ([] (test-buy-itemss
512 (walk-to-counter)))
513 ([script]
514 (->> [(first script) (set-money (second script)
515 999999)]
516 (play-moves
517 [[] [:a] []])
518 (scroll-text)
519 (do-nothing 100)
520 (play-moves [[:a]])
521 (do-nothing 100)
522 (buy-items
523 [[0 1]
524 [1 15]
525 [2 1]
526 [3 20]
527 [4 95]
528 ]))))
530 (defn-memo buy-initial-items
531 ([] (buy-initial-items
532 (walk-to-counter)))
533 ([script]
534 (->> script
535 (play-moves
536 [[] [:a] []])
537 (scroll-text)
538 (do-nothing 100)
539 (play-moves [[:a]])
540 (do-nothing 100)
541 (buy-items
542 [[0 1]
543 [1 1]
544 [2 1]
545 [3 1]
546 [4 1]
547 ]))))