Mercurial > vba-clojure
comparison clojure/com/aurellem/gb/hxc.clj @ 288:eec3e69500d9
Made hxc-pokenames and hxc-items return keywords instead of strings by default; added hxc-pokenames-raw and hxc-items-raw for the string version.
author | Dylan Holmes <ocsenave@gmail.com> |
---|---|
date | Thu, 29 Mar 2012 13:31:31 -0500 |
parents | 33c546273619 |
children | c31cb3043087 |
comparison
equal
deleted
inserted
replaced
287:7918c0dcc0bd | 288:eec3e69500d9 |
---|---|
1 (ns com.aurellem.gb.hxc | 1 (ns com.aurellem.gb.hxc |
2 (:use (com.aurellem.gb assembly characters gb-driver util | 2 (:use (com.aurellem.gb assembly characters gb-driver util |
3 constants species)) | 3 constants species)) |
4 (:use (com.aurellem.world practice)) | 4 ;; (:use (com.aurellem.world practice)) |
5 (:import [com.aurellem.gb.gb_driver SaveState])) | 5 (:import [com.aurellem.gb.gb_driver SaveState])) |
6 | 6 |
7 | 7 |
8 | 8 |
9 | 9 |
10 ; ************* HANDWRITTEN CONSTANTS | 10 ; ************* HANDWRITTEN CONSTANTS |
11 | 11 |
12 | 12 |
13 | |
14 (defn low-high | |
15 [low high] | |
16 (+ low (* 256 high))) | |
17 | |
18 | |
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)))))) | |
27 | |
28 | |
29 ;; used to decode item prices | |
30 | |
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)))) | |
41 | |
42 | |
43 | |
44 | 13 |
45 (def pkmn-types | 14 (def pkmn-types |
46 [:normal ;;0 | 15 [:normal ;;0 |
47 :fighting ;;1 | 16 :fighting ;;1 |
48 :flying ;;2 | 17 :flying ;;2 |
195 hxc-thunk)) | 164 hxc-thunk)) |
196 | 165 |
197 | 166 |
198 ;; -------------------------------------------------- | 167 ;; -------------------------------------------------- |
199 | 168 |
200 (def hxc-items | 169 |
170 | |
171 (defn hxc-pokenames-raw | |
172 "The hardcoded names of the 190 species in memory. List begins at | |
173 ROM@E8000. Although names in memory are padded with 0x50 to be 10 characters | |
174 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 190 | |
179 name-length 10] | |
180 (map character-codes->str | |
181 (partition name-length | |
182 (map #(if (= 0x50 %) 0x00 %) | |
183 (take (* count-species name-length) | |
184 (drop 0xE8000 | |
185 rom)))))))) | |
186 (def hxc-pokenames | |
187 (comp | |
188 (partial map format-name) | |
189 hxc-pokenames-raw)) | |
190 | |
191 | |
192 | |
193 | |
194 (defn hxc-pokedex-names | |
195 "The names of the pokemon in hardcoded pokedex order. List begins at | |
196 ROM@410B1. See also, hxc-pokenames." | |
197 ([] (hxc-pokedex-names | |
198 com.aurellem.gb.gb-driver/original-rom)) | |
199 ([rom] | |
200 (let [names (hxc-pokenames rom)] | |
201 (#(mapv % | |
202 ((comp range count keys) %)) | |
203 (zipmap | |
204 (take (count names) | |
205 (drop 0x410b1 rom)) | |
206 | |
207 names))))) | |
208 | |
209 | |
210 | |
211 | |
212 (def hxc-items-raw | |
201 "The hardcoded names of the items in memory. List begins at | 213 "The hardcoded names of the items in memory. List begins at |
202 ROM@045B7" | 214 ROM@045B7" |
203 (hxc-thunk-words 0x45B7 870)) | 215 (hxc-thunk-words 0x45B7 870)) |
204 | 216 |
205 (def hxc-types | 217 (def hxc-types |
211 "The hardcoded names of the trainer titles in memory. List begins at | 223 "The hardcoded names of the trainer titles in memory. List begins at |
212 ROM@27E77" | 224 ROM@27E77" |
213 (hxc-thunk-words 0x27E77 196)) | 225 (hxc-thunk-words 0x27E77 196)) |
214 | 226 |
215 | 227 |
216 (def hxc-pokedex-text* | 228 (def hxc-pokedex-text-raw |
217 "The hardcoded pokedex entries in memory. List begins at | 229 "The hardcoded pokedex entries in memory. List begins at |
218 ROM@B8000, shortly before move names." | 230 ROM@B8000, shortly before move names." |
219 (hxc-thunk-words 0xB8000 14754)) | 231 (hxc-thunk-words 0xB8000 14754)) |
232 | |
233 | |
234 | |
235 (def hxc-items | |
236 "The hardcoded names of the items in memory, presented as | |
237 keywords. List begins at ROM@045B7. See also, hxc-items-raw." | |
238 (comp (partial map format-name) hxc-items-raw)) | |
220 | 239 |
221 (defn hxc-pokedex-text | 240 (defn hxc-pokedex-text |
222 "The hardcoded pokedex entries in memory, presented as an | 241 "The hardcoded pokedex entries in memory, presented as an |
223 associative hash map. List begins at ROM@B8000." | 242 associative hash map. List begins at ROM@B8000." |
224 ([] (hxc-pokedex-text com.aurellem.gb.gb-driver/original-rom)) | 243 ([] (hxc-pokedex-text com.aurellem.gb.gb-driver/original-rom)) |
225 ([rom] | 244 ([rom] |
226 (zipmap | 245 (zipmap |
227 (hxc-pokedex-names rom) | 246 (hxc-pokedex-names rom) |
228 (cons nil ;; for missingno. | 247 (cons nil ;; for missingno. |
229 (hxc-pokedex-text* rom))))) | 248 (hxc-pokedex-text-raw rom))))) |
230 | 249 |
231 ;; In red/blue, pokedex stats are in internal order. | 250 ;; In red/blue, pokedex stats are in internal order. |
232 ;; In yellow, pokedex stats are in pokedex order. | 251 ;; In yellow, pokedex stats are in pokedex order. |
233 | 252 |
234 (defn hxc-pokedex-stats | 253 (defn hxc-pokedex-stats |
235 "The hardcoded pokedex stats (species height weight) in memory. List | 254 "The hardcoded pokedex stats (species height weight) in memory. List |
236 begins at ROM@40687" | 255 begins at ROM@40687" |
237 ;; uses hxc-pokedex-text to count pokemon | |
238 ;; since hxc-pokenames includes several missingno" | |
239 ([] (hxc-pokedex-stats com.aurellem.gb.gb-driver/original-rom)) | 256 ([] (hxc-pokedex-stats com.aurellem.gb.gb-driver/original-rom)) |
240 ([rom] | 257 ([rom] |
241 (let [poketext (hxc-pokedex-text rom) | 258 (let [pokedex-names (zipmap (range) (hxc-pokedex-names rom)) |
242 pkmn-count (count poketext) | 259 pkmn-count (count pokedex-names) |
243 pokedex-names (zipmap (range) (hxc-pokedex-names rom)) | |
244 ] | 260 ] |
245 ((fn capture-stats | 261 ((fn capture-stats |
246 [n stats data] | 262 [n stats data] |
247 (if (zero? n) stats | 263 (if (zero? n) stats |
248 (let [[species | 264 (let [[species |
397 (range) | 413 (range) |
398 moves) | 414 moves) |
399 dec) | 415 dec) |
400 (take 100 | 416 (take 100 |
401 (drop 0x1232D rom)))))))) | 417 (drop 0x1232D rom)))))))) |
402 | |
403 (defn hxc-pokenames | |
404 "The hardcoded names of the 190 species in memory. List begins at | |
405 ROM@E8000. Although names in memory are padded with 0x50 to be 10 characters | |
406 long, these names are stripped of padding. See also, hxc-pokedex-names" | |
407 ([] | |
408 (hxc-pokenames com.aurellem.gb.gb-driver/original-rom)) | |
409 ([rom] | |
410 (let [count-species 190 | |
411 name-length 10] | |
412 (map character-codes->str | |
413 (partition name-length | |
414 (map #(if (= 0x50 %) 0x00 %) | |
415 (take (* count-species name-length) | |
416 (drop 0xE8000 | |
417 rom)))))))) | |
418 | |
419 | |
420 | |
421 (defn hxc-pokedex-names | |
422 "The names of the pokemon in hardcoded pokedex order. List begins at | |
423 ROM@410B1. See also, hxc-pokenames." | |
424 ([] (hxc-pokedex-names | |
425 com.aurellem.gb.gb-driver/original-rom)) | |
426 ([rom] | |
427 (let [names (hxc-pokenames rom)] | |
428 (#(mapv % | |
429 ((comp range count keys) %)) | |
430 (zipmap | |
431 (take (count names) | |
432 (drop 0x410b1 rom)) | |
433 | |
434 (map format-name names)))))) | |
435 | 418 |
436 | 419 |
437 | 420 |
438 (defn internal-id | 421 (defn internal-id |
439 ([rom] | 422 ([rom] |
440 (zipmap | 423 (zipmap |
441 (map format-name (hxc-pokenames rom)) | 424 (hxc-pokenames rom) |
442 (range))) | 425 (range))) |
443 ([] | 426 ([] |
444 (internal-id com.aurellem.gb.gb-driver/original-rom))) | 427 (internal-id com.aurellem.gb.gb-driver/original-rom))) |
445 | 428 |
446 | 429 |
509 "A hardcoded collection of 190 pointers to alternating evolution/learnset data, | 492 "A hardcoded collection of 190 pointers to alternating evolution/learnset data, |
510 in internal order." | 493 in internal order." |
511 ([] | 494 ([] |
512 (hxc-ptrs-evolve com.aurellem.gb.gb-driver/original-rom)) | 495 (hxc-ptrs-evolve com.aurellem.gb.gb-driver/original-rom)) |
513 ([rom] | 496 ([rom] |
514 (let [names (hxc-pokenames rom) | 497 (let [ |
515 pkmn-count (count names) | 498 pkmn-count (count (hxc-pokenames-raw)) ;; 190 |
516 ptrs | 499 ptrs |
517 (map (fn [[a b]] (low-high a b)) | 500 (map (fn [[a b]] (low-high a b)) |
518 (partition 2 | 501 (partition 2 |
519 (take (* 2 pkmn-count) | 502 (take (* 2 pkmn-count) |
520 (drop 0x3b1e5 rom))))] | 503 (drop 0x3b1e5 rom))))] |
531 ([] (hxc-learnsets com.aurellem.gb.gb-driver/original-rom)) | 514 ([] (hxc-learnsets com.aurellem.gb.gb-driver/original-rom)) |
532 ([rom] | 515 ([rom] |
533 (apply assoc | 516 (apply assoc |
534 {} | 517 {} |
535 (interleave | 518 (interleave |
536 (map format-name (hxc-pokenames rom)) | 519 (hxc-pokenames rom) |
537 (map (comp | 520 (map (comp |
538 (partial map | 521 (partial map |
539 (fn [[lvl mv]] [lvl (dec mv)])) | 522 (fn [[lvl mv]] [lvl (dec mv)])) |
540 (partial partition 2) | 523 (partial partition 2) |
541 ;; keep the learnset data | 524 ;; keep the learnset data |
566 sorted by internal order. Pointers to the data exist at ROM@3B1E5; see also, hxc-ptrs-evolve." | 549 sorted by internal order. Pointers to the data exist at ROM@3B1E5; see also, hxc-ptrs-evolve." |
567 ([] (hxc-evolution com.aurellem.gb.gb-driver/original-rom)) | 550 ([] (hxc-evolution com.aurellem.gb.gb-driver/original-rom)) |
568 ([rom] | 551 ([rom] |
569 (apply assoc {} | 552 (apply assoc {} |
570 (interleave | 553 (interleave |
571 (map format-name (hxc-pokenames rom)) | 554 (hxc-pokenames rom) |
572 (map | 555 (map |
573 (comp | 556 (comp |
574 format-evo | 557 format-evo |
575 (partial take-while (comp not zero?)) | 558 (partial take-while (comp not zero?)) |
576 #(drop % rom)) | 559 #(drop % rom)) |
581 "Like hxc-evolution, except it uses the names of items and pokemon | 564 "Like hxc-evolution, except it uses the names of items and pokemon |
582 --- grabbed from ROM --- rather than their numerical identifiers." | 565 --- grabbed from ROM --- rather than their numerical identifiers." |
583 ([] (hxc-evolution-pretty com.aurellem.gb.gb-driver/original-rom)) | 566 ([] (hxc-evolution-pretty com.aurellem.gb.gb-driver/original-rom)) |
584 ([rom] | 567 ([rom] |
585 (let | 568 (let |
586 [poke-names (vec (map format-name (hxc-pokenames rom))) | 569 [poke-names (vec (hxc-pokenames rom)) |
587 item-names (vec (map format-name (hxc-items rom))) | 570 item-names (vec (hxc-items rom)) |
588 use-names | 571 use-names |
589 (fn [m] | 572 (fn [m] |
590 (loop [ks (keys m) new-map m] | 573 (loop [ks (keys m) new-map m] |
591 (let [k (first ks)] | 574 (let [k (first ks)] |
592 (cond (nil? ks) new-map | 575 (cond (nil? ks) new-map |
613 | 596 |
614 (into {} | 597 (into {} |
615 (map (fn [[pkmn evo-coll]] | 598 (map (fn [[pkmn evo-coll]] |
616 [pkmn (map use-names evo-coll)]) | 599 [pkmn (map use-names evo-coll)]) |
617 (hxc-evolution rom)))))) | 600 (hxc-evolution rom)))))) |
618 | |
619 | |
620 | |
621 | 601 |
622 | 602 |
623 (defn hxc-pokemon-base | 603 (defn hxc-pokemon-base |
624 ([] (hxc-pokemon-base com.aurellem.gb.gb-driver/original-rom)) | 604 ([] (hxc-pokemon-base com.aurellem.gb.gb-driver/original-rom)) |
625 ([rom] | 605 ([rom] |
633 moves (apply assoc {} | 613 moves (apply assoc {} |
634 (interleave | 614 (interleave |
635 (range) | 615 (range) |
636 (map format-name | 616 (map format-name |
637 (hxc-move-names rom)))) | 617 (hxc-move-names rom)))) |
618 machines (hxc-machines) | |
638 ] | 619 ] |
639 (zipmap | 620 (zipmap |
640 pokemon | 621 pokemon |
641 (map | 622 (map |
642 (fn [[n | 623 (fn [[n |
720 | 701 |
721 (defn hxc-item-prices | 702 (defn hxc-item-prices |
722 "The hardcoded list of item prices in memory. List begins at ROM@4495" | 703 "The hardcoded list of item prices in memory. List begins at ROM@4495" |
723 ([] (hxc-item-prices com.aurellem.gb.gb-driver/original-rom)) | 704 ([] (hxc-item-prices com.aurellem.gb.gb-driver/original-rom)) |
724 ([rom] | 705 ([rom] |
725 (let [items (map format-name (hxc-items rom)) | 706 (let [items (hxc-items rom) |
726 price-size 3] | 707 price-size 3] |
727 (zipmap items | 708 (zipmap items |
728 (map (comp | 709 (map (comp |
729 ;; zero-cost items are "priceless" | 710 ;; zero-cost items are "priceless" |
730 #(if (zero? %) :priceless %) | 711 #(if (zero? %) :priceless %) |
734 (drop 0x4495 rom)))))))) | 715 (drop 0x4495 rom)))))))) |
735 | 716 |
736 (defn hxc-shops | 717 (defn hxc-shops |
737 ([] (hxc-shops com.aurellem.gb.gb-driver/original-rom)) | 718 ([] (hxc-shops com.aurellem.gb.gb-driver/original-rom)) |
738 ([rom] | 719 ([rom] |
739 (let [items (zipmap (range) (map format-name (hxc-items rom))) | 720 (let [items (zipmap (range) (hxc-items rom)) |
740 | 721 |
741 ;; temporarily softcode the TM items | 722 ;; temporarily softcode the TM items |
742 items (into | 723 items (into |
743 items | 724 items |
744 (map (juxt identity | 725 (map (juxt identity |
772 ;; ********************** MANIPULATION FNS | 753 ;; ********************** MANIPULATION FNS |
773 | 754 |
774 | 755 |
775 (defn same-type | 756 (defn same-type |
776 ([pkmn move] | 757 ([pkmn move] |
777 (same-type? | 758 (same-type |
778 com.aurellem.gb.gb-driver/original-rom pkmn move)) | 759 com.aurellem.gb.gb-driver/original-rom pkmn move)) |
779 ([rom pkmn move] | 760 ([rom pkmn move] |
780 (((comp :types (hxc-pokemon-base rom)) pkmn) | 761 (((comp :types (hxc-pokemon-base rom)) pkmn) |
781 ((comp :type (hxc-move-data rom)) move)))) | 762 ((comp :type (hxc-move-data rom)) move)))) |
782 | 763 |