Mercurial > vba-clojure
view clojure/com/aurellem/gb/hxc.clj @ 349:37616a97beaa
fixed a few blocks that were not tangling properly.
author | Dylan Holmes <ocsenave@gmail.com> |
---|---|
date | Sun, 08 Apr 2012 07:57:52 -0500 |
parents | 497ca041f5af |
children | 5aabbe326eb0 |
line wrap: on
line source
2 (ns com.aurellem.gb.hxc3 (:use (com.aurellem.gb assembly characters gb-driver util mem-util4 constants species))5 (:import [com.aurellem.gb.gb_driver SaveState]))7 ; ************* HANDWRITTEN CONSTANTS9 (def pkmn-types10 [:normal ;;011 :fighting ;;112 :flying ;;213 :poison ;;314 :ground ;;415 :rock ;;516 :bird ;;617 :bug ;;718 :ghost ;;819 :A20 :B21 :C22 :D23 :E24 :F25 :G26 :H27 :I28 :J29 :K30 :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 take41 ;; their accuracy from the move accuracy, does42 ;; this mean that the move always "hits" but the43 ;; status effect may not?45 (def move-effects46 ["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 acr96 "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 difference103 ;; 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 acr114 "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 0x19119 "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. some128 exceptions apply."129 "(rage)"130 "(mimic)"131 "(metronome)"132 "(leech seed)"133 "does nothing (splash)"134 "(disable)"135 ])137 ;; ************** HARDCODED DATA139 (defn hxc-thunk140 "Creates a thunk (nullary fn) that grabs data in a certain region of rom and141 splits it into a collection by 0x50. If rom is not supplied, uses the142 original rom data."143 [start length]144 (fn self145 ([rom]146 (take-nth 2147 (partition-by #(= % 0x50)148 (take length149 (drop start rom)))))150 ([]151 (self com.aurellem.gb.gb-driver/original-rom))))153 (def hxc-thunk-words154 "Same as hxc-thunk, except it interprets the rom data as characters,155 returning a collection of strings."156 (comp157 (partial comp (partial map character-codes->str))158 hxc-thunk))160 ;; --------------------------------------------------163 (defn hxc-pokenames-raw164 "The hardcoded names of the 190 species in memory. List begins at165 ROM@E8000. Although names in memory are padded with 0x50 to be 10 characters166 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 190171 name-length 10]172 (map character-codes->str173 (partition name-length174 (map #(if (= 0x50 %) 0x00 %)175 (take (* count-species name-length)176 (drop 0xE8000177 rom))))))))178 (def hxc-pokenames179 (comp180 (partial map format-name)181 hxc-pokenames-raw))186 (defn hxc-pokedex-names187 "The names of the pokemon in hardcoded pokedex order. List begins at188 ROM@410B1. See also, hxc-pokenames."189 ([] (hxc-pokedex-names190 com.aurellem.gb.gb-driver/original-rom))191 ([rom]192 (let [names (hxc-pokenames rom)]193 (#(mapv %194 ((comp range count keys) %))195 (zipmap196 (take (count names)197 (drop 0x410b1 rom))199 names)))))201 (def hxc-types202 "The hardcoded type names in memory. List begins at ROM@27D99,203 shortly before hxc-titles."204 (hxc-thunk-words 0x27D99 102))207 ;; http://hax.iimarck.us/topic/581/208 (defn hxc-cry209 "The pokemon cry data in internal order. List begins at ROM@39462"210 ([](hxc-cry com.aurellem.gb.gb-driver/original-rom))211 ([rom]212 (zipmap213 (hxc-pokenames rom)214 (map215 (fn [[cry-id pitch length]]216 {:cry-id cry-id217 :pitch pitch218 :length length}219 )220 (partition 3221 (drop 0x39462 rom))))))223 (defn hxc-cry-groups224 ([] (hxc-cry-groups com.aurellem.gb.gb-driver/original-rom))225 ([rom]226 (map #(mapv first227 (filter228 (fn [[k v]]229 (= % (:cry-id v)))230 (hxc-cry)))231 ((comp232 range233 count234 set235 (partial map :cry-id)236 vals237 hxc-cry)238 rom))))241 (defn cry-conversion!242 "Convert Porygon's cry in ROM to be the cry of the given pokemon."243 [pkmn]244 (write-rom!245 (rewrite-memory246 (vec(rom))247 0x3965D248 (map second249 ((hxc-cry) pkmn)))))254 (def hxc-items-raw255 "The hardcoded names of the items in memory. List begins at256 ROM@045B7"257 (hxc-thunk-words 0x45B7 870))259 (def hxc-items260 "The hardcoded names of the items in memory, presented as261 keywords. List begins at ROM@045B7. See also, hxc-items-raw."262 (comp (partial map format-name) hxc-items-raw))266 (def hxc-titles267 "The hardcoded names of the trainer titles in memory. List begins at268 ROM@27E77"269 (hxc-thunk-words 0x27E77 196))272 (def hxc-pokedex-text-raw273 "The hardcoded pokedex entries in memory. List begins at274 ROM@B8000, shortly before move names."275 (hxc-thunk-words 0xB8000 14754))280 (defn hxc-pokedex-text281 "The hardcoded pokedex entries in memory, presented as an282 associative hash map. List begins at ROM@B8000."283 ([] (hxc-pokedex-text com.aurellem.gb.gb-driver/original-rom))284 ([rom]285 (zipmap286 (hxc-pokedex-names rom)287 (cons nil ;; for missingno.288 (hxc-pokedex-text-raw rom)))))290 ;; In red/blue, pokedex stats are in internal order.291 ;; In yellow, pokedex stats are in pokedex order.292 (defn hxc-pokedex-stats293 "The hardcoded pokedex stats (species height weight) in memory. List294 begins at ROM@40687"295 ([] (hxc-pokedex-stats com.aurellem.gb.gb-driver/original-rom))296 ([rom]297 (let [pokedex-names (zipmap (range) (hxc-pokedex-names rom))298 pkmn-count (count pokedex-names)299 ]300 ((fn capture-stats301 [n stats data]302 (if (zero? n) stats303 (let [[species304 [_305 height-ft306 height-in307 weight-1308 weight-2309 _310 dex-ptr-1311 dex-ptr-2312 dex-bank313 _314 & data]]315 (split-with (partial not= 0x50) data)]316 (recur (dec n)317 (assoc stats318 (pokedex-names (- pkmn-count (dec n)))319 {:species320 (format-name (character-codes->str species))321 :height-ft322 height-ft323 :height-in324 height-in325 :weight326 (/ (low-high weight-1 weight-2) 10.)328 ;; :text329 ;; (character-codes->str330 ;; (take-while331 ;; (partial not= 0x50)332 ;; (drop333 ;; (+ 0xB8000334 ;; -0x4000335 ;; (low-high dex-ptr-1 dex-ptr-2))336 ;; rom)))337 })339 data)342 )))344 pkmn-count345 {}346 (drop 0x40687 rom))) ))351 (def hxc-places352 "The hardcoded place names in memory. List begins at353 ROM@71500. [Cinnabar] Mansion seems to be dynamically calculated."354 (hxc-thunk-words 0x71500 560))357 (defn hxc-dialog358 "The hardcoded dialogue in memory, including in-game alerts. Dialog359 seems to be separated by 0x57 instead of 0x50 (END). Begins at ROM@98000."360 ([rom]361 (map character-codes->str362 (take-nth 2363 (partition-by #(= % 0x57)364 (take 0x0F728365 (drop 0x98000 rom))))))366 ([]367 (hxc-dialog com.aurellem.gb.gb-driver/original-rom)))370 (def hxc-move-names371 "The hardcoded move names in memory. List begins at ROM@BC000"372 (hxc-thunk-words 0xBC000 1551))373 (defn hxc-move-data374 "The hardcoded (basic (move effects)) in memory. List begins at375 0x38000. Returns a map of {:name :power :accuracy :pp :fx-id376 :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 6383 types pkmn-types ;;; !! hardcoded types384 ]385 (zipmap (map format-name names)386 (map387 (fn [[idx effect power type-id accuracy pp]]388 {:name (names (dec idx))389 :power power390 :accuracy accuracy391 :pp pp392 :type (types type-id)393 :fx-id effect394 :fx-txt (get move-effects effect)395 }396 )398 (partition move-size399 (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 6412 format-name (fn [s]413 (keyword (.toLowerCase414 (apply str415 (map #(if (= % \space) "-" %) s)))))416 ]417 (zipmap (map format-name names)418 (map419 (fn [[idx effect power type accuracy pp]]420 {:name (names (dec idx))421 :power power422 :accuracy (hex accuracy)423 :pp pp424 :fx-id (hex effect)425 :fx-txt (get move-effects effect)426 }427 )429 (partition move-size430 (take (* move-size move-count)431 (drop 0x38000 rom))))))))434 (defn hxc-machines435 "The hardcoded moves taught by TMs and HMs. List begins at ROM@1232D."436 ([] (hxc-machines437 com.aurellem.gb.gb-driver/original-rom))438 ([rom]439 (let [moves (hxc-move-names rom)]440 (zipmap441 (range)442 (take-while443 (comp not nil?)444 (map (comp445 format-name446 (zipmap447 (range)448 moves)449 dec)450 (take 100451 (drop 0x1232D rom))))))))456 (defn internal-id457 ([rom]458 (zipmap459 (hxc-pokenames rom)460 (range)))461 ([]462 (internal-id com.aurellem.gb.gb-driver/original-rom)))468 ;; nidoran gender change upon levelup469 ;; (->470 ;; @current-state471 ;; rom472 ;; vec473 ;; (rewrite-memory474 ;; (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♂))475 ;; [1 1 15])476 ;; (rewrite-memory477 ;; (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♀))478 ;; [1 1 3])479 ;; (write-rom!)481 ;; )489 (defn format-evo490 "Parse a sequence of evolution data, returning a map. First is the491 method: 0 = end-evolution-data. 1 = level-up, 2 = item, 3 = trade. Next is an item id, if the492 method of evolution is by item (only stones will actually make pokemon493 evolve, for some auxillary reason.) Finally, the minimum level for494 evolution to occur (level 1 means no limit, which is used for trade495 and item evolutions), followed by the internal id of the pokemon496 into which to evolve. Hence, level up and trade evolutions are497 described with 3498 bytes; item evolutions with four."499 [coll]500 (let [method (first coll)]501 (cond (empty? coll) []502 (= 0 method) [] ;; just in case503 (= 1 method) ;; level-up evolution504 (conj (format-evo (drop 3 coll))505 {:method :level-up506 :min-level (nth coll 1)507 :into (dec (nth coll 2))})509 (= 2 method) ;; item evolution510 (conj (format-evo (drop 4 coll))511 {:method :item512 :item (dec (nth coll 1))513 :min-level (nth coll 2)514 :into (dec (nth coll 3))})516 (= 3 method) ;; trade evolution517 (conj (format-evo (drop 3 coll))518 {:method :trade519 :min-level (nth coll 1) ;; always 1 for trade.520 :into (dec (nth coll 2))}))))523 (defn hxc-ptrs-evolve524 "A hardcoded collection of 190 pointers to alternating evolution/learnset data,525 in internal order."526 ([]527 (hxc-ptrs-evolve com.aurellem.gb.gb-driver/original-rom))528 ([rom]529 (let [530 pkmn-count (count (hxc-pokenames-raw)) ;; 190531 ptrs532 (map (fn [[a b]] (low-high a b))533 (partition 2534 (take (* 2 pkmn-count)535 (drop 0x3b1e5 rom))))]536 (map (partial + 0x34000) ptrs)538 )))541 (defn hxc-learnsets542 "Hardcoded map associating pokemon names to lists of pairs [lvl543 move] of abilities they learn as they level up. The data544 exists at ROM@34000, sorted by internal order. Pointers to the data545 exist at ROM@3B1E5; see also, hxc-ptrs-evolve"546 ([] (hxc-learnsets com.aurellem.gb.gb-driver/original-rom))547 ([rom]548 (apply assoc549 {}550 (interleave551 (hxc-pokenames rom)552 (map (comp553 (partial map554 (fn [[lvl mv]] [lvl (dec mv)]))555 (partial partition 2)556 ;; keep the learnset data557 (partial take-while (comp not zero?))558 ;; skip the evolution data559 rest560 (partial drop-while (comp not zero?)))561 (map #(drop % rom)562 (hxc-ptrs-evolve rom)))))))564 (defn hxc-learnsets-pretty565 "Live hxc-learnsets except it reports the name of each move --- as566 it appears in rom --- rather than the move index."567 ([] (hxc-learnsets-pretty com.aurellem.gb.gb-driver/original-rom))568 ([rom]569 (let [moves (vec(map format-name (hxc-move-names)))]570 (into {}571 (map (fn [[pkmn learnset]]572 [pkmn (map (fn [[lvl mv]] [lvl (moves mv)])573 learnset)])574 (hxc-learnsets rom))))))578 (defn hxc-pokemon-base579 ([] (hxc-pokemon-base com.aurellem.gb.gb-driver/original-rom))580 ([rom]581 (let [entry-size 28582 pkmn-count (count (hxc-pokedex-text rom))583 pokemon (rest (hxc-pokedex-names))584 types (apply assoc {}585 (interleave586 (range)587 pkmn-types)) ;;!! softcoded588 moves (apply assoc {}589 (interleave590 (range)591 (map format-name592 (hxc-move-names rom))))593 machines (hxc-machines)594 ]595 (zipmap596 pokemon597 (map598 (fn [[n599 rating-hp600 rating-atk601 rating-def602 rating-speed603 rating-special604 type-1605 type-2606 rarity607 rating-xp608 pic-dimensions ;; tile_width|tile_height (8px/tile)609 ptr-pic-obverse-1610 ptr-pic-obverse-2611 ptr-pic-reverse-1612 ptr-pic-reverse-2613 move-1614 move-2615 move-3616 move-4617 growth-rate618 &619 TMs|HMs]]620 (let621 [base-moves622 (mapv moves623 ((comp624 ;; since the game uses zero as a delimiter,625 ;; it must also increment all move indices by 1.626 ;; heren we decrement to correct this.627 (partial map dec)628 (partial take-while (comp not zero?)))629 [move-1 move-2 move-3 move-4]))631 types632 (set (list (types type-1)633 (types type-2)))634 TMs|HMs635 (map636 (comp637 (partial map first)638 (partial remove (comp zero? second)))639 (split-at640 50641 (map vector642 (rest(range))643 (reduce concat644 (map645 #(take 8646 (concat (bit-list %)647 (repeat 0)))649 TMs|HMs)))))651 TMs (vec (first TMs|HMs))652 HMs (take 5 (map (partial + -50) (vec (second TMs|HMs))))655 ]658 {:dex# n659 :base-moves base-moves660 :types types661 :TMs TMs662 :HMs HMs663 :base-hp rating-hp664 :base-atk rating-atk665 :base-def rating-def666 :base-speed rating-speed667 :base-special rating-special668 :o0 pic-dimensions669 :o1 ptr-pic-obverse-1670 :o2 ptr-pic-obverse-2671 }))673 (partition entry-size674 (take (* entry-size pkmn-count)675 (drop 0x383DE676 rom))))))))680 (defn hxc-intro-pkmn681 "The hardcoded pokemon to display in Prof. Oak's introduction; the pokemon's682 internal id is stored at ROM@5EDB."683 ([] (hxc-intro-pkmn684 com.aurellem.gb.gb-driver/original-rom))685 ([rom]686 (nth (hxc-pokenames rom) (nth rom 0x5EDB))))688 (defn sxc-intro-pkmn!689 "Set the hardcoded pokemon to display in Prof. Oak's introduction."690 [pokemon]691 (write-rom!692 (rewrite-rom 0x5EDB693 [694 (inc695 ((zipmap696 (hxc-pokenames)697 (range))698 pokemon))])))701 (defn hxc-item-prices702 "The hardcoded list of item prices in memory. List begins at ROM@4495"703 ([] (hxc-item-prices com.aurellem.gb.gb-driver/original-rom))704 ([rom]705 (let [items (hxc-items rom)706 price-size 3]707 (zipmap items708 (map (comp709 ;; zero-cost items are "priceless"710 #(if (zero? %) :priceless %)711 decode-bcd butlast)712 (partition price-size713 (take (* price-size (count items))714 (drop 0x4495 rom))))))))716 (defn hxc-shops717 ([] (hxc-shops com.aurellem.gb.gb-driver/original-rom))718 ([rom]719 (let [items (zipmap (range) (hxc-items rom))721 ;; temporarily softcode the TM items722 items (into723 items724 (map (juxt identity725 (comp keyword726 (partial str "tm-")727 (partial + 1 -200)728 ))729 (take 200 (drop 200 (range)))))731 ]733 ((fn parse-shop [coll [num-items & items-etc]]734 (let [inventory (take-while735 (partial not= 0xFF)736 items-etc)737 [separator & items-etc] (drop num-items (rest items-etc))]738 (if (= separator 0x50)739 (map (partial mapv (comp items dec)) (conj coll inventory))740 (recur (conj coll inventory) items-etc)741 )742 ))744 '()745 (drop 0x233C rom))748 )))753 (defn hxc-ptrs-wild754 "A list of the hardcoded wild encounter data in memory. Pointers755 begin at ROM@0CB95; data begins at ROM@0x04D89"756 ([] (hxc-ptrs-wild com.aurellem.gb.gb-driver/original-rom))757 ([rom]758 (let [ptrs759 (map (fn [[a b]] (+ a (* 0x100 b)))760 (take-while (partial not= (list 0xFF 0xFF))761 (partition 2 (drop 0xCB95 rom))))]762 ptrs)))766 (defn hxc-wilds767 "A list of the hardcoded wild encounter data in memory. Pointers768 begin at ROM@0CB95; data begins at ROM@0x04D89"769 ([] (hxc-wilds com.aurellem.gb.gb-driver/original-rom))770 ([rom]771 (let [pokenames (zipmap (range) (hxc-pokenames rom))]772 (map773 (partial map (fn [[a b]] {:species (pokenames (dec b)) :level774 a}))775 (partition 10777 (take-while (comp (partial not= 1)778 first)779 (partition 2780 (drop 0xCD8C rom))782 ))))))786 ;; ********************** MANIPULATION FNS789 (defn same-type790 ([pkmn move]791 (same-type792 com.aurellem.gb.gb-driver/original-rom pkmn move))793 ([rom pkmn move]794 (((comp :types (hxc-pokemon-base rom)) pkmn)795 ((comp :type (hxc-move-data rom)) move))))800 (defn submap?801 "Compares the two maps. Returns true if map-big has the same associations as map-small, otherwise false."802 [map-small map-big]803 (cond (empty? map-small) true804 (and805 (contains? map-big (ffirst map-small))806 (= (get map-big (ffirst map-small))807 (second (first map-small))))808 (recur (next map-small) map-big)810 :else false))813 (defn search-map [proto-map maps]814 "Returns all the maps that make the same associations as proto-map."815 (some (partial submap? proto-map) maps))817 (defn filter-vals818 "Returns a map consisting of all the pairs [key val] for819 which (pred key) returns true."820 [pred map]821 (reduce (partial apply assoc) {}822 (filter (fn [[k v]] (pred v)) map)))825 (defn search-moves826 "Returns a subcollection of all hardcoded moves with the827 given attributes. Attributes consist of :name :power828 :accuracy :pp :fx-id829 (and also :fx-txt, but it contains the same information830 as :fx-id)"831 ([attribute-map]832 (search-moves833 com.aurellem.gb.gb-driver/original-rom attribute-map))834 ([rom attribute-map]835 (filter-vals (partial submap? attribute-map)836 (hxc-move-data rom))))842 ;; note: 0x2f31 contains the names "TM" "HM"?844 ;; note for later: credits start at F1290846 ;; note: DADB hyper-potion-hp _ _ _ super-potion-hp _ _ _ potion-hp ??848 ;; note: DD4D spells out pokemon vital stat names ("speed", etc.)850 ;; note: 1195C-6A says ABLE#NOT ABLE#, but so does 119C0-119CE.851 ;; The first instance is for Machines; the second, for stones.853 ;; 0x251A (in indexable mem): image decompression routine seems to begin here.856 (comment858 (def hxc-later859 "Running this code produces, e.g. hardcoded names NPCs give860 their pokemon. Will sort through it later."861 (print (character-codes->str(take 10000862 (drop 0x71597863 (rom (root)))))))865 (let [dex866 (partition-by #(= 0x50 %)867 (take 2540868 (drop 0x40687869 (rom (root)))))]870 (def dex dex)871 (def hxc-species872 (map character-codes->str873 (take-nth 4 dex))))874 )