view clojure/com/aurellem/run/bootstrap_1.clj @ 363:79252378fd22

saving progress...]
author Robert McIntyre <rlm@mit.edu>
date Mon, 09 Apr 2012 10:35:22 -0500
parents 8d8023057b3c
children 958a333f16e2
line wrap: on
line source
1 (ns com.aurellem.run.bootstrap-1
2 (:use (com.aurellem.gb saves gb-driver util
3 items vbm characters money))
4 (:use (com.aurellem.run util title save-corruption bootstrap-0))
5 (:use (com.aurellem.exp item-bridge))
6 (:import [com.aurellem.gb.gb_driver SaveState]))
8 (defn pc-item-writer-program
9 []
10 (let [limit 201
11 [target-high target-low] (disect-bytes-2 0xD162)]
12 (flatten
13 [[0x00 ;; (item-hack) set increment stack pointer no-op
14 0x1E ;; load limit into E
15 limit
16 0x3F ;; (item-hack) set carry flag no-op
18 ;; load 2 into C.
19 0x0E ;; C == 1 means input-first nybble
20 0x04 ;; C == 0 means input-second nybble
22 0x21 ;; load target into HL
23 target-low
24 target-high
25 0x37 ;; (item-hack) set carry flag no-op
27 0x00 ;; (item-hack) no-op
28 0x37 ;; (item-hack) set carry flag no-op
30 0x00 ;; (item-hack) no-op
31 0xF3 ;; disable interrupts
32 ;; Input Section
34 0x3E ;; load 0x20 into A, to measure buttons
35 0x10
37 0x00 ;; (item-hack) no-op
38 0xE0 ;; load A into [FF00]
39 0x00
41 0xF0 ;; load 0xFF00 into A to get
42 0x00 ;; button presses
44 0xE6
45 0x0F ;; select bottom four bits of A
46 0x37 ;; (item-hack) set carry flag no-op
48 0x00 ;; (item-hack) no-op
49 0xB8 ;; see if input is different (CP A B)
51 0x00 ;; (item-hack) (INC SP)
52 0x28 ;; repeat above steps if input is not different
53 ;; (jump relative backwards if B != A)
54 0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)
56 0x47 ;; load A into B
58 0x0D ;; dec C
59 0x37 ;; (item-hack) set-carry flag
60 ;; branch based on C:
61 0x20 ;; JR NZ
62 23 ;; skip "input second nybble" and "jump to target" below
64 ;; input second nybble
66 0x0C ;; inc C
67 0x0C ;; inc C
69 0x00 ;; (item-hack) no-op
70 0xE6 ;; select bottom bits
71 0x0F
72 0x37 ;; (item-hack) set-carry flag no-op
74 0x00 ;; (item-hack) no-op
75 0xB2 ;; (OR A D) -> A
77 0x22 ;; (do (A -> (HL)) (INC HL))
79 0x1D ;; (DEC E)
81 0x00 ;; (item-hack)
82 0x20 ;; jump back to input section if not done
83 0xDA ;; literal -36 == TM 18 (counter)
84 0x01 ;; (item-hack) set BC to literal (no-op)
86 ;; jump to target
87 0x00 ;; (item-hack) these two bytes can be anything.
88 0x01
90 0x00 ;; (item-hack) no-op
91 0xBF ;; (CP A A) ensures Z
93 0xCA ;; (item-hack) jump if Z
94 target-low
95 target-high
96 0x01 ;; (item-hack) will never be reached.
98 ;; input first nybble
99 0x00
100 0xCB
101 0x37 ;; swap nybbles on A
103 0x57 ;; A -> D
105 0x37 ;; (item-hack) set carry flag no-op
106 0x18 ;; relative jump backwards
107 0xCD ;; literal -51 == TM05; go back to input section
108 0x01 ;; (item-hack) will never reach this instruction
110 ]
111 (repeat 8 [0x00 0x01])
113 [;; jump to actual program
114 0x00
115 0x37 ;; (item-hack) set carry flag no-op
117 0x2E ;; 0x3A -> L
118 0x3A
121 0x00 ;; (item-hack) no-op
122 0x26 ;; 0xD5 -> L
123 0xD5
124 0x01 ;; (item-hack) set-carry BC
126 0x00 ;; (item-hack) these can be anything
127 0x01
129 0x00
130 0xE9 ;; jump to (HL)
131 ]])))
133 (defn view-desired-item-layout []
134 (clojure.pprint/pprint
135 (raw-inventory->inventory (pc-item-writer-program))))
137 (defn pc-item-writer-state []
138 (-> (read-state "bootstrap-init")
139 (set-memory pc-item-list-start 50)
140 (set-memory-range
141 map-function-address-start
142 [0x8B 0xD5])
143 (set-memory-range
144 (inc pc-item-list-start)
145 (pc-item-writer-program))))
147 (defn test-pc-item-writer []
148 (let [orig (read-state "pc-item-writer")]
149 (-> orig
150 (print-listing 0xD162 (+ 0xD162 20))
151 (run-moves (reduce concat
152 (repeat 10 [[:a :b :start :select] []])))
153 ((fn [_] (println "===========") _))
154 (print-listing 0xD162 (+ 0xD162 20)))))
156 (defn close-all-menus [[moves state :as script]]
157 (loop [s script]
158 (let [depth (current-depth (second (do-nothing 50 s)))]
159 (println "depth" depth)
160 (if (= depth 1)
161 s
162 (recur (close-menu s))))))
164 (defn-memo name-rival
165 ([] (name-rival (to-rival-name)))
166 ([script]
167 (->> script
168 (first-difference [] [:a] AF)
169 (first-difference [] [:r] DE)
170 (play-moves
171 [[]
172 [] [] [:r] [] [:d] [:a] ;; L
173 [:r] [] [:r] [] [:r] [] [:r] []
174 [:r] [] [:d] [] [:d] [:a] ;; [PK]
175 [:d] [] [:r] [:a]
176 ]))))
178 (defn-memo to-room-pc
179 ([] (to-room-pc (name-rival)))
180 ([script]
181 (->> script
182 finish-title
183 (walk [← ← ↑ ← ↑ ↑ ↑]))))
185 (defn-memo bootstrap-corrupt-save
186 ([] (bootstrap-corrupt-save (to-room-pc)))
187 ([script]
188 (->> script
189 (do-save-corruption 2)
190 (corrupt-item-list 0)
191 close-all-menus)))
193 (defn-memo begin-initial-deposits
194 ([] (begin-initial-deposits
195 (bootstrap-corrupt-save)))
196 ([script]
197 (->> script
198 (first-difference [] [:a] AF)
199 (scroll-text)
200 (set-cursor 1)
201 select-menu-entry)))
203 (defn wait-for-quantity
204 [[moves state :as script]]
205 (if (not= (item-quantity-selected state) 1)
206 (repeat-until-different [] item-quantity-selected script)
207 script))
209 (defn wait-for-cursor
210 [[moves state :as script]]
211 (if (not= (list-offset state) 0)
212 (repeat-until-different [] list-offset script)
213 script))
215 (defn deposit-held-item [n quantity [moves state :as script]]
216 (let [total-quantity (second (nth-item state n))]
217 (println "total-quantity" total-quantity)
218 (->> script
219 (set-cursor n)
220 (select-menu-entry 1)
221 (wait-for-quantity)
222 (set-quantity total-quantity quantity)
223 (delayed-difference [] [:a] 100 #(search-string % "stored"))
224 (scroll-text))))
226 (defn sell-held-item [n quantity [moves state :as script]]
227 (let [total-quantity (second (nth-item state n))]
228 (->> script
229 (wait-for-cursor) ;; when selling, the cursor always
230 (set-cursor n) ;; returns to the top of the list.
231 (select-menu-entry 1)
232 (wait-for-quantity)
233 (set-quantity total-quantity quantity)
234 (delayed-difference [] [:a] 100 current-depth)
235 (play-moves (repeat 20 [:b]))
236 (delayed-difference [] [:a] 100 #(search-string % "What"))
237 )))
239 (defn widthdraw-pc-item [n quantity [moves state :as script]]
240 (let [total-quantity (second (nth-pc-item state n))]
241 (->> script
242 (set-cursor n)
243 (select-menu-entry 1)
244 (wait-for-quantity)
245 (set-quantity total-quantity quantity)
246 (delayed-difference [] [:a] 100 #(search-string % "Withdrew"))
247 (scroll-text))))
249 (defn toss-held-item [n quantity [moves state :as script]]
250 (let [total-quantity (second (nth-item state n))]
251 (->> script
252 (set-cursor n)
253 (select-menu-entry 1)
254 (set-cursor-relative 1)
255 (select-menu-entry -1)
256 (wait-for-quantity)
257 (set-quantity total-quantity quantity)
258 (play-moves [[:a]])
259 (scroll-text)
260 (delayed-difference [] [:a] 100 #(search-string % "Threw"))
261 (scroll-text)
262 )))
264 (defn buy-item [n quantity [moves state :as script]]
265 (->> script
266 (set-cursor n)
267 (purchase-item quantity)))
270 (def desired-zero-quantities
271 (map second (filter (comp (partial = 0) first)
272 (partition 2 (pc-item-writer-program)))))
274 (defn-memo initial-deposits
275 ([] (initial-deposits (begin-initial-deposits)))
276 ([script]
277 (->> script
278 (deposit-held-item 0 0x1)
279 ((fn [script]
280 (reduce
281 (fn [script item] (deposit-held-item item 0xFF script))
282 script
283 (range 3 (+ 13 3)))))
284 close-all-menus)))
287 (defn-memo prepare-celadon-warp
288 ([] (prepare-celadon-warp (initial-deposits)))
289 ([script]
290 (->> script
291 (activate-start-menu)
292 (set-cursor-relative 1)
293 (select-menu-entry)
294 (toss-held-item 35 0xFA)
295 (close-all-menus))))
298 ;;0 -- 256
299 ;;1 -- 254
300 ;;2 -- 254
301 ;;3 -- 255
303 (defn-memo restore-items
304 ([] (restore-items (prepare-celadon-warp)))
305 ([script]
306 (->> script
307 (first-difference [] [:a] AF)
308 (scroll-text)
309 (select-menu-entry)
310 (widthdraw-pc-item 0 1)
311 ;;(widthdraw-pc-item 0 99)
312 ;;(widthdraw-pc-item 1 1)
313 (widthdraw-pc-item 13 255)
314 (close-all-menus))))
316 (defn-memo to-celadon
317 ([] (to-celadon (restore-items)))
318 ([script]
319 (->> script
320 (walk [→ → → → → → → ↑
321 ↓ ↓ ↓ ↓ ↓ ← ← ← ←
322 ↓ ↓]))))
325 ;; celadon store inventory
327 ;; Floor 2
328 ;;=====================================
329 ;; Great Ball TM32 (double-team)
330 ;; Super Potion TM33 (reflect)
331 ;; Revive TM02 (razor-wind)
332 ;; Super Repel TM07 (horn-drill)
333 ;; Antidote TM37 (egg-bomb)
334 ;; Burn Heal TM01 (mega-punch)
335 ;; Ice Heal TM05 (mega-kick)
336 ;; Awakening TM09 (take-down)
337 ;; Parlyz Heal TM17 (submission)
340 ;; Floor 3
341 ;;=====================================
342 ;; TM18 (counter)
345 ;; Floor 4
346 ;;=====================================
347 ;; Poke Doll
348 ;; Fire Stone
349 ;; Thunder Stone
350 ;; Water Stone
351 ;; Leaf Stone
353 ;; Floor 5
354 ;;=====================================
355 ;; X Accuracy HP UP
356 ;; Guard Spec. Protein
357 ;; Dire Hit Iron
358 ;; X Attack Carbos
359 ;; X Defend Calcium
360 ;; X Speed
361 ;; X Special
363 ;; Roof
364 ;;=====================================
365 ;; Fresh Water TM13 (ice-beam)
366 ;; Soda Pop TM48 (rock-slide)
367 ;; Lemonade :) TM49 (tri-attack)
370 (defn-memo go-to-floor-two
371 ([] (go-to-floor-two (to-celadon)))
372 ([script]
373 (->> script
374 (walk [↑ → → → → → → → → → → →
375 ↑ ↑ ↑ ↑ ↑ ↑
376 ← ← ← ←
377 ↓ ↓ ↓
378 ← ←])
379 (first-difference [] ↑ AF))))
381 (defn talk
382 "Assumes that you are facing something that initiates text and
383 causes it to do so."
384 [script]
385 (->> script
386 (delayed-difference [] [:a] 100
387 #(aget (memory %) text-address))))
389 (defn-memo get-money-floor-two
390 ([] (get-money-floor-two (go-to-floor-two)))
391 ([script]
392 (->> script
393 talk
394 (set-cursor 1)
395 (select-menu-entry)
396 (sell-held-item 0 1)
397 (sell-held-item 0 1)
398 (close-menu))))
400 (defn-memo floor-two-TMs
401 ([] (floor-two-TMs (get-money-floor-two)))
402 ([script]
403 (->> script
404 (wait-for-cursor)
405 (select-menu-entry)
406 (buy-item 2 98) ;; TM02 (razor-wind)
407 (buy-item 4 71) ;; TM37 (doubleteam)
408 (buy-item 5 63) ;; TM01 (mega-punch)
409 (buy-item 6 1) ;; TM05 (mega-kick)
410 (buy-item 7 56) ;; TM09 (take-down)
411 (close-menu))))
413 (defn end-shop-conversation
414 [script]
415 (->> script
416 (wait-until scroll-text [:b])
417 (play-moves [[] [:b]])
418 close-menu))
420 (defn-memo floor-two-more-money
421 ([] (floor-two-more-money (floor-two-TMs)))
422 ([script]
423 (->> script
424 (wait-for-cursor)
425 (set-cursor 1)
426 (select-menu-entry)
427 (sell-held-item 0 1)
428 (sell-held-item 0 1)
429 close-menu
430 end-shop-conversation)))
432 (defn turn [direction script]
433 (->> script
434 (first-difference [] direction AF)))
436 (defn-memo floor-two-items
437 ([] (floor-two-items (floor-two-more-money)))
438 ([script]
439 (->> script
440 (walk [←])
441 (turn ↑)
442 talk
443 select-menu-entry
444 (buy-item 5 12) ;; burn heal
445 (buy-item 6 55) ;; ice heal
446 (buy-item 7 4) ;; awakening
447 (buy-item 8 99) ;; parlyz heal
448 (buy-item 8 55) ;; parlyz heal
449 close-menu
450 end-shop-conversation)))
452 (defn-memo go-to-floor-three
453 ([] (go-to-floor-three (floor-two-items)))
454 ([script]
455 (->> script
456 (walk [→ → → → → → → → → → ↑ ↑ ↑
457 → ↑]))))
458 (defn-memo get-TM18
459 ([] (get-TM18 (go-to-floor-three)))
460 ([script]
461 (->> script
462 (walk [↓ ↓])
463 talk
464 (scroll-text 3)
465 end-text)))
467 (defn-memo go-to-floor-four
468 ([] (go-to-floor-four (get-TM18)))
469 ([script]
470 (->> script
471 (walk [← ← ← ← ↑ ↑
472 ↓ ← ← ↓ ↓ ↓
473 ← ← ← ← ←])
474 (turn ↓))))
476 (defn-memo floor-four-items
477 ([] (floor-four-items (go-to-floor-four)))
478 ([script]
479 (->> script
480 talk
481 select-menu-entry
482 (buy-item 1 23) ;; Fire Stone
483 (buy-item 2 98) ;; Thunder Stone
484 (buy-item 3 29) ;; Water Stone
485 close-menu
486 end-shop-conversation)))
488 (defn-memo go-to-floor-five
489 ([] (go-to-floor-five (floor-four-items)))
490 ([script]
491 (->> script
492 (walk [→ → → → → →
493 ↑ ↑ ↑
494 → → → → → ↑ ;; leave floor four
495 ↓ ← ← ← ← ← ← ← ←
496 ↓ ↓ ↓ ← ← ← ]);; go to five's clerk
497 (turn ↑))))
499 (defn-memo floor-five-items
500 ([] (floor-five-items (go-to-floor-five)))
501 ([script]
502 (->> script
503 talk
504 select-menu-entry
505 (buy-item 0 58) ;; X-Accuracy
506 (buy-item 1 99) ;; Guard Spec.
507 (buy-item 1 24) ;; Guard Spec.
508 close-menu
509 end-shop-conversation)))
511 (defn-memo go-to-roof
512 ([] (go-to-roof (floor-five-items)))
513 ([script]
514 (->> script
515 (walk [→ → → → ↑ ↑ ↑ → → → ↑ ;; leave floor five
516 ↓ ← ← ←]) ;; walk to vending machine
517 (turn ↑))))
519 (defn buy-drink
520 "Assumes you're in front of the vending machine. Buys the indicated
521 drink."
522 [n script]
523 (->> script
524 (do-nothing 20)
525 (play-moves [[:a][:a]])
526 scroll-text
527 (wait-for-cursor)
528 (set-cursor n)
529 select-menu-entry
530 close-menu))
532 (defn-memo roof-drinks
533 ([] (roof-drinks (go-to-roof)))
534 ([script]
535 (->> script
536 (buy-drink 0) ;; fresh water (for TM13)
537 ;; buy 16 lemonades
538 ;; LEMONADE is the best item <3 :)
539 (multiple-times 16 (partial buy-drink 2)))))
541 (defn-memo get-TM13
542 ([] (get-TM13 (roof-drinks)))
543 ([script]
544 (->> script
545 (walk [← ← ← ← ← ← ↓])
546 (play-moves [[][:a][:a][]])
547 (scroll-text 3)
548 select-menu-entry
549 select-menu-entry
550 (scroll-text 6)
551 close-menu)))
553 (defn-memo to-celadon-poke-center
554 ([] (to-celadon-poke-center (get-TM13)))
555 ([script]
556 (->> script
557 (walk [↑ → → → → → → → → → ↑]) ; leave roof
558 (walk [↓ ← ← ← ← ↓ ↓ ↓ ← ← ← ← ←
559 ↑ ↑ ↑ ← ← ↑]) ; to elevator
561 (walk [→ → ↑ ↑]) ; to controls
562 talk
563 select-menu-entry ; to floor 1
564 (walk [↓ ↓ ← ←])
565 (walk [↓ → ↓ ↓ ↓ ↓ ↓ ↓]) ; leave store
566 (walk [↓ → → → → → → → → → → ↑ ↑])
567 (walk (repeat 23 →))
568 (walk [↑ ↑ ↑ ↑]) ; enter poke center
569 (walk [↑ ↑ ↑ → → → → → → → → → →]) ; to computer
570 (turn ↑))))
572 (defn activate-rlm-pc [script]
573 (->> script
574 talk
575 scroll-text
576 wait-for-cursor
577 (set-cursor 1)
578 select-menu-entry
579 (scroll-text 2)))
581 (defn begin-deposit [script]
582 (->> script
583 (set-cursor 1)
584 select-menu-entry))
586 (defn begin-withdraw [script]
587 (->> script
588 (set-cursor 0)
589 (select-menu-entry)))
591 (defn deposit-held-item-named
592 [item-name quantity [moves state :as script]]
593 (let [index (count
594 (take-while
595 (fn [[name quant]]
596 (or (not= name item-name)
597 (< quant quantity)))
598 (inventory state)))]
599 (println "index" index)
600 (deposit-held-item index quantity script)))
603 (defn-memo begin-hacking
604 ([] (begin-hacking(to-celadon-poke-center)))
605 ([script]
606 (->> script
607 activate-rlm-pc
608 begin-deposit
609 (deposit-held-item-named 0x00 30)
610 (deposit-held-item-named :TM01 63)
611 (deposit-held-item-named :awakening 4)
612 (deposit-held-item-named :thunderstone 98)
613 (deposit-held-item-named :TM09 55)
614 (deposit-held-item-named 0x00 55))))
616 (defn open-held-items
617 [script]
618 (->> script
619 select-menu-entry))
621 (defn-memo hacking-2
622 ([] (hacking-2 (begin-hacking)))
623 ([script]
624 (->> script
625 close-menu
626 close-menu
627 end-text;;; grr
629 activate-start-menu
630 open-held-items
631 (toss-held-item 0 166) ;; discard cruft
632 close-menu
633 close-menu)))
635 (defn-memo hacking-3
636 ([] (hacking-3 (hacking-2)))
637 ([script]
638 (->> script
639 activate-rlm-pc
640 begin-withdraw
641 (widthdraw-pc-item 0 99)
642 (widthdraw-pc-item 0 1)
643 (widthdraw-pc-item 2 0xFE)
644 (widthdraw-pc-item 3 0xFE))))