view clojure/com/aurellem/gb/hxc.clj @ 490:151c96d60921

edit to image.clj
author Robert McIntyre <rlm@mit.edu>
date Mon, 11 Jun 2012 00:53:20 -0500
parents acc3d1ad24e8
children
line wrap: on
line source

2 (ns com.aurellem.gb.hxc
3 (:use (com.aurellem.gb assembly characters gb-driver util mem-util
4 constants species))
5 (:import [com.aurellem.gb.gb_driver SaveState]))
7 ; ************* HANDWRITTEN CONSTANTS
9 (def pkmn-types
10 [:normal ;;0
11 :fighting ;;1
12 :flying ;;2
13 :poison ;;3
14 :ground ;;4
15 :rock ;;5
16 :bird ;;6
17 :bug ;;7
18 :ghost ;;8
19 :A
20 :B
21 :C
22 :D
23 :E
24 :F
25 :G
26 :H
27 :I
28 :J
29 :K
30 :fire ;;20 (0x14)
31 :water ;;21 (0x15)
32 :grass ;;22 (0x16)
33 :electric ;;23 (0x17)
34 :psychic ;;24 (0x18)
35 :ice ;;25 (0x19)
36 :dragon ;;26 (0x1A)
37 ])
40 ;; question: when status effects claim to take
41 ;; their accuracy from the move accuracy, does
42 ;; this mean that the move always "hits" but the
43 ;; status effect may not?
45 (def move-effects
46 ["normal damage"
47 "no damage, just opponent sleep" ;; how many turns? is atk power ignored?
48 "0x4C chance of poison"
49 "leech half of inflicted damage"
50 "0x19 chance of burn"
51 "0x19 chance of freeze"
52 "0x19 chance of paralyze"
53 "user faints; opponent defense halved during attack."
54 "leech half of inflicted damage ONLY if sleeping opponent."
55 "imitate last attack"
56 "user atk +1"
57 "user def +1"
58 "user spd +1"
59 "user spc +1"
60 "user acr +1" ;; unused?!
61 "user evd +1"
62 "get post-battle $ = 2*level*uses"
63 "0xFE acr, no matter what."
64 "opponent atk -1" ;; acr taken from move acr?
65 "opponent def -1" ;;
66 "opponent spd -1" ;;
67 "opponent spc -1" ;;
68 "opponent acr -1";;
69 "opponent evd -1"
70 "converts user's type to opponent's."
71 "(haze)"
72 "(bide)"
73 "(thrash)"
74 "(teleport)"
75 "(fury swipes)"
76 "attacks 2-5 turns" ;; unused? like rollout?
77 "0x19 chance of flinch"
78 "opponent sleep for 1-7 turns"
79 "0x66 chance of poison"
80 "0x4D chance of burn"
81 "0x4D chance of freeze"
82 "0x4D chance of paralyze"
83 "0x4D chance of flinch"
84 "one-hit KO"
85 "charge one turn, atk next."
86 "fixed damage, leaves 1HP." ;; how is dmg determined?
87 "fixed damage." ;; cf seismic toss, dragon rage, psywave.
88 "atk 2-5 turns; opponent can't attack" ;; unnormalized? (0 0x60 0x60 0x20 0x20)
89 "charge one turn, atk next. (can't be hit when charging)"
90 "atk hits twice."
91 "user takes 1 damage if misses."
92 "evade status-lowering effects" ;;caused by you or also your opponent?
93 "(broken) if user is slower than opponent, makes critical hit impossible, otherwise has no effect"
94 "atk causes recoil dmg = 1/4 dmg dealt"
95 "confuses opponent" ;; acr taken from move acr
96 "user atk +2"
97 "user def +2"
98 "user spd +2"
99 "user spc +2"
100 "user acr +2" ;; unused!
101 "user evd +2" ;; unused!
102 "restores up to half of user's max hp." ;; broken: fails if the difference
103 ;; b/w max and current hp is one less than a multiple of 256.
104 "(transform)"
105 "opponent atk -2"
106 "opponent def -2"
107 "opponent spd -2"
108 "opponent spc -2"
109 "opponent acr -2"
110 "opponent evd -2"
111 "doubles user spc when attacked"
112 "doubles user def when attacked"
113 "just poisons opponent" ;;acr taken from move acr
114 "just paralyzes opponent" ;;
115 "0x19 chance opponent atk -1"
116 "0x19 chance opponent def -1"
117 "0x19 chance opponent spd -1"
118 "0x4C chance opponent spc -1" ;; context suggest chance is 0x19
119 "0x19 chance opponent acr -1"
120 "0x19 chance opponent evd -1"
121 "???" ;; unused? no effect?
122 "???" ;; unused? no effect?
123 "0x19 chance opponent confused"
124 "atk hits twice. 0x33 chance opponent poisioned."
125 "broken. crash the game after attack."
126 "(substitute)"
127 "unless opponent faints, user must recharge after atk. some
128 exceptions apply."
129 "(rage)"
130 "(mimic)"
131 "(metronome)"
132 "(leech seed)"
133 "does nothing (splash)"
134 "(disable)"
135 ])
137 ;; ************** HARDCODED DATA
139 (defn hxc-thunk
140 "Creates a thunk (nullary fn) that grabs data in a certain region of rom and
141 splits it into a collection by 0x50. If rom is not supplied, uses the
142 original rom data."
143 [start length]
144 (fn self
145 ([rom]
146 (take-nth 2
147 (partition-by #(= % 0x50)
148 (take length
149 (drop start rom)))))
150 ([]
151 (self com.aurellem.gb.gb-driver/original-rom))))
153 (def hxc-thunk-words
154 "Same as hxc-thunk, except it interprets the rom data as characters,
155 returning a collection of strings."
156 (comp
157 (partial comp (partial map character-codes->str))
158 hxc-thunk))
160 ;; --------------------------------------------------
163 (defn hxc-pokenames-raw
164 "The hardcoded names of the 190 species in memory. List begins at
165 ROM@E8000. Although names in memory are padded with 0x50 to be 10 characters
166 long, these names are stripped of padding. See also, hxc-pokedex-names"
167 ([]
168 (hxc-pokenames-raw com.aurellem.gb.gb-driver/original-rom))
169 ([rom]
170 (let [count-species 190
171 name-length 10]
172 (map character-codes->str
173 (partition name-length
174 (map #(if (= 0x50 %) 0x00 %)
175 (take (* count-species name-length)
176 (drop 0xE8000
177 rom))))))))
178 (def hxc-pokenames
179 (comp
180 (partial map format-name)
181 hxc-pokenames-raw))
186 (defn hxc-pokedex-names
187 "The names of the pokemon in hardcoded pokedex order. List of the
188 pokedex numbers of each pokemon (in internal order) begins at
189 ROM@410B1. See also, hxc-pokenames."
190 ([] (hxc-pokedex-names
191 com.aurellem.gb.gb-driver/original-rom))
192 ([rom]
193 (let [names (hxc-pokenames rom)]
194 (#(mapv %
195 ((comp range count keys) %))
196 (zipmap
197 (take (count names)
198 (drop 0x410b1 rom))
200 names)))))
202 (def hxc-types
203 "The hardcoded type names in memory. List begins at ROM@27D99,
204 shortly before hxc-titles."
205 (hxc-thunk-words 0x27D99 102))
208 ;; http://hax.iimarck.us/topic/581/
209 (defn hxc-cry
210 "The pokemon cry data in internal order. List begins at ROM@39462"
211 ([](hxc-cry com.aurellem.gb.gb-driver/original-rom))
212 ([rom]
213 (zipmap
214 (hxc-pokenames rom)
215 (map
216 (fn [[cry-id pitch length]]
217 {:cry-id cry-id
218 :pitch pitch
219 :length length}
220 )
221 (partition 3
222 (drop 0x39462 rom))))))
224 (defn hxc-cry-groups
225 ([] (hxc-cry-groups com.aurellem.gb.gb-driver/original-rom))
226 ([rom]
227 (map #(mapv first
228 (filter
229 (fn [[k v]]
230 (= % (:cry-id v)))
231 (hxc-cry)))
232 ((comp
233 range
234 count
235 set
236 (partial map :cry-id)
237 vals
238 hxc-cry)
239 rom))))
242 (defn cry-conversion!
243 "Convert Porygon's cry in ROM to be the cry of the given pokemon."
244 [pkmn]
245 (write-rom!
246 (rewrite-memory
247 (vec(rom))
248 0x3965D
249 (map second
250 ((hxc-cry) pkmn)))))
255 (def hxc-items-raw
256 "The hardcoded names of the items in memory. List begins at
257 ROM@045B7"
258 (hxc-thunk-words 0x45B7 870))
260 (def hxc-items
261 "The hardcoded names of the items in memory, presented as
262 keywords. List begins at ROM@045B7. See also, hxc-items-raw."
263 (comp (partial map format-name) hxc-items-raw))
267 (def hxc-titles
268 "The hardcoded names of the trainer titles in memory. List begins at
269 ROM@27E77"
270 (hxc-thunk-words 0x27E77 196))
273 (def hxc-pokedex-text-raw
274 "The hardcoded pokedex entries in memory. List begins at
275 ROM@B8000, shortly before move names."
276 (hxc-thunk-words 0xB8000 14754))
281 (defn hxc-pokedex-text
282 "The hardcoded pokedex entries in memory, presented as an
283 associative hash map. List begins at ROM@B8000."
284 ([] (hxc-pokedex-text com.aurellem.gb.gb-driver/original-rom))
285 ([rom]
286 (zipmap
287 (hxc-pokedex-names rom)
288 (cons nil ;; for missingno.
289 (hxc-pokedex-text-raw rom)))))
291 ;; In red/blue, pokedex stats are in internal order.
292 ;; In yellow, pokedex stats are in pokedex order.
293 (defn hxc-pokedex-stats
294 "The hardcoded pokedex stats (species height weight) in memory. List
295 begins at ROM@40687"
296 ([] (hxc-pokedex-stats com.aurellem.gb.gb-driver/original-rom))
297 ([rom]
298 (let [pokedex-names (zipmap (range) (hxc-pokedex-names rom))
299 pkmn-count (count pokedex-names)
300 ]
301 ((fn capture-stats
302 [n stats data]
303 (if (zero? n) stats
304 (let [[species
305 [_
306 height-ft
307 height-in
308 weight-1
309 weight-2
310 _
311 dex-ptr-1
312 dex-ptr-2
313 dex-bank
314 _
315 & data]]
316 (split-with (partial not= 0x50) data)]
317 (recur (dec n)
318 (assoc stats
319 (pokedex-names (- pkmn-count (dec n)))
320 {:species
321 (format-name (character-codes->str species))
322 :height-ft
323 height-ft
324 :height-in
325 height-in
326 :weight
327 (/ (low-high weight-1 weight-2) 10.)
329 ;; :text
330 ;; (character-codes->str
331 ;; (take-while
332 ;; (partial not= 0x50)
333 ;; (drop
334 ;; (+ 0xB8000
335 ;; -0x4000
336 ;; (low-high dex-ptr-1 dex-ptr-2))
337 ;; rom)))
338 })
340 data)
343 )))
345 pkmn-count
346 {}
347 (drop 0x40687 rom))) ))
352 (def hxc-places
353 "The hardcoded place names in memory. List begins at
354 ROM@71500. [Cinnabar/Celadon] Mansion seems to be dynamically calculated."
355 (hxc-thunk-words 0x71500 560))
357 (defn hxc-dialog
358 "The hardcoded dialogue in memory, including in-game alerts. Dialog
359 seems to be separated by 0x57 instead of 0x50 (END). Begins at ROM@98000."
360 ([rom]
361 (map character-codes->str
362 (take-nth 2
363 (partition-by #(= % 0x57)
364 (take 0x0F728
365 (drop 0x98000 rom))))))
366 ([]
367 (hxc-dialog com.aurellem.gb.gb-driver/original-rom)))
370 (def hxc-move-names
371 "The hardcoded move names in memory. List begins at ROM@BC000"
372 (hxc-thunk-words 0xBC000 1551))
373 (defn hxc-move-data
374 "The hardcoded (basic (move effects)) in memory. List begins at
375 0x38000. Returns a map of {:name :power :accuracy :pp :fx-id
376 :fx-txt}. The move descriptions are handwritten, not hardcoded."
377 ([]
378 (hxc-move-data com.aurellem.gb.gb-driver/original-rom))
379 ([rom]
380 (let [names (vec (hxc-move-names rom))
381 move-count (count names)
382 move-size 6
383 types pkmn-types ;;; !! hardcoded types
384 ]
385 (zipmap (map format-name names)
386 (map
387 (fn [[idx effect power type-id accuracy pp]]
388 {:name (names (dec idx))
389 :power power
390 :accuracy accuracy
391 :pp pp
392 :type (types type-id)
393 :fx-id effect
394 :fx-txt (get move-effects effect)
395 }
396 )
398 (partition move-size
399 (take (* move-size move-count)
400 (drop 0x38000 rom))))))))
404 (defn hxc-move-data*
405 "Like hxc-move-data, but reports numbers as hexadecimal symbols instead."
406 ([]
407 (hxc-move-data* com.aurellem.gb.gb-driver/original-rom))
408 ([rom]
409 (let [names (vec (hxc-move-names rom))
410 move-count (count names)
411 move-size 6
412 format-name (fn [s]
413 (keyword (.toLowerCase
414 (apply str
415 (map #(if (= % \space) "-" %) s)))))
416 ]
417 (zipmap (map format-name names)
418 (map
419 (fn [[idx effect power type accuracy pp]]
420 {:name (names (dec idx))
421 :power power
422 :accuracy (hex accuracy)
423 :pp pp
424 :fx-id (hex effect)
425 :fx-txt (get move-effects effect)
426 }
427 )
429 (partition move-size
430 (take (* move-size move-count)
431 (drop 0x38000 rom))))))))
434 (defn hxc-machines
435 "The hardcoded moves taught by TMs and HMs. List begins at ROM@1232D."
436 ([] (hxc-machines
437 com.aurellem.gb.gb-driver/original-rom))
438 ([rom]
439 (let [moves (hxc-move-names rom)]
440 (zipmap
441 (range)
442 (take-while
443 (comp not nil?)
444 (map (comp
445 format-name
446 (zipmap
447 (range)
448 moves)
449 dec)
450 (take 100
451 (drop 0x1232D rom))))))))
456 (defn internal-id
457 ([rom]
458 (zipmap
459 (hxc-pokenames rom)
460 (range)))
461 ([]
462 (internal-id com.aurellem.gb.gb-driver/original-rom)))
468 ;; nidoran gender change upon levelup
469 ;; (->
470 ;; @current-state
471 ;; rom
472 ;; vec
473 ;; (rewrite-memory
474 ;; (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♂))
475 ;; [1 1 15])
476 ;; (rewrite-memory
477 ;; (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♀))
478 ;; [1 1 3])
479 ;; (write-rom!)
481 ;; )
485 (defn hxc-advantage
486 ;; in-game multipliers are stored as 10x their effective value
487 ;; to allow for fractional multipliers like 1/2
489 "The hardcoded type advantages in memory, returned as tuples of
490 atk-type def-type multiplier. By default (i.e. if not listed here),
491 the multiplier is 1. List begins at 0x3E62D."
492 ([] (hxc-advantage com.aurellem.gb.gb-driver/original-rom))
493 ([rom]
494 (map
495 (fn [[atk def mult]] [(get pkmn-types atk (hex atk))
496 (get pkmn-types def (hex def))
497 (/ mult 10)])
498 (partition 3
499 (take-while (partial not= 0xFF)
500 (drop 0x3E62D rom))))))
504 (defn format-evo
505 "Parse a sequence of evolution data, returning a map. First is the
506 method: 0 = end-evolution-data. 1 = level-up, 2 = item, 3 = trade. Next is an item id, if the
507 method of evolution is by item (only stones will actually make pokemon
508 evolve, for some auxillary reason.) Finally, the minimum level for
509 evolution to occur (level 1 means no limit, which is used for trade
510 and item evolutions), followed by the internal id of the pokemon
511 into which to evolve. Hence, level up and trade evolutions are
512 described with 3
513 bytes; item evolutions with four."
514 [coll]
515 (let [method (first coll)]
516 (cond (empty? coll) []
517 (= 0 method) [] ;; just in case
518 (= 1 method) ;; level-up evolution
519 (conj (format-evo (drop 3 coll))
520 {:method :level-up
521 :min-level (nth coll 1)
522 :into (dec (nth coll 2))})
524 (= 2 method) ;; item evolution
525 (conj (format-evo (drop 4 coll))
526 {:method :item
527 :item (dec (nth coll 1))
528 :min-level (nth coll 2)
529 :into (dec (nth coll 3))})
531 (= 3 method) ;; trade evolution
532 (conj (format-evo (drop 3 coll))
533 {:method :trade
534 :min-level (nth coll 1) ;; always 1 for trade.
535 :into (dec (nth coll 2))}))))
538 (defn hxc-ptrs-evolve
539 "A hardcoded collection of 190 pointers to alternating evolution/learnset data,
540 in internal order."
541 ([]
542 (hxc-ptrs-evolve com.aurellem.gb.gb-driver/original-rom))
543 ([rom]
544 (let [
545 pkmn-count (count (hxc-pokenames-raw)) ;; 190
546 ptrs
547 (map (fn [[a b]] (low-high a b))
548 (partition 2
549 (take (* 2 pkmn-count)
550 (drop 0x3b1e5 rom))))]
551 (map (partial + 0x34000) ptrs)
553 )))
555 (defn hxc-evolution
556 "Hardcoded evolution data in memory. The data exists at ROM@34000,
557 sorted by internal order. Pointers to the data exist at ROM@3B1E5; see also, hxc-ptrs-evolve."
558 ([] (hxc-evolution com.aurellem.gb.gb-driver/original-rom))
559 ([rom]
560 (apply assoc {}
561 (interleave
562 (hxc-pokenames rom)
563 (map
564 (comp
565 format-evo
566 (partial take-while (comp not zero?))
567 #(drop % rom))
568 (hxc-ptrs-evolve rom)
569 )))))
571 (defn hxc-evolution-pretty
572 "Like hxc-evolution, except it uses the names of items and pokemon
573 --- grabbed from ROM --- rather than their numerical identifiers."
574 ([] (hxc-evolution-pretty com.aurellem.gb.gb-driver/original-rom))
575 ([rom]
576 (let
577 [poke-names (vec (hxc-pokenames rom))
578 item-names (vec (hxc-items rom))
579 use-names
580 (fn [m]
581 (loop [ks (keys m) new-map m]
582 (let [k (first ks)]
583 (cond (nil? ks) new-map
584 (= k :into)
585 (recur
586 (next ks)
587 (assoc new-map
588 :into
589 (poke-names
590 (:into
591 new-map))))
592 (= k :item)
593 (recur
594 (next ks)
595 (assoc new-map
596 :item
597 (item-names
598 (:item new-map))))
599 :else
600 (recur
601 (next ks)
602 new-map)
603 ))))]
605 (into {}
606 (map (fn [[pkmn evo-coll]]
607 [pkmn (map use-names evo-coll)])
608 (hxc-evolution rom))))))
613 (defn hxc-learnsets
614 "Hardcoded map associating pokemon names to lists of pairs [lvl
615 move] of abilities they learn as they level up. The data
616 exists at ROM@34000, sorted by internal order. Pointers to the data
617 exist at ROM@3B1E5; see also, hxc-ptrs-evolve"
618 ([] (hxc-learnsets com.aurellem.gb.gb-driver/original-rom))
619 ([rom]
620 (apply assoc
621 {}
622 (interleave
623 (hxc-pokenames rom)
624 (map (comp
625 (partial map
626 (fn [[lvl mv]] [lvl (dec mv)]))
627 (partial partition 2)
628 ;; keep the learnset data
629 (partial take-while (comp not zero?))
630 ;; skip the evolution data
631 rest
632 (partial drop-while (comp not zero?)))
633 (map #(drop % rom)
634 (hxc-ptrs-evolve rom)))))))
636 (defn hxc-learnsets-pretty
637 "Live hxc-learnsets except it reports the name of each move --- as
638 it appears in rom --- rather than the move index."
639 ([] (hxc-learnsets-pretty com.aurellem.gb.gb-driver/original-rom))
640 ([rom]
641 (let [moves (vec(map format-name (hxc-move-names)))]
642 (into {}
643 (map (fn [[pkmn learnset]]
644 [pkmn (map (fn [[lvl mv]] [lvl (moves mv)])
645 learnset)])
646 (hxc-learnsets rom))))))
650 (defn hxc-pokemon-base
651 ([] (hxc-pokemon-base com.aurellem.gb.gb-driver/original-rom))
652 ([rom]
653 (let [entry-size 28
655 pokemon (rest (hxc-pokedex-names))
656 pkmn-count (inc(count pokemon))
657 types (apply assoc {}
658 (interleave
659 (range)
660 pkmn-types)) ;;!! softcoded
661 moves (apply assoc {}
662 (interleave
663 (range)
664 (map format-name
665 (hxc-move-names rom))))
666 machines (hxc-machines)
667 ]
668 (zipmap
669 pokemon
670 (map
671 (fn [[n
672 rating-hp
673 rating-atk
674 rating-def
675 rating-speed
676 rating-special
677 type-1
678 type-2
679 rarity
680 rating-xp
681 pic-dimensions ;; tile_width|tile_height (8px/tile)
682 ptr-pic-obverse-1
683 ptr-pic-obverse-2
684 ptr-pic-reverse-1
685 ptr-pic-reverse-2
686 move-1
687 move-2
688 move-3
689 move-4
690 growth-rate
691 &
692 TMs|HMs]]
693 (let
694 [base-moves
695 (mapv moves
696 ((comp
697 ;; since the game uses zero as a delimiter,
698 ;; it must also increment all move indices by 1.
699 ;; heren we decrement to correct this.
700 (partial map dec)
701 (partial take-while (comp not zero?)))
702 [move-1 move-2 move-3 move-4]))
704 types
705 (set (list (types type-1)
706 (types type-2)))
707 TMs|HMs
708 (map
709 (comp
710 (partial map first)
711 (partial remove (comp zero? second)))
712 (split-at
713 50
714 (map vector
715 (rest(range))
716 (reduce concat
717 (map
718 #(take 8
719 (concat (bit-list %)
720 (repeat 0)))
722 TMs|HMs)))))
724 TMs (vec (first TMs|HMs))
725 HMs (take 5 (map (partial + -50) (vec (second TMs|HMs))))
728 ]
731 {:dex# n
732 :base-moves base-moves
733 :types types
734 :TMs TMs
735 :HMs HMs
736 :base-hp rating-hp
737 :base-atk rating-atk
738 :base-def rating-def
739 :base-speed rating-speed
740 :base-special rating-special
741 :o0 pic-dimensions
742 :o1 ptr-pic-obverse-1
743 :o2 ptr-pic-obverse-2
744 }))
746 (partition entry-size
747 (take (* entry-size pkmn-count)
748 (drop 0x383DE
749 rom))))))))
753 (defn hxc-intro-pkmn
754 "The hardcoded pokemon to display in Prof. Oak's introduction; the pokemon's
755 internal id is stored at ROM@5EDB."
756 ([] (hxc-intro-pkmn
757 com.aurellem.gb.gb-driver/original-rom))
758 ([rom]
759 (nth (hxc-pokenames rom) (nth rom 0x5EDB))))
761 (defn sxc-intro-pkmn!
762 "Set the hardcoded pokemon to display in Prof. Oak's introduction."
763 [pokemon]
764 (write-rom!
765 (rewrite-rom 0x5EDB
766 [
767 (inc
768 ((zipmap
769 (hxc-pokenames)
770 (range))
771 pokemon))])))
774 (defn hxc-item-prices
775 "The hardcoded list of item prices in memory. List begins at ROM@4495"
776 ([] (hxc-item-prices com.aurellem.gb.gb-driver/original-rom))
777 ([rom]
778 (let [items (hxc-items rom)
779 price-size 3]
780 (zipmap items
781 (map (comp
782 ;; zero-cost items are "priceless"
783 #(if (zero? %) :priceless %)
784 decode-bcd butlast)
785 (partition price-size
786 (take (* price-size (count items))
787 (drop 0x4495 rom))))))))
789 (defn hxc-shops
790 ([] (hxc-shops com.aurellem.gb.gb-driver/original-rom))
791 ([rom]
792 (let [items (zipmap (range) (hxc-items rom))
794 ;; temporarily softcode the TM items
795 items (into
796 items
797 (map (juxt identity
798 (comp keyword
799 (partial str "tm-")
800 (partial + 1 -200)
801 ))
802 (take 200 (drop 200 (range)))))
804 ]
806 ((fn parse-shop [coll [num-items & items-etc]]
807 (let [inventory (take-while
808 (partial not= 0xFF)
809 items-etc)
810 [separator & items-etc] (drop num-items (rest items-etc))]
811 (if (= separator 0x50)
812 (map (partial mapv (comp items dec)) (conj coll inventory))
813 (recur (conj coll inventory) items-etc)
814 )
815 ))
817 '()
818 (drop 0x233C rom))
821 )))
826 (defn hxc-ptrs-wild
827 "A list of the hardcoded wild encounter data in memory. Pointers
828 begin at ROM@0CB95; data begins at ROM@0x04D89"
829 ([] (hxc-ptrs-wild com.aurellem.gb.gb-driver/original-rom))
830 ([rom]
831 (let [ptrs
832 (map (fn [[a b]] (+ a (* 0x100 b)))
833 (take-while (partial not= (list 0xFF 0xFF))
834 (partition 2 (drop 0xCB95 rom))))]
835 ptrs)))
839 (defn hxc-wilds
840 "A list of the hardcoded wild encounter data in memory. Pointers
841 begin at ROM@0CB95; data begins at ROM@0x04D89"
842 ([] (hxc-wilds com.aurellem.gb.gb-driver/original-rom))
843 ([rom]
844 (let [pokenames (zipmap (range) (hxc-pokenames rom))]
845 (map
846 (partial map (fn [[a b]] {:species (pokenames (dec b)) :level
847 a}))
848 (partition 10
850 (take-while (comp (partial not= 1)
851 first)
852 (partition 2
853 (drop 0xCD8C rom))
855 ))))))
859 ;; ********************** MANIPULATION FNS
862 (defn same-type
863 ([pkmn move]
864 (same-type
865 com.aurellem.gb.gb-driver/original-rom pkmn move))
866 ([rom pkmn move]
867 (((comp :types (hxc-pokemon-base rom)) pkmn)
868 ((comp :type (hxc-move-data rom)) move))))
873 (defn submap?
874 "Compares the two maps. Returns true if map-big has the same associations as map-small, otherwise false."
875 [map-small map-big]
876 (cond (empty? map-small) true
877 (and
878 (contains? map-big (ffirst map-small))
879 (= (get map-big (ffirst map-small))
880 (second (first map-small))))
881 (recur (next map-small) map-big)
883 :else false))
886 (defn search-map [proto-map maps]
887 "Returns all the maps that make the same associations as proto-map."
888 (some (partial submap? proto-map) maps))
890 (defn filter-vals
891 "Returns a map consisting of all the pairs [key val] for
892 which (pred key) returns true."
893 [pred map]
894 (reduce (partial apply assoc) {}
895 (filter (fn [[k v]] (pred v)) map)))
898 (defn search-moves
899 "Returns a subcollection of all hardcoded moves with the
900 given attributes. Attributes consist of :name :power
901 :accuracy :pp :fx-id
902 (and also :fx-txt, but it contains the same information
903 as :fx-id)"
904 ([attribute-map]
905 (search-moves
906 com.aurellem.gb.gb-driver/original-rom attribute-map))
907 ([rom attribute-map]
908 (filter-vals (partial submap? attribute-map)
909 (hxc-move-data rom))))
915 ;; note: 0x2f31 contains the names "TM" "HM"?
917 ;; note for later: credits start at F1290
919 ;; note: DADB hyper-potion-hp _ _ _ super-potion-hp _ _ _ potion-hp ??
921 ;; note: DD4D spells out pokemon vital stat names ("speed", etc.)
923 ;; note: 1195C-6A says ABLE#NOT ABLE#, but so does 119C0-119CE.
924 ;; The first instance is for Machines; the second, for stones.
926 ;; note: according to
927 ;; http://www.upokecenter.com/games/rby/guides/rgbtrainers.php
928 ;; the amount of money given by a trainer is equal to the
929 ;; base money times the level of the last Pokemon on that trainer's
930 ;; list. Other sources say it's the the level of the last pokemon
931 ;; /defeated/.
933 ;; todo: find base money.
936 ;; note: 0xDFEA (in indexable mem) is the dex# of the currently-viewed Pokemon in
937 ;; in the pokedex. It's used for other purposes if there is none.
939 ;; note: 0x9D35 (index.) switches from 0xFF to 0x00 temporarily when
940 ;; you walk between areas.
942 ;; note: 0xD059 (index.) is the special battle type of your next battle:
943 ;; - 00 is a usual battle
944 ;; - 01 is a pre-scripted OLD MAN battle which always fails to catch the
945 ;; target Pokemon.
946 ;; - 02 is a safari zone battle
947 ;; - 03 obligates you to run away. (unused)
948 ;; - 04 is a pre-scripted OAK battle, which (temporarily) causes the
949 ;; enemy Pokemon to cry PIKAAA, and which always catches the target
950 ;; Pokemon. The target Pokemon is erased after the battle.
951 ;; - 05+ are glitch states in which you are sort of the Pokemon.
954 ;; note: 0x251A (in indexable mem): image decompression routine seems to begin here.
956 ;; note: 0x4845 (index): vending inventory is loaded here. possibly
957 ;; other things, too.
958 (comment
959 ;; temporarily intercept/adjust what pops out of the vending
960 ;; machine.
961 ;; (and how much it costs)
963 ;; located at 0x4845
964 ;; not to be confused with shop inventory, 0xCF7B
965 (do
966 (step (read-state "vend-menu"))
967 (write-memory! (rewrite-memory (vec(memory)) 0x4845 [2 0 1 0]))
968 (step @current-state [:a])
969 (step @current-state [])
970 (nstep @current-state 200) ))
973 ;; Note: There are two tile tables, one from 8000-8FFF, the other from
974 ;; 8800-97FF. The latter contains symbols, possibly map tiles(?), with some japanese chars and stuff at the end.
975 (defn print-pixel-letters!
976 "The pixel tiles representing letters. Neat!"
977 ([] (print-pixel-letters! (read-state "oak-speaks")))
978 ([state]
979 (map
980 (comp
981 println
982 (partial map #(if (zero? %) \space 0))
983 #(if (< (count %) 8)
984 (recur (cons 0 %))
985 %)
986 reverse bit-list)
988 (take 0xFFF (drop 0x8800 (memory state))))))
991 ;; (defn test-2 []
992 ;; (loop [n 0
993 ;; pc-1 (pc-trail (-> state-defend (tick) (step [:a]) (step [:a]) (step []) (nstep 100)) 100000)
994 ;; pc-2 (pc-trail (-> state-speed (tick) (step [:a]) (step [:a])
995 ;; (step []) (nstep 100)) 100000)]
996 ;; (cond (empty? (drop n pc-1)) [pc-1 n]
997 ;; (not= (take 10 (drop n pc-1)) (take 10 pc-2))
998 ;; (recur pc-1 pc-2 (inc n))
999 ;; :else
1000 ;; [(take 1000 pc-2) n])))
1005 (defn test-3
1006 "Explore trainer data"
1007 ([] (test-3 0x3A289))
1008 ([start]
1009 (let [pokenames (vec(hxc-pokenames-raw))]
1010 (println
1011 (reduce
1012 str
1013 (map
1014 (fn [[adr lvl pkmn]]
1015 (str (format "%-11s %4d %02X %02X \t %05X\n"
1017 (cond
1018 (zero? lvl) "+"
1019 (nil? (get pokenames (dec pkmn)))
1020 "-"
1021 :else
1022 (get pokenames (dec pkmn)))
1023 lvl
1024 pkmn
1025 lvl
1026 adr
1027 )))
1028 (map cons
1029 (take-nth 2 (drop start (range)))
1030 (partition 2
1031 (take 400;;703
1032 (drop
1033 start
1034 ;; 0x3A75D
1035 (rom)))))))))))
1037 (defn search-memory* [mem codes k]
1038 (loop [index 0
1039 index-next 1
1040 start-match 0
1041 to-match codes
1042 matches []]
1043 (cond
1044 (>= index (count mem)) matches
1046 (empty? to-match)
1047 (recur
1048 index-next
1049 (inc index-next)
1050 index-next
1051 codes
1052 (conj matches
1053 [(hex start-match) (take k (drop start-match mem))])
1056 (or (= (first to-match) \_) ;; wildcard
1057 (= (first to-match) (nth mem index)))
1058 (recur
1059 (inc index)
1060 index-next
1061 start-match
1062 (rest to-match)
1063 matches)
1065 :else
1066 (recur
1067 index-next
1068 (inc index-next)
1069 index-next
1070 codes
1071 matches))))
1074 (defn search-pattern [ptn coll]
1075 (loop
1076 [index 0
1077 to-match ptn
1078 binds {}
1080 next-index 1
1081 match-start 0
1082 matches []]
1084 (cond
1085 (>= index (count coll)) matches
1086 (empty? to-match)
1087 (recur
1088 next-index
1089 ptn
1090 {}
1091 (inc next-index)
1092 next-index
1093 (conj match-start
1094 [(hex match-start) binds]))
1096 :else
1097 (let [k (first to-match)
1098 v (nth coll index)]
1099 (cond
1100 (= k \_) ;; wildcard
1101 (recur
1102 (inc index)
1103 (rest to-match)
1104 binds
1106 next-index
1107 match-start
1108 matches)
1110 (keyword? k)
1111 (if (binds k)
1112 (if (= (binds k) v)
1114 ;; consistent bindings
1115 (recur
1116 (inc index)
1117 (rest to-match)
1118 binds
1120 next-index
1121 match-start
1122 matches)
1124 ;; inconsistent bindings
1125 (recur
1126 next-index
1127 ptn
1128 {}
1129 (inc next-index)
1130 next-index
1131 matches))
1133 (if ((set (vals binds)) v)
1134 ;; bindings are not unique
1135 (recur
1136 next-index
1137 ptn
1138 {}
1139 (inc next-index)
1140 next-index
1141 matches)
1143 ;; bindings are unique
1144 (recur
1145 (inc index)
1146 (rest to-match)
1147 (assoc binds k v)
1149 next-index
1150 match-start
1151 matches)))
1153 :else ;; k is just a number
1154 (if (= k v)
1155 (recur
1156 (inc index)
1157 (rest to-match)
1158 binds
1160 next-index
1161 match-start
1162 matches)
1164 (recur
1165 next-index
1166 ptn
1167 {}
1168 (inc next-index)
1169 next-index
1170 matches)))))))
1180 (defn search-pattern* [ptn coll]
1181 (loop
1183 binds {}
1184 index 0
1185 index-next 1
1186 start-match 0
1187 to-match ptn
1188 matches []]
1190 (cond
1191 (>= index (count coll)) matches
1192 (empty? to-match)
1193 (recur
1194 {}
1195 index-next
1196 (inc index-next)
1197 index-next
1198 ptn
1199 (conj matches
1200 [(hex start-match) binds]))
1202 :else
1203 (let [k (first to-match)
1204 v (nth coll index)]
1205 (cond
1206 (= k \_) ;; wildcard
1207 (recur
1208 binds
1209 (inc index)
1210 index-next
1211 start-match
1212 (rest to-match)
1213 matches)
1215 (keyword? k)
1216 (if (binds k)
1217 (if (= (binds k) v)
1218 (recur
1219 binds
1220 (inc index)
1221 index-next
1222 start-match
1223 (rest to-match)
1224 matches)
1225 (recur
1226 {}
1227 index-next
1228 (inc index-next)
1229 index-next
1230 ptn
1231 matches))
1232 (if
1233 ;; every symbol must be bound to a different thing.
1234 ((set (vals binds)) v)
1235 (recur
1236 {}
1237 index-next
1238 (inc index-next)
1239 index-next
1240 ptn
1241 matches)
1242 (recur
1243 (assoc binds k v)
1244 (inc index)
1245 index-next
1246 start-match
1247 (rest to-match)
1248 matches))))))))
1253 ;; look for the rainbow badge in memory
1254 (println (reduce str (map #(str (first %) "\t" (vec(second %)) "\n") (search-memory (rom) [221] 10))))
1257 (comment
1259 (def hxc-later
1260 "Running this code produces, e.g. hardcoded names NPCs give
1261 their pokemon. Will sort through it later."
1262 (print (character-codes->str(take 10000
1263 (drop 0x71597
1264 (rom (root)))))))
1266 (let [dex
1267 (partition-by #(= 0x50 %)
1268 (take 2540
1269 (drop 0x40687
1270 (rom (root)))))]
1271 (def dex dex)
1272 (def hxc-species
1273 (map character-codes->str
1274 (take-nth 4 dex))))