Mercurial > vba-clojure
view clojure/com/aurellem/gb/hxc.clj @ 306:2873f50b7291
beginning to work on cry data
author | Dylan Holmes <ocsenave@gmail.com> |
---|---|
date | Sat, 31 Mar 2012 01:27:46 -0500 |
parents | c31cb3043087 |
children | 872e032949ff |
line wrap: on
line source
1 (ns com.aurellem.gb.hxc2 (:use (com.aurellem.gb assembly characters gb-driver util3 constants species))4 ;; (:use (com.aurellem.world practice))5 (:import [com.aurellem.gb.gb_driver SaveState]))10 ; ************* HANDWRITTEN CONSTANTS14 (def pkmn-types15 [:normal ;;016 :fighting ;;117 :flying ;;218 :poison ;;319 :ground ;;420 :rock ;;521 :bird ;;622 :bug ;;723 :ghost ;;824 :A25 :B26 :C27 :D28 :E29 :F30 :G31 :H32 :I33 :J34 :K35 :fire ;;20 (0x14)36 :water ;;21 (0x15)37 :grass ;;22 (0x16)38 :electric ;;23 (0x17)39 :psychic ;;24 (0x18)40 :ice ;;25 (0x19)41 :dragon ;;26 (0x1A)42 ])45 ;; question: when status effects claim to take46 ;; their accuracy from the move accuracy, does47 ;; this mean that the move always "hits" but the48 ;; status effect may not?50 (def move-effects51 ["normal damage"52 "no damage, just opponent sleep" ;; how many turns? is atk power ignored?53 "0x4C chance of poison"54 "leech half of inflicted damage"55 "0x19 chance of burn"56 "0x19 chance of freeze"57 "0x19 chance of paralyze"58 "user faints; opponent defense halved during attack."59 "leech half of inflicted damage ONLY if sleeping opponent."60 "imitate last attack"61 "user atk +1"62 "user def +1"63 "user spd +1"64 "user spc +1"65 "user acr +1" ;; unused?!66 "user evd +1"67 "get post-battle $ = 2*level*uses"68 "0xFE acr, no matter what."69 "opponent atk -1" ;; acr taken from move acr?70 "opponent def -1" ;;71 "opponent spd -1" ;;72 "opponent spc -1" ;;73 "opponent acr -1";;74 "opponent evd -1"75 "converts user's type to opponent's."76 "(haze)"77 "(bide)"78 "(thrash)"79 "(teleport)"80 "(fury swipes)"81 "attacks 2-5 turns" ;; unused? like rollout?82 "0x19 chance of flinch"83 "opponent sleep for 1-7 turns"84 "0x66 chance of poison"85 "0x4D chance of burn"86 "0x4D chance of freeze"87 "0x4D chance of paralyze"88 "0x4D chance of flinch"89 "one-hit KO"90 "charge one turn, atk next."91 "fixed damage, leaves 1HP." ;; how is dmg determined?92 "fixed damage." ;; cf seismic toss, dragon rage, psywave.93 "atk 2-5 turns; opponent can't attack" ;; unnormalized? (0 0x60 0x60 0x20 0x20)94 "charge one turn, atk next. (can't be hit when charging)"95 "atk hits twice."96 "user takes 1 damage if misses."97 "evade status-lowering effects" ;;caused by you or also your opponent?98 "(broken) if user is slower than opponent, makes critical hit impossible, otherwise has no effect"99 "atk causes recoil dmg = 1/4 dmg dealt"100 "confuses opponent" ;; acr taken from move acr101 "user atk +2"102 "user def +2"103 "user spd +2"104 "user spc +2"105 "user acr +2" ;; unused!106 "user evd +2" ;; unused!107 "restores up to half of user's max hp." ;; broken: fails if the difference108 ;; b/w max and current hp is one less than a multiple of 256.109 "(transform)"110 "opponent atk -2"111 "opponent def -2"112 "opponent spd -2"113 "opponent spc -2"114 "opponent acr -2"115 "opponent evd -2"116 "doubles user spc when attacked"117 "doubles user def when attacked"118 "just poisons opponent" ;;acr taken from move acr119 "just paralyzes opponent" ;;120 "0x19 chance opponent atk -1"121 "0x19 chance opponent def -1"122 "0x19 chance opponent spd -1"123 "0x4C chance opponent spc -1" ;; context suggest chance is 0x19124 "0x19 chance opponent acr -1"125 "0x19 chance opponent evd -1"126 "???" ;; unused? no effect?127 "???" ;; unused? no effect?128 "0x19 chance opponent confused"129 "atk hits twice. 0x33 chance opponent poisioned."130 "broken. crash the game after attack."131 "(substitute)"132 "unless opponent faints, user must recharge after atk. some133 exceptions apply."134 "(rage)"135 "(mimic)"136 "(metronome)"137 "(leech seed)"138 "does nothing (splash)"139 "(disable)"140 ])143 ;; ************** HARDCODED DATA145 (defn hxc-thunk146 "Creates a thunk (nullary fn) that grabs data in a certain region of rom and147 splits it into a collection by 0x50. If rom is not supplied, uses the148 original rom data."149 [start length]150 (fn self151 ([rom]152 (take-nth 2153 (partition-by #(= % 0x50)154 (take length155 (drop start rom)))))156 ([]157 (self com.aurellem.gb.gb-driver/original-rom))))159 (def hxc-thunk-words160 "Same as hxc-thunk, except it interprets the rom data as characters,161 returning a collection of strings."162 (comp163 (partial comp (partial map character-codes->str))164 hxc-thunk))167 ;; --------------------------------------------------171 (defn hxc-pokenames-raw172 "The hardcoded names of the 190 species in memory. List begins at173 ROM@E8000. Although names in memory are padded with 0x50 to be 10 characters174 long, these names are stripped of padding. See also, hxc-pokedex-names"175 ([]176 (hxc-pokenames-raw com.aurellem.gb.gb-driver/original-rom))177 ([rom]178 (let [count-species 190179 name-length 10]180 (map character-codes->str181 (partition name-length182 (map #(if (= 0x50 %) 0x00 %)183 (take (* count-species name-length)184 (drop 0xE8000185 rom))))))))186 (def hxc-pokenames187 (comp188 (partial map format-name)189 hxc-pokenames-raw))194 (defn hxc-pokedex-names195 "The names of the pokemon in hardcoded pokedex order. List begins at196 ROM@410B1. See also, hxc-pokenames."197 ([] (hxc-pokedex-names198 com.aurellem.gb.gb-driver/original-rom))199 ([rom]200 (let [names (hxc-pokenames rom)]201 (#(mapv %202 ((comp range count keys) %))203 (zipmap204 (take (count names)205 (drop 0x410b1 rom))207 names)))))211 ;; http://hax.iimarck.us/topic/581/212 (defn hxc-pokedex-cry213 "The pokemon cry data in internal order. List begins at ROM@410B1214 []218 (def hxc-items-raw219 "The hardcoded names of the items in memory. List begins at220 ROM@045B7"221 (hxc-thunk-words 0x45B7 870))223 (def hxc-types224 "The hardcoded type names in memory. List begins at ROM@27D99,225 shortly before hxc-titles."226 (hxc-thunk-words 0x27D99 102))228 (def hxc-titles229 "The hardcoded names of the trainer titles in memory. List begins at230 ROM@27E77"231 (hxc-thunk-words 0x27E77 196))234 (def hxc-pokedex-text-raw235 "The hardcoded pokedex entries in memory. List begins at236 ROM@B8000, shortly before move names."237 (hxc-thunk-words 0xB8000 14754))241 (def hxc-items242 "The hardcoded names of the items in memory, presented as243 keywords. List begins at ROM@045B7. See also, hxc-items-raw."244 (comp (partial map format-name) hxc-items-raw))246 (defn hxc-pokedex-text247 "The hardcoded pokedex entries in memory, presented as an248 associative hash map. List begins at ROM@B8000."249 ([] (hxc-pokedex-text com.aurellem.gb.gb-driver/original-rom))250 ([rom]251 (zipmap252 (hxc-pokedex-names rom)253 (cons nil ;; for missingno.254 (hxc-pokedex-text-raw rom)))))256 ;; In red/blue, pokedex stats are in internal order.257 ;; In yellow, pokedex stats are in pokedex order.259 (defn hxc-pokedex-stats260 "The hardcoded pokedex stats (species height weight) in memory. List261 begins at ROM@40687"262 ([] (hxc-pokedex-stats com.aurellem.gb.gb-driver/original-rom))263 ([rom]264 (let [pokedex-names (zipmap (range) (hxc-pokedex-names rom))265 pkmn-count (count pokedex-names)266 ]267 ((fn capture-stats268 [n stats data]269 (if (zero? n) stats270 (let [[species271 [_272 height-ft273 height-in274 weight-1275 weight-2276 _277 dex-ptr-1278 dex-ptr-2279 dex-bank280 _281 & data]]282 (split-with (partial not= 0x50) data)]283 (recur (dec n)284 (assoc stats285 (pokedex-names (- pkmn-count (dec n)))286 {:species287 (format-name (character-codes->str species))288 :height-ft289 height-ft290 :height-in291 height-in292 :weight293 (/ (low-high weight-1 weight-2) 10.)295 ;; :text296 ;; (character-codes->str297 ;; (take-while298 ;; (partial not= 0x50)299 ;; (drop300 ;; (+ 0xB8000301 ;; -0x4000302 ;; (low-high dex-ptr-1 dex-ptr-2))303 ;; rom)))304 })306 data)309 )))311 pkmn-count312 {}313 (drop 0x40687 rom))) ))321 (def hxc-places322 "The hardcoded place names in memory. List begins at323 ROM@71500. [Cinnabar] Mansion seems to be dynamically calculated."324 (hxc-thunk-words 0x71500 560))327 (defn hxc-dialog328 "The hardcoded dialogue in memory, including in-game alerts. Dialog329 seems to be separated by 0x57 instead of 0x50 (END). Begins at ROM@98000."330 ([rom]331 (map character-codes->str332 (take-nth 2333 (partition-by #(= % 0x57)334 (take 0x0F728335 (drop 0x98000 rom))))))336 ([]337 (hxc-dialog com.aurellem.gb.gb-driver/original-rom)))340 (def hxc-move-names341 "The hardcoded move names in memory. List begins at ROM@BC000"342 (hxc-thunk-words 0xBC000 1551))345 (defn hxc-move-data346 "The hardcoded (basic (move effects)) in memory. List begins at347 0x38000. Returns a map of {:name :power :accuracy :pp :fx-id348 :fx-txt}. The move descriptions are handwritten, not hardcoded."349 ([]350 (hxc-move-data com.aurellem.gb.gb-driver/original-rom))351 ([rom]352 (let [names (vec (hxc-move-names rom))353 move-count (count names)354 move-size 6355 types pkmn-types ;;; !! hardcoded types356 ]357 (zipmap (map format-name names)358 (map359 (fn [[idx effect power type-id accuracy pp]]360 {:name (names (dec idx))361 :power power362 :accuracy accuracy363 :pp pp364 :type (types type-id)365 :fx-id effect366 :fx-txt (get move-effects effect)367 }368 )370 (partition move-size371 (take (* move-size move-count)372 (drop 0x38000 rom))))))))376 (defn hxc-move-data*377 "Like hxc-move-data, but reports numbers as hexadecimal symbols instead."378 ([]379 (hxc-move-data* com.aurellem.gb.gb-driver/original-rom))380 ([rom]381 (let [names (vec (hxc-move-names rom))382 move-count (count names)383 move-size 6384 format-name (fn [s]385 (keyword (.toLowerCase386 (apply str387 (map #(if (= % \space) "-" %) s)))))388 ]389 (zipmap (map format-name names)390 (map391 (fn [[idx effect power type accuracy pp]]392 {:name (names (dec idx))393 :power power394 :accuracy (hex accuracy)395 :pp pp396 :fx-id (hex effect)397 :fx-txt (get move-effects effect)398 }399 )401 (partition move-size402 (take (* move-size move-count)403 (drop 0x38000 rom))))))))406 (defn hxc-machines407 "The hardcoded moves taught by TMs and HMs. List begins at ROM@0x1232D."408 ([] (hxc-machines409 com.aurellem.gb.gb-driver/original-rom))410 ([rom]411 (let [moves (hxc-move-names rom)]412 (zipmap413 (range)414 (take-while415 (comp not nil?)416 (map (comp417 format-name418 (zipmap419 (range)420 moves)421 dec)422 (take 100423 (drop 0x1232D rom))))))))427 (defn internal-id428 ([rom]429 (zipmap430 (hxc-pokenames rom)431 (range)))432 ([]433 (internal-id com.aurellem.gb.gb-driver/original-rom)))439 ;; nidoran gender change upon levelup440 ;; (->441 ;; @current-state442 ;; rom443 ;; vec444 ;; (rewrite-memory445 ;; (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♂))446 ;; [1 1 15])447 ;; (rewrite-memory448 ;; (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♀))449 ;; [1 1 3])450 ;; (write-rom!)452 ;; )457 (defn hxc-advantage458 ;; in-game multipliers are stored as 10x their effective value459 ;; to allow for fractional multipliers like 1/2461 "The hardcoded type advantages in memory, returned as tuples of462 atk-type def-type multiplier. By default (i.e. if not listed here),463 the multiplier is 1. List begins at 0x3E62D."464 ([] (hxc-advantage com.aurellem.gb.gb-driver/original-rom))465 ([rom]466 (map467 (fn [[atk def mult]] [(get pkmn-types atk (hex atk))468 (get pkmn-types def (hex def))469 (/ mult 10)])470 (partition 3471 (take-while (partial not= 0xFF)472 (drop 0x3E62D rom))))))476 (defn format-evo477 [coll]478 (let [method (first coll)]479 (cond (empty? coll) []480 (= 0 method) [] ;; just in case481 (= 1 method) ;; level-up evolution482 (conj (format-evo (drop 3 coll))483 {:method :level-up484 :min-level (nth coll 1)485 :into (dec (nth coll 2))})487 (= 2 method) ;; item evolution488 (conj (format-evo (drop 4 coll))489 {:method :item490 :item (dec (nth coll 1))491 :min-level (nth coll 2)492 :into (dec (nth coll 3))})494 (= 3 method) ;; trade evolution495 (conj (format-evo (drop 3 coll))496 {:method :trade497 :min-level (nth coll 1) ;; always 1 for trade.498 :into (dec (nth coll 2))}))))501 (defn hxc-ptrs-evolve502 "A hardcoded collection of 190 pointers to alternating evolution/learnset data,503 in internal order."504 ([]505 (hxc-ptrs-evolve com.aurellem.gb.gb-driver/original-rom))506 ([rom]507 (let [508 pkmn-count (count (hxc-pokenames-raw)) ;; 190509 ptrs510 (map (fn [[a b]] (low-high a b))511 (partition 2512 (take (* 2 pkmn-count)513 (drop 0x3b1e5 rom))))]514 (map (partial + 0x34000) ptrs)516 )))519 (defn hxc-learnsets520 "Hardcoded map associating pokemon names to lists of pairs [lvl521 move] of abilities they learn as they level up. The data522 exists at ROM@3400, sorted by internal order. Pointers to the data523 exist at ROM@3B1E5; see also, hxc-ptrs-evolve"524 ([] (hxc-learnsets com.aurellem.gb.gb-driver/original-rom))525 ([rom]526 (apply assoc527 {}528 (interleave529 (hxc-pokenames rom)530 (map (comp531 (partial map532 (fn [[lvl mv]] [lvl (dec mv)]))533 (partial partition 2)534 ;; keep the learnset data535 (partial take-while (comp not zero?))536 ;; skip the evolution data537 rest538 (partial drop-while (comp not zero?)))539 (map #(drop % rom)540 (hxc-ptrs-evolve rom)))))))542 (defn hxc-learnsets-pretty543 "Live hxc-learnsets except it reports the name of each move --- as544 it appears in rom --- rather than the move index."545 ([] (hxc-learnsets-pretty com.aurellem.gb.gb-driver/original-rom))546 ([rom]547 (let [moves (vec(map format-name (hxc-move-names)))]548 (into {}549 (map (fn [[pkmn learnset]]550 [pkmn (map (fn [[lvl mv]] [lvl (moves mv)])551 learnset)])552 (hxc-learnsets rom))))))557 (defn hxc-evolution558 "Hardcoded evolution data in memory. The data exists at ROM@34000,559 sorted by internal order. Pointers to the data exist at ROM@3B1E5; see also, hxc-ptrs-evolve."560 ([] (hxc-evolution com.aurellem.gb.gb-driver/original-rom))561 ([rom]562 (apply assoc {}563 (interleave564 (hxc-pokenames rom)565 (map566 (comp567 format-evo568 (partial take-while (comp not zero?))569 #(drop % rom))570 (hxc-ptrs-evolve rom)571 )))))573 (defn hxc-evolution-pretty574 "Like hxc-evolution, except it uses the names of items and pokemon575 --- grabbed from ROM --- rather than their numerical identifiers."576 ([] (hxc-evolution-pretty com.aurellem.gb.gb-driver/original-rom))577 ([rom]578 (let579 [poke-names (vec (hxc-pokenames rom))580 item-names (vec (hxc-items rom))581 use-names582 (fn [m]583 (loop [ks (keys m) new-map m]584 (let [k (first ks)]585 (cond (nil? ks) new-map586 (= k :into)587 (recur588 (next ks)589 (assoc new-map590 :into591 (poke-names592 (:into593 new-map))))594 (= k :item)595 (recur596 (next ks)597 (assoc new-map598 :item599 (item-names600 (:item new-map))))601 :else602 (recur603 (next ks)604 new-map)605 ))))]607 (into {}608 (map (fn [[pkmn evo-coll]]609 [pkmn (map use-names evo-coll)])610 (hxc-evolution rom))))))613 (defn hxc-pokemon-base614 ([] (hxc-pokemon-base com.aurellem.gb.gb-driver/original-rom))615 ([rom]616 (let [entry-size 28617 pkmn-count (count (hxc-pokedex-text rom))618 pokemon (rest (hxc-pokedex-names))619 types (apply assoc {}620 (interleave621 (range)622 pkmn-types)) ;;!! softcoded623 moves (apply assoc {}624 (interleave625 (range)626 (map format-name627 (hxc-move-names rom))))628 machines (hxc-machines)629 ]630 (zipmap631 pokemon632 (map633 (fn [[n634 rating-hp635 rating-atk636 rating-def637 rating-speed638 rating-special639 type-1640 type-2641 rarity642 rating-xp643 pic-dimensions ;; tile_width|tile_height (8px/tile)644 ptr-pic-obverse-1645 ptr-pic-obverse-2646 ptr-pic-reverse-1647 ptr-pic-reverse-2648 move-1649 move-2650 move-3651 move-4652 growth-rate653 &654 TMs|HMs]]655 (let656 [base-moves657 (mapv moves658 ((comp659 ;; since the game uses zero as a delimiter,660 ;; it must also increment all move indices by 1.661 ;; heren we decrement to correct this.662 (partial map dec)663 (partial take-while (comp not zero?)))664 [move-1 move-2 move-3 move-4]))666 types667 (set (list (types type-1)668 (types type-2)))669 TMs|HMs670 (map671 (comp672 (partial map first)673 (partial remove (comp zero? second)))674 (split-at675 50676 (map vector677 (rest(range))678 (reduce concat679 (map680 #(take 8681 (concat (bit-list %)682 (repeat 0)))684 TMs|HMs)))))686 TMs (vec (first TMs|HMs))687 HMs (take 5 (map (partial + -50) (vec (second TMs|HMs))))690 ]693 {:dex# n694 :base-moves base-moves695 :types types696 :TMs TMs697 :HMs HMs698 :base-hp rating-hp699 :base-atk rating-atk700 :base-def rating-def701 :base-speed rating-speed702 :base-special rating-special703 }))705 (partition entry-size706 (take (* entry-size pkmn-count)707 (drop 0x383DE708 rom))))))))712 (defn hxc-item-prices713 "The hardcoded list of item prices in memory. List begins at ROM@4495"714 ([] (hxc-item-prices com.aurellem.gb.gb-driver/original-rom))715 ([rom]716 (let [items (hxc-items rom)717 price-size 3]718 (zipmap items719 (map (comp720 ;; zero-cost items are "priceless"721 #(if (zero? %) :priceless %)722 decode-bcd butlast)723 (partition price-size724 (take (* price-size (count items))725 (drop 0x4495 rom))))))))727 (defn hxc-shops728 ([] (hxc-shops com.aurellem.gb.gb-driver/original-rom))729 ([rom]730 (let [items (zipmap (range) (hxc-items rom))732 ;; temporarily softcode the TM items733 items (into734 items735 (map (juxt identity736 (comp keyword737 (partial str "tm-")738 (partial + 1 -200)739 ))740 (take 200 (drop 200 (range)))))742 ]744 ((fn parse-shop [coll [num-items & items-etc]]745 (let [inventory (take-while746 (partial not= 0xFF)747 items-etc)748 [separator & items-etc] (drop num-items (rest items-etc))]749 (if (= separator 0x50)750 (map (partial mapv (comp items dec)) (conj coll inventory))751 (recur (conj coll inventory) items-etc)752 )753 ))755 '()756 (drop 0x233C rom))759 )))765 (defn hxc-ptrs-wild766 "A list of the hardcoded wild encounter data in memory. Pointers767 begin at ROM@0CB95; data begins at ROM@0x04D89"768 ([] (hxc-ptrs-wild com.aurellem.gb.gb-driver/original-rom))769 ([rom]770 (let [ptrs771 (map (fn [[a b]] (+ a (* 0x100 b)))772 (take-while (partial not= (list 0xFF 0xFF))773 (partition 2 (drop 0xCB95 rom))))]774 ptrs)))778 (defn hxc-wilds779 "A list of the hardcoded wild encounter data in memory. Pointers780 begin at ROM@0CB95; data begins at ROM@0x04D89"781 ([] (hxc-wilds com.aurellem.gb.gb-driver/original-rom))782 ([rom]783 (let [pokenames (zipmap (range) (hxc-pokenames rom))]784 (map785 (partial map (fn [[a b]] {:species (pokenames (dec b)) :level786 a}))787 (partition 10789 (take-while (comp (partial not= 1)790 first)791 (partition 2792 (drop 0xCD8C rom))794 ))))))809 ;; ********************** MANIPULATION FNS812 (defn same-type813 ([pkmn move]814 (same-type815 com.aurellem.gb.gb-driver/original-rom pkmn move))816 ([rom pkmn move]817 (((comp :types (hxc-pokemon-base rom)) pkmn)818 ((comp :type (hxc-move-data rom)) move))))823 (defn submap?824 "Compares the two maps. Returns true if map-big has the same associations as map-small, otherwise false."825 [map-small map-big]826 (cond (empty? map-small) true827 (and828 (contains? map-big (ffirst map-small))829 (= (get map-big (ffirst map-small))830 (second (first map-small))))831 (recur (next map-small) map-big)833 :else false))836 (defn search-map [proto-map maps]837 "Returns all the maps that make the same associations as proto-map."838 (some (partial submap? proto-map) maps))840 (defn filter-vals841 "Returns a map consisting of all the pairs [key val] for842 which (pred key) returns true."843 [pred map]844 (reduce (partial apply assoc) {}845 (filter (fn [[k v]] (pred v)) map)))848 (defn search-moves849 "Returns a subcollection of all hardcoded moves with the850 given attributes. Attributes consist of :name :power851 :accuracy :pp :fx-id852 (and also :fx-txt, but it contains the same information853 as :fx-id)"854 ([attribute-map]855 (search-moves856 com.aurellem.gb.gb-driver/original-rom attribute-map))857 ([rom attribute-map]858 (filter-vals (partial submap? attribute-map)859 (hxc-move-data rom))))865 ;; note: 0x2f31 contains the names "TM" "HM"?867 ;; note for later: credits start at F1290871 (comment873 (def hxc-later874 "Running this code produces, e.g. hardcoded names NPCs give875 their pokemon. Will sort through it later."876 (print (character-codes->str(take 10000877 (drop 0x71597878 (rom (root)))))))880 (let [dex881 (partition-by #(= 0x50 %)882 (take 2540883 (drop 0x40687884 (rom (root)))))]885 (def dex dex)886 (def hxc-species887 (map character-codes->str888 (take-nth 4 dex))))889 )