view clojure/com/aurellem/gb/hxc.clj @ 286:0e31aff20d5f

added give-empty-pokedex
author Robert McIntyre <rlm@mit.edu>
date Wed, 28 Mar 2012 06:06:00 -0500
parents 516acb83410f
children 33c546273619
line wrap: on
line source
1 (ns com.aurellem.gb.hxc
2 (:use (com.aurellem.gb assembly characters gb-driver util
3 constants species))
4 (:use (com.aurellem.world practice))
5 (:import [com.aurellem.gb.gb_driver SaveState]))
10 ; ************* HANDWRITTEN CONSTANTS
14 (defn low-high
15 [low high]
16 (+ low (* 256 high)))
19 (defn format-name
20 "Convert the string of alphabetic/space characters into a keyword by
21 replacing spaces with hyphens and converting to lowercase."
22 [s]
23 (if (nil? s) nil
24 (keyword (.toLowerCase
25 (apply str
26 (map #(if (= % \space) "-" %) s))))))
29 ;; used to decode item prices
31 (defn decode-bcd
32 "Take a sequence of binary-coded digits (in written order) and return the number they represent."
33 [digits]
34 ((fn self [coll]
35 (if (empty? coll) 0
36 (+ (first coll) (* 100 (self (rest coll))))))
37 (map
38 #(+ (* 10 (int (/ % 16)))
39 (rem % 16))
40 (reverse digits))))
45 (def pkmn-types
46 [:normal ;;0
47 :fighting ;;1
48 :flying ;;2
49 :poison ;;3
50 :ground ;;4
51 :rock ;;5
52 :bird ;;6
53 :bug ;;7
54 :ghost ;;8
55 :A
56 :B
57 :C
58 :D
59 :E
60 :F
61 :G
62 :H
63 :I
64 :J
65 :K
66 :fire ;;20 (0x14)
67 :water ;;21 (0x15)
68 :grass ;;22 (0x16)
69 :electric ;;23 (0x17)
70 :psychic ;;24 (0x18)
71 :ice ;;25 (0x19)
72 :dragon ;;26 (0x1A)
73 ])
76 ;; question: when status effects claim to take
77 ;; their accuracy from the move accuracy, does
78 ;; this mean that the move always "hits" but the
79 ;; status effect may not?
81 (def move-effects
82 ["normal damage"
83 "no damage, just opponent sleep" ;; how many turns? is atk power ignored?
84 "0x4C chance of poison"
85 "leech half of inflicted damage"
86 "0x19 chance of burn"
87 "0x19 chance of freeze"
88 "0x19 chance of paralyze"
89 "user faints; opponent defense halved during attack."
90 "leech half of inflicted damage ONLY if sleeping opponent."
91 "imitate last attack"
92 "user atk +1"
93 "user def +1"
94 "user spd +1"
95 "user spc +1"
96 "user acr +1" ;; unused?!
97 "user evd +1"
98 "get post-battle $ = 2*level*uses"
99 "0xFE acr, no matter what."
100 "opponent atk -1" ;; acr taken from move acr?
101 "opponent def -1" ;;
102 "opponent spd -1" ;;
103 "opponent spc -1" ;;
104 "opponent acr -1";;
105 "opponent evd -1"
106 "converts user's type to opponent's."
107 "(haze)"
108 "(bide)"
109 "(thrash)"
110 "(teleport)"
111 "(fury swipes)"
112 "attacks 2-5 turns" ;; unused? like rollout?
113 "0x19 chance of flinch"
114 "opponent sleep for 1-7 turns"
115 "0x66 chance of poison"
116 "0x4D chance of burn"
117 "0x4D chance of freeze"
118 "0x4D chance of paralyze"
119 "0x4D chance of flinch"
120 "one-hit KO"
121 "charge one turn, atk next."
122 "fixed damage, leaves 1HP." ;; how is dmg determined?
123 "fixed damage." ;; cf seismic toss, dragon rage, psywave.
124 "atk 2-5 turns; opponent can't attack" ;; unnormalized? (0 0x60 0x60 0x20 0x20)
125 "charge one turn, atk next. (can't be hit when charging)"
126 "atk hits twice."
127 "user takes 1 damage if misses."
128 "evade status-lowering effects" ;;caused by you or also your opponent?
129 "(broken) if user is slower than opponent, makes critical hit impossible, otherwise has no effect"
130 "atk causes recoil dmg = 1/4 dmg dealt"
131 "confuses opponent" ;; acr taken from move acr
132 "user atk +2"
133 "user def +2"
134 "user spd +2"
135 "user spc +2"
136 "user acr +2" ;; unused!
137 "user evd +2" ;; unused!
138 "restores up to half of user's max hp." ;; broken: fails if the difference
139 ;; b/w max and current hp is one less than a multiple of 256.
140 "(transform)"
141 "opponent atk -2"
142 "opponent def -2"
143 "opponent spd -2"
144 "opponent spc -2"
145 "opponent acr -2"
146 "opponent evd -2"
147 "doubles user spc when attacked"
148 "doubles user def when attacked"
149 "just poisons opponent" ;;acr taken from move acr
150 "just paralyzes opponent" ;;
151 "0x19 chance opponent atk -1"
152 "0x19 chance opponent def -1"
153 "0x19 chance opponent spd -1"
154 "0x4C chance opponent spc -1" ;; context suggest chance is 0x19
155 "0x19 chance opponent acr -1"
156 "0x19 chance opponent evd -1"
157 "???" ;; unused? no effect?
158 "???" ;; unused? no effect?
159 "0x19 chance opponent confused"
160 "atk hits twice. 0x33 chance opponent poisioned."
161 "broken. crash the game after attack."
162 "(substitute)"
163 "unless opponent faints, user must recharge after atk. some
164 exceptions apply."
165 "(rage)"
166 "(mimic)"
167 "(metronome)"
168 "(leech seed)"
169 "does nothing (splash)"
170 "(disable)"
171 ])
174 ;; ************** HARDCODED DATA
176 (defn hxc-thunk
177 "Creates a thunk (nullary fn) that grabs data in a certain region of rom and
178 splits it into a collection by 0x50. If rom is not supplied, uses the
179 original rom data."
180 [start length]
181 (fn self
182 ([rom]
183 (take-nth 2
184 (partition-by #(= % 0x50)
185 (take length
186 (drop start rom)))))
187 ([]
188 (self com.aurellem.gb.gb-driver/original-rom))))
190 (def hxc-thunk-words
191 "Same as hxc-thunk, except it interprets the rom data as characters,
192 returning a collection of strings."
193 (comp
194 (partial comp (partial map character-codes->str))
195 hxc-thunk))
198 ;; --------------------------------------------------
200 (def hxc-items
201 "The hardcoded names of the items in memory. List begins at
202 ROM@045B7"
203 (hxc-thunk-words 0x45B7 870))
205 (def hxc-types
206 "The hardcoded type names in memory. List begins at ROM@27D99,
207 shortly before hxc-titles."
208 (hxc-thunk-words 0x27D99 102))
210 (def hxc-titles
211 "The hardcoded names of the trainer titles in memory. List begins at
212 ROM@27E77"
213 (hxc-thunk-words 0x27E77 196))
216 (def hxc-pokedex-text
217 "The hardcoded pokedex entries in memory. List begins at
218 ROM@B8000, shortly before move names."
219 (hxc-thunk-words 0xB8000 14754))
222 ;; In red/blue, pokedex stats are in internal order.
223 ;; In yellow, pokedex stats are in pokedex order.
225 (defn hxc-pokedex-stats
226 "The hardcoded pokedex stats (species height weight) in memory. List
227 begins at ROM@40687"
228 ;; uses hxc-pokedex-text to count pokemon
229 ;; since hxc-pokenames includes several missingno"
230 ([] (hxc-pokedex-stats com.aurellem.gb.gb-driver/original-rom))
231 ([rom]
232 (let [poketext (hxc-pokedex-text)
233 pkmn-count (count poketext)
234 ]
235 ((fn capture-stats
236 [n stats data]
237 (if (zero? n) stats
238 (let [[species
239 [_
240 height-ft
241 height-in
242 weight-1
243 weight-2
244 _
245 dex-ptr-1
246 dex-ptr-2
247 dex-bank
248 _
249 & data]]
250 (split-with (partial not= 0x50) data)]
251 (recur (dec n)
252 (assoc stats
253 (- pkmn-count n)
254 {:species
255 (character-codes->str species)
256 :height-ft
257 height-ft
258 :height-in
259 height-in
260 :weight
261 (/ (low-high weight-1 weight-2) 10.)
263 ;; :text
264 ;; (character-codes->str
265 ;; (take-while
266 ;; (partial not= 0x50)
267 ;; (drop
268 ;; (+ 0xB8000
269 ;; -0x4000
270 ;; (low-high dex-ptr-1 dex-ptr-2))
271 ;; rom)))
272 })
274 data)
277 )))
279 pkmn-count
280 {}
281 (drop 0x40687 rom))) ))
289 (def hxc-places
290 "The hardcoded place names in memory. List begins at
291 ROM@71500. [Cinnabar] Mansion seems to be dynamically calculated."
292 (hxc-thunk-words 0x71500 560))
295 (defn hxc-dialog
296 "The hardcoded dialogue in memory, including in-game alerts. Dialog
297 seems to be separated by 0x57 instead of 0x50 (END). Begins at ROM@98000."
298 ([rom]
299 (map character-codes->str
300 (take-nth 2
301 (partition-by #(= % 0x57)
302 (take 0x0F728
303 (drop 0x98000 rom))))))
304 ([]
305 (hxc-dialog com.aurellem.gb.gb-driver/original-rom)))
308 (def hxc-move-names
309 "The hardcoded move names in memory. List begins at ROM@BC000"
310 (hxc-thunk-words 0xBC000 1551))
313 (defn hxc-move-data
314 "The hardcoded (basic (move effects)) in memory. List begins at
315 0x38000. Returns a map of {:name :power :accuracy :pp :fx-id
316 :fx-txt}. The move descriptions are handwritten, not hardcoded."
317 ([]
318 (hxc-move-data com.aurellem.gb.gb-driver/original-rom))
319 ([rom]
320 (let [names (vec (hxc-move-names rom))
321 move-count (count names)
322 move-size 6
323 types pkmn-types ;;; !! hardcoded types
324 ]
325 (zipmap (map format-name names)
326 (map
327 (fn [[idx effect power type-id accuracy pp]]
328 {:name (names (dec idx))
329 :power power
330 :accuracy accuracy
331 :pp pp
332 :type (types type-id)
333 :fx-id effect
334 :fx-txt (get move-effects effect)
335 }
336 )
338 (partition move-size
339 (take (* move-size move-count)
340 (drop 0x38000 rom))))))))
344 (defn hxc-move-data*
345 "Like hxc-move-data, but reports numbers as hexadecimal symbols instead."
346 ([]
347 (hxc-move-data* com.aurellem.gb.gb-driver/original-rom))
348 ([rom]
349 (let [names (vec (hxc-move-names rom))
350 move-count (count names)
351 move-size 6
352 format-name (fn [s]
353 (keyword (.toLowerCase
354 (apply str
355 (map #(if (= % \space) "-" %) s)))))
356 ]
357 (zipmap (map format-name names)
358 (map
359 (fn [[idx effect power type accuracy pp]]
360 {:name (names (dec idx))
361 :power power
362 :accuracy (hex accuracy)
363 :pp pp
364 :fx-id (hex effect)
365 :fx-txt (get move-effects effect)
366 }
367 )
369 (partition move-size
370 (take (* move-size move-count)
371 (drop 0x38000 rom))))))))
374 (defn hxc-machines
375 "The hardcoded moves taught by TMs and HMs. List begins at ROM@0x1232D."
376 ([] (hxc-machines
377 com.aurellem.gb.gb-driver/original-rom))
378 ([rom]
379 (let [moves (hxc-move-names rom)]
380 (zipmap
381 (range)
382 (take-while
383 (comp not nil?)
384 (map (comp
385 format-name
386 (zipmap
387 (range)
388 moves)
389 dec)
390 (take 100
391 (drop 0x1232D rom))))))))
393 (defn hxc-pokenames
394 "The hardcoded names of the 190 species in memory. List begins at
395 ROM@E8000. Although names in memory are padded with 0x50 to be 10 characters
396 long, these names are stripped of padding."
397 ([]
398 (hxc-pokenames com.aurellem.gb.gb-driver/original-rom))
399 ([rom]
400 (let [count-species 190
401 name-length 10]
402 (map character-codes->str
403 (partition name-length
404 (map #(if (= 0x50 %) 0x00 %)
405 (take (* count-species name-length)
406 (drop 0xE8000
407 rom))))))))
412 (defn internal-id
413 ([rom]
414 (zipmap
415 (map format-name (hxc-pokenames rom))
416 (range)))
417 ([]
418 (internal-id com.aurellem.gb.gb-driver/original-rom)))
422 ;; nidoran gender change upon levelup
423 ;; (->
424 ;; @current-state
425 ;; rom
426 ;; vec
427 ;; (rewrite-memory
428 ;; (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♂))
429 ;; [1 1 15])
430 ;; (rewrite-memory
431 ;; (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♀))
432 ;; [1 1 3])
433 ;; (write-rom!)
435 ;; )
440 (defn hxc-advantage
441 "The hardcoded type advantages in memory, returned as tuples of atk-type def-type multiplier. By default (i.e. if not listed here),
442 the multiplier is 1."
443 ([] (hxc-advantage com.aurellem.gb.gb-driver/original-rom))
444 ([rom]
445 (map
446 (fn [[atk def mult]] [(get pkmn-types atk (hex atk))
447 (get pkmn-types def (hex def))
448 (/ mult 10)])
449 (partition 3
450 (take-while (partial not= 0xFF)
451 (drop 0x3E62D rom))))))
455 (defn format-evo
456 [coll]
457 (let [method (first coll)]
458 (cond (empty? coll) []
459 (= 0 method) [] ;; just in case
460 (= 1 method) ;; level-up evolution
461 (conj (format-evo (drop 3 coll))
462 {:method :level-up
463 :min-level (nth coll 1)
464 :into (dec (nth coll 2))})
466 (= 2 method) ;; item evolution
467 (conj (format-evo (drop 4 coll))
468 {:method :item
469 :item (dec (nth coll 1))
470 :min-level (nth coll 2)
471 :into (dec (nth coll 3))})
473 (= 3 method) ;; trade evolution
474 (conj (format-evo (drop 3 coll))
475 {:method :trade
476 :min-level (nth coll 1) ;; always 1 for trade.
477 :into (dec (nth coll 2))}))))
480 (defn hxc-ptrs-evolve
481 "A hardcoded collection of 190 pointers to alternating evolution/learnset data,
482 in internal order."
483 ([]
484 (hxc-ptrs-evolve com.aurellem.gb.gb-driver/original-rom))
485 ([rom]
486 (let [names (hxc-pokenames rom)
487 pkmn-count (count names)
488 ptrs
489 (map (fn [[a b]] (low-high a b))
490 (partition 2
491 (take (* 2 pkmn-count)
492 (drop 0x3b1e5 rom))))]
493 (map (partial + 0x34000) ptrs)
495 )))
498 (defn hxc-learnsets
499 "Hardcoded map associating pokemon names to lists of pairs [lvl
500 move] of abilities they learn as they level up. The data
501 exists at ROM@3400, sorted by internal order. Pointers to the data
502 exist at ROM@3B1E5; see also, hxc-ptrs-evolve"
503 ([] (hxc-learnsets com.aurellem.gb.gb-driver/original-rom))
504 ([rom]
505 (apply assoc
506 {}
507 (interleave
508 (map format-name (hxc-pokenames rom))
509 (map (comp
510 (partial map
511 (fn [[lvl mv]] [lvl (dec mv)]))
512 (partial partition 2)
513 ;; keep the learnset data
514 (partial take-while (comp not zero?))
515 ;; skip the evolution data
516 rest
517 (partial drop-while (comp not zero?)))
518 (map #(drop % rom)
519 (hxc-ptrs-evolve rom)))))))
521 (defn hxc-learnsets-pretty
522 "Live hxc-learnsets except it reports the name of each move --- as
523 it appears in rom --- rather than the move index."
524 ([] (hxc-learnsets-pretty com.aurellem.gb.gb-driver/original-rom))
525 ([rom]
526 (let [moves (vec(map format-name (hxc-move-names)))]
527 (into {}
528 (map (fn [[pkmn learnset]]
529 [pkmn (map (fn [[lvl mv]] [lvl (moves mv)])
530 learnset)])
531 (hxc-learnsets rom))))))
536 (defn hxc-evolution
537 "Hardcoded evolution data in memory. The data exists at ROM@34000,
538 sorted by internal order. Pointers to the data exist at ROM@3B1E5; see also, hxc-ptrs-evolve."
539 ([] (hxc-evolution com.aurellem.gb.gb-driver/original-rom))
540 ([rom]
541 (apply assoc {}
542 (interleave
543 (map format-name (hxc-pokenames rom))
544 (map
545 (comp
546 format-evo
547 (partial take-while (comp not zero?))
548 #(drop % rom))
549 (hxc-ptrs-evolve rom)
550 )))))
552 (defn hxc-evolution-pretty
553 "Like hxc-evolution, except it uses the names of items and pokemon
554 --- grabbed from ROM --- rather than their numerical identifiers."
555 ([] (hxc-evolution-pretty com.aurellem.gb.gb-driver/original-rom))
556 ([rom]
557 (let
558 [poke-names (vec (map format-name (hxc-pokenames rom)))
559 item-names (vec (map format-name (hxc-items rom)))
560 use-names
561 (fn [m]
562 (loop [ks (keys m) new-map m]
563 (let [k (first ks)]
564 (cond (nil? ks) new-map
565 (= k :into)
566 (recur
567 (next ks)
568 (assoc new-map
569 :into
570 (poke-names
571 (:into
572 new-map))))
573 (= k :item)
574 (recur
575 (next ks)
576 (assoc new-map
577 :item
578 (item-names
579 (:item new-map))))
580 :else
581 (recur
582 (next ks)
583 new-map)
584 ))))]
586 (into {}
587 (map (fn [[pkmn evo-coll]]
588 [pkmn (map use-names evo-coll)])
589 (hxc-evolution rom))))))
595 (defn hxc-pokemon-base
596 ([] (hxc-pokemon-base com.aurellem.gb.gb-driver/original-rom))
597 ([rom]
598 (let [entry-size 28
599 pkmn-count (count (hxc-pokedex-text rom))
600 types (apply assoc {}
601 (interleave
602 (range)
603 pkmn-types)) ;;!! softcoded
604 moves (apply assoc {}
605 (interleave
606 (range)
607 (map format-name
608 (hxc-move-names rom))))
609 ]
610 (map
612 (fn [[n
613 rating-hp
614 rating-atk
615 rating-def
616 rating-speed
617 rating-special
618 type-1
619 type-2
620 rarity
621 rating-xp
622 pic-dimensions ;; tile_width|tile_height (8px/tile)
623 ptr-pic-obverse-1
624 ptr-pic-obverse-2
625 ptr-pic-reverse-1
626 ptr-pic-reverse-2
627 move-1
628 move-2
629 move-3
630 move-4
631 growth-rate
632 &
633 TMs|HMs]]
634 (let
635 [base-moves
636 (mapv moves
637 ((comp
638 ;; since the game uses zero as a delimiter,
639 ;; it must also increment all move indices by 1.
640 ;; heren we decrement to correct this.
641 (partial map dec)
642 (partial take-while (comp not zero?)))
643 [move-1 move-2 move-3 move-4]))
645 types
646 (set (list (types type-1)
647 (types type-2)))
648 TMs|HMs
649 (map
650 (comp
651 (partial map first)
652 (partial remove (comp zero? second)))
653 (split-at
654 50
655 (map vector
656 (rest(range))
657 (reduce concat
658 (map
659 #(take 8
660 (concat (bit-list %)
661 (repeat 0)))
663 TMs|HMs)))))
665 TMs (vec (first TMs|HMs))
666 HMs (take 5 (map (partial + -50) (vec (second TMs|HMs))))
669 ]
672 {:dex# n
673 :base-moves base-moves
674 :types types
675 :TMs TMs
676 :HMs HMs
677 :base-hp rating-hp
678 :base-atk rating-atk
679 :base-def rating-def
680 :base-speed rating-speed
681 :base-special rating-special
682 }))
684 (partition entry-size
685 (take (* entry-size pkmn-count)
686 (drop 0x383DE
687 rom)))))))
691 (defn hxc-item-prices
692 "The hardcoded list of item prices in memory. List begins at ROM@4495"
693 ([] (hxc-item-prices com.aurellem.gb.gb-driver/original-rom))
694 ([rom]
695 (let [items (map format-name (hxc-items rom))
696 price-size 3]
697 (zipmap items
698 (map (comp
699 ;; zero-cost items are "priceless"
700 #(if (zero? %) :priceless %)
701 decode-bcd butlast)
702 (partition price-size
703 (take (* price-size (count items))
704 (drop 0x4495 rom))))))))
706 (defn hxc-shops
707 ([] (hxc-shops com.aurellem.gb.gb-driver/original-rom))
708 ([rom]
709 (let [items (zipmap (range) (map format-name (hxc-items rom)))
711 ;; temporarily softcode the TM items
712 items (into
713 items
714 (map (juxt identity
715 (comp keyword
716 (partial str "tm-")
717 (partial + 1 -200)
718 ))
719 (take 200 (drop 200 (range)))))
721 ]
723 ((fn parse-shop [coll [num-items & items-etc]]
724 (let [inventory (take-while
725 (partial not= 0xFF)
726 items-etc)
727 [separator & items-etc] (drop num-items (rest items-etc))]
728 (if (= separator 0x50)
729 (map (partial mapv (comp items dec)) (conj coll inventory))
730 (recur (conj coll inventory) items-etc)
731 )
732 ))
734 '()
735 (drop 0x233C rom))
738 )))
742 ;; ********************** MANIPULATION FNS
747 (defn submap?
748 "Compares the two maps. Returns true if map-big has the same associations as map-small, otherwise false."
749 [map-small map-big]
750 (cond (empty? map-small) true
751 (and
752 (contains? map-big (ffirst map-small))
753 (= (get map-big (ffirst map-small))
754 (second (first map-small))))
755 (recur (next map-small) map-big)
757 :else false))
760 (defn search-map [proto-map maps]
761 "Returns all the maps that make the same associations as proto-map."
762 (some (partial submap? proto-map) maps))
764 (defn filter-vals
765 "Returns a map consisting of all the pairs [key val] for
766 which (pred key) returns true."
767 [pred map]
768 (reduce (partial apply assoc) {}
769 (filter (fn [[k v]] (pred v)) map)))
772 (defn search-moves
773 "Returns a subcollection of all hardcoded moves with the
774 given attributes. Attributes consist of :name :power
775 :accuracy :pp :fx-id
776 (and also :fx-txt, but it contains the same information
777 as :fx-id)"
778 ([attribute-map]
779 (search-moves
780 com.aurellem.gb.gb-driver/original-rom attribute-map))
781 ([rom attribute-map]
782 (filter-vals (partial submap? attribute-map)
783 (hxc-move-data rom))))
789 ;; note: 0x2f31 contains the names "TM" "HM"?
791 ;; note for later: credits start at F1290
796 ;; (def dex-order
797 ;; [:bulbasaur
798 ;; :ivysaur
799 ;; :venusaur
800 ;; :charmander
801 ;; :charmeleon
802 ;; :charizard])
805 ;; (defn same-type-attack-bonus?
806 ;; ([pkmn move]
807 ;; (same-type-attack-bonus?
808 ;; com.aurellem.gb.gb-driver/original-rom pkmn move))
809 ;; ([rom pkmn move]
810 ;; (hxc-pokemon-base rom)))
817 (comment
819 (def hxc-later
820 "Running this code produces, e.g. hardcoded names NPCs give
821 their pokemon. Will sort through it later."
822 (print (character-codes->str(take 10000
823 (drop 0x71597
824 (rom (root)))))))
826 (let [dex
827 (partition-by #(= 0x50 %)
828 (take 2540
829 (drop 0x40687
830 (rom (root)))))]
831 (def dex dex)
832 (def hxc-species
833 (map character-codes->str
834 (take-nth 4 dex))))
835 )