view clojure/com/aurellem/gb/hxc.clj @ 277:710bfbb1e048

fix compiliation errors
author Robert McIntyre <rlm@mit.edu>
date Tue, 27 Mar 2012 12:57:58 -0500
parents 69184558fcf3
children ca1afcef3542
line wrap: on
line source
1 (ns com.aurellem.gb.hxc
2 (:use (com.aurellem.gb assembly characters gb-driver util
3 constants))
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 (keyword (.toLowerCase
24 (apply str
25 (map #(if (= % \space) "-" %) s)))))
29 (def pkmn-types
30 [:normal ;;0
31 :fighting ;;1
32 :flying ;;2
33 :poison ;;3
34 :ground ;;4
35 :rock ;;5
36 :bird ;;6
37 :bug ;;7
38 :ghost ;;8
39 :A
40 :B
41 :C
42 :D
43 :E
44 :F
45 :G
46 :H
47 :I
48 :J
49 :K
50 :fire ;;20 (0x14)
51 :water ;;21 (0x15)
52 :grass ;;22 (0x16)
53 :electric ;;23 (0x17)
54 :psychic ;;24 (0x18)
55 :ice ;;25 (0x19)
56 :dragon ;;26 (0x1A)
57 ])
60 ;; question: when status effects claim to take
61 ;; their accuracy from the move accuracy, does
62 ;; this mean that the move always "hits" but the
63 ;; status effect may not?
65 (def move-effects
66 ["normal damage"
67 "no damage, just opponent sleep" ;; how many turns? is atk power ignored?
68 "0x4C chance of poison"
69 "leech half of inflicted damage"
70 "0x19 chance of burn"
71 "0x19 chance of freeze"
72 "0x19 chance of paralyze"
73 "user faints; opponent defense halved during attack."
74 "leech half of inflicted damage ONLY if sleeping opponent."
75 "imitate last attack"
76 "user atk +1"
77 "user def +1"
78 "user spd +1"
79 "user spc +1"
80 "user acr +1" ;; unused?!
81 "user evd +1"
82 "get post-battle $ = 2*level*uses"
83 "0xFE acr, no matter what."
84 "opponent atk -1" ;; acr taken from move acr?
85 "opponent def -1" ;;
86 "opponent spd -1" ;;
87 "opponent spc -1" ;;
88 "opponent acr -1";;
89 "opponent evd -1"
90 "converts user's type to opponent's."
91 "(haze)"
92 "(bide)"
93 "(thrash)"
94 "(teleport)"
95 "(fury swipes)"
96 "attacks 2-5 turns" ;; unused? like rollout?
97 "0x19 chance of flinch"
98 "opponent sleep for 1-7 turns"
99 "0x66 chance of poison"
100 "0x4D chance of burn"
101 "0x4D chance of freeze"
102 "0x4D chance of paralyze"
103 "0x4D chance of flinch"
104 "one-hit KO"
105 "charge one turn, atk next."
106 "fixed damage, leaves 1HP." ;; how is dmg determined?
107 "fixed damage." ;; cf seismic toss, dragon rage, psywave.
108 "atk 2-5 turns; opponent can't attack" ;; unnormalized? (0 0x60 0x60 0x20 0x20)
109 "charge one turn, atk next. (can't be hit when charging)"
110 "atk hits twice."
111 "user takes 1 damage if misses."
112 "evade status-lowering effects" ;;caused by you or also your opponent?
113 "(broken) if user is slower than opponent, makes critical hit impossible, otherwise has no effect"
114 "atk causes recoil dmg = 1/4 dmg dealt"
115 "confuses opponent" ;; acr taken from move acr
116 "user atk +2"
117 "user def +2"
118 "user spd +2"
119 "user spc +2"
120 "user acr +2" ;; unused!
121 "user evd +2" ;; unused!
122 "restores up to half of user's max hp." ;; broken: fails if the difference
123 ;; b/w max and current hp is one less than a multiple of 256.
124 "(transform)"
125 "opponent atk -2"
126 "opponent def -2"
127 "opponent spd -2"
128 "opponent spc -2"
129 "opponent acr -2"
130 "opponent evd -2"
131 "doubles user spc when attacked"
132 "doubles user def when attacked"
133 "just poisons opponent" ;;acr taken from move acr
134 "just paralyzes opponent" ;;
135 "0x19 chance opponent atk -1"
136 "0x19 chance opponent def -1"
137 "0x19 chance opponent spd -1"
138 "0x4C chance opponent spc -1" ;; context suggest chance is 0x19
139 "0x19 chance opponent acr -1"
140 "0x19 chance opponent evd -1"
141 "???" ;; unused? no effect?
142 "???" ;; unused? no effect?
143 "0x19 chance opponent confused"
144 "atk hits twice. 0x33 chance opponent poisioned."
145 "broken. crash the game after attack."
146 "(substitute)"
147 "unless opponent faints, user must recharge after atk. some
148 exceptions apply."
149 "(rage)"
150 "(mimic)"
151 "(metronome)"
152 "(leech seed)"
153 "does nothing (splash)"
154 "(disable)"
155 ])
158 ;; ************** HARDCODED DATA
160 (defn hxc-thunk
161 "Creates a thunk (nullary fn) that grabs data in a certain region of rom and
162 splits it into a collection by 0x50. If rom is not supplied, uses the
163 original rom data."
164 [start length]
165 (fn self
166 ([rom]
167 (take-nth 2
168 (partition-by #(= % 0x50)
169 (take length
170 (drop start rom)))))
171 ([]
172 (self com.aurellem.gb.gb-driver/original-rom))))
174 (def hxc-thunk-words
175 "Same as hxc-thunk, except it interprets the rom data as characters,
176 returning a collection of strings."
177 (comp
178 (partial comp (partial map character-codes->str))
179 hxc-thunk))
182 ;; --------------------------------------------------
184 (def hxc-items
185 "The hardcoded names of the items in memory. List begins at
186 ROM@045B7"
187 (hxc-thunk-words 0x45B7 870))
189 (def hxc-types
190 "The hardcoded type names in memory. List begins at ROM@27D99,
191 shortly before hxc-titles."
192 (hxc-thunk-words 0x27D99 102))
194 (def hxc-titles
195 "The hardcoded names of the trainer titles in memory. List begins at
196 ROM@27E77"
197 (hxc-thunk-words 0x27E77 196))
200 (def hxc-pokedex-text
201 "The hardcoded pokedex entries in memory. List begins at
202 ROM@B8000, shortly before move names."
203 (hxc-thunk-words 0xB8000 14754))
206 ;; In red/blue, pokedex stats are in internal order.
207 ;; In yellow, pokedex stats are in pokedex order.
209 (defn hxc-pokedex-stats
210 "The hardcoded pokedex stats (species height weight) in memory. List
211 begins at ROM@40687"
212 ;; uses hxc-pokedex-text to count pokemon
213 ;; since hxc-pokenames includes several missingno"
214 ([] (hxc-pokedex-stats com.aurellem.gb.gb-driver/original-rom))
215 ([rom]
216 (let [poketext (hxc-pokedex-text)
217 pkmn-count (count poketext)
218 ]
219 ((fn capture-stats
220 [n stats data]
221 (if (zero? n) stats
222 (let [[species
223 [_
224 height-ft
225 height-in
226 weight-1
227 weight-2
228 _
229 dex-ptr-1
230 dex-ptr-2
231 dex-bank
232 _
233 & data]]
234 (split-with (partial not= 0x50) data)]
235 (recur (dec n)
236 (assoc stats
237 (- pkmn-count n)
238 {:species
239 (character-codes->str species)
240 :height-ft
241 height-ft
242 :height-in
243 height-in
244 :weight
245 (/ (low-high weight-1 weight-2) 10.)
247 ;; :text
248 ;; (character-codes->str
249 ;; (take-while
250 ;; (partial not= 0x50)
251 ;; (drop
252 ;; (+ 0xB8000
253 ;; -0x4000
254 ;; (low-high dex-ptr-1 dex-ptr-2))
255 ;; rom)))
256 })
258 data)
261 )))
263 pkmn-count
264 {}
265 (drop 0x40687 rom))) ))
273 (def hxc-places
274 "The hardcoded place names in memory. List begins at
275 ROM@71500. [Cinnabar] Mansion seems to be dynamically calculated."
276 (hxc-thunk-words 0x71500 560))
279 (defn hxc-dialog
280 "The hardcoded dialogue in memory, including in-game alerts. Dialog
281 seems to be separated by 0x57 instead of 0x50 (END). Begins at ROM@98000."
282 ([rom]
283 (map character-codes->str
284 (take-nth 2
285 (partition-by #(= % 0x57)
286 (take 0x0F728
287 (drop 0x98000 rom))))))
288 ([]
289 (hxc-dialog com.aurellem.gb.gb-driver/original-rom)))
294 (def hxc-move-names
295 "The hardcoded move names in memory. List begins at ROM@BC000"
296 (hxc-thunk-words 0xBC000 1551))
299 (defn hxc-move-data
300 "The hardcoded (basic (move effects)) in memory. List begins at
301 0x38000. Returns a map of {:name :power :accuracy :pp :fx-id
302 :fx-txt}. The move descriptions are handwritten, not hardcoded."
303 ([]
304 (hxc-move-data com.aurellem.gb.gb-driver/original-rom))
305 ([rom]
306 (let [names (vec (hxc-move-names rom))
307 move-count (count names)
308 move-size 6]
309 (zipmap (map format-name names)
310 (map
311 (fn [[idx effect power type accuracy pp]]
312 {:name (names (dec idx))
313 :power power
314 :accuracy accuracy
315 :pp pp
316 :fx-id effect
317 :fx-txt (get move-effects effect)
318 }
319 )
321 (partition move-size
322 (take (* move-size move-count)
323 (drop 0x38000 rom))))))))
327 (defn hxc-move-data*
328 "Like hxc-move-data, but reports numbers as hexadecimal symbols instead."
329 ([]
330 (hxc-move-data* com.aurellem.gb.gb-driver/original-rom))
331 ([rom]
332 (let [names (vec (hxc-move-names rom))
333 move-count (count names)
334 move-size 6
335 format-name (fn [s]
336 (keyword (.toLowerCase
337 (apply str
338 (map #(if (= % \space) "-" %) s)))))
339 ]
340 (zipmap (map format-name names)
341 (map
342 (fn [[idx effect power type accuracy pp]]
343 {:name (names (dec idx))
344 :power power
345 :accuracy (hex accuracy)
346 :pp pp
347 :fx-id (hex effect)
348 :fx-txt (get move-effects effect)
349 }
350 )
352 (partition move-size
353 (take (* move-size move-count)
354 (drop 0x38000 rom))))))))
358 (defn hxc-pokenames
359 "The hardcoded names of the 190 species in memory. List begins at
360 ROM@E8000. Although names in memory are padded with 0x50 to be 10 characters
361 long, these names are stripped of padding."
362 ([]
363 (hxc-pokenames com.aurellem.gb.gb-driver/original-rom))
364 ([rom]
365 (let [count-species 190
366 name-length 10]
367 (map character-codes->str
368 (partition name-length
369 (map #(if (= 0x50 %) 0x00 %)
370 (take (* count-species name-length)
371 (drop 0xE8000
372 rom))))))))
377 (defn internal-id
378 ([rom]
379 (zipmap
380 (map format-name (hxc-pokenames rom))
381 (range)))
382 ([]
383 (internal-id com.aurellem.gb.gb-driver/original-rom)))
387 ;; nidoran gender change upon levelup
388 ;; (->
389 ;; @current-state
390 ;; rom
391 ;; vec
392 ;; (rewrite-memory
393 ;; (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♂))
394 ;; [1 1 15])
395 ;; (rewrite-memory
396 ;; (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♀))
397 ;; [1 1 3])
398 ;; (write-rom!)
400 ;; )
405 (defn hxc-advantage
406 "The hardcoded type advantages in memory, returned as tuples of atk-type def-type multiplier. By default (i.e. if not listed here),
407 the multiplier is 1."
408 ([] (hxc-advantage com.aurellem.gb.gb-driver/original-rom))
409 ([rom]
410 (map
411 (fn [[atk def mult]] [(get pkmn-types atk (hex atk))
412 (get pkmn-types def (hex def))
413 (/ mult 10)])
414 (partition 3
415 (take-while (partial not= 0xFF)
416 (drop 0x3E62D rom))))))
419 (defn format-evo
420 [coll]
421 (let [method (first coll)]
422 (cond (empty? coll) []
423 (= 0 method) [] ;; just in case
424 (= 1 method) ;; level-up evolution
425 (conj (format-evo (drop 3 coll))
426 {:method :level-up
427 :min-level (nth coll 1)
428 :into (dec (nth coll 2))})
430 (= 2 method) ;; item evolution
431 (conj (format-evo (drop 4 coll))
432 {:method :item
433 :item (dec (nth coll 1))
434 :min-level (nth coll 2)
435 :into (dec (nth coll 3))})
437 (= 3 method) ;; trade evolution
438 (conj (format-evo (drop 3 coll))
439 {:method :trade
440 :min-level (nth coll 1) ;; always 1 for trade.
441 :into (dec (nth coll 2))}))))
444 (defn hxc-ptrs-evolve
445 "A hardcoded collection of 190 pointers to alternating evolution/learnset data,
446 in internal order."
447 ([]
448 (hxc-ptrs-evolve com.aurellem.gb.gb-driver/original-rom))
449 ([rom]
450 (let [names (hxc-pokenames rom)
451 pkmn-count (count names)
452 ptrs
453 (map (fn [[a b]] (low-high a b))
454 (partition 2
455 (take (* 2 pkmn-count)
456 (drop 0x3b1e5 rom))))]
457 (map (partial + 0x34000) ptrs)
459 )))
462 (defn hxc-learnsets
463 "Hardcoded map associating pokemon names to lists of pairs [lvl
464 move] of abilities they learn as they level up. The data
465 exists at ROM@3400, sorted by internal order. Pointers to the data
466 exist at ROM@3B1E5; see also, hxc-ptrs-evolve"
467 ([] (hxc-learnsets com.aurellem.gb.gb-driver/original-rom))
468 ([rom]
469 (apply assoc
470 {}
471 (interleave
472 (map format-name (hxc-pokenames rom))
473 (map (comp
474 (partial map
475 (fn [[lvl mv]] [lvl (dec mv)]))
476 (partial partition 2)
477 ;; keep the learnset data
478 (partial take-while (comp not zero?))
479 ;; skip the evolution data
480 rest
481 (partial drop-while (comp not zero?)))
482 (map #(drop % rom)
483 (hxc-ptrs-evolve rom)))))))
485 (defn hxc-learnsets-pretty
486 "Live hxc-learnsets except it reports the name of each move --- as
487 it appears in rom --- rather than the move index."
488 ([] (hxc-learnsets-pretty com.aurellem.gb.gb-driver/original-rom))
489 ([rom]
490 (let [moves (vec(map format-name (hxc-move-names)))]
491 (into {}
492 (map (fn [[pkmn learnset]]
493 [pkmn (map (fn [[lvl mv]] [lvl (moves mv)])
494 learnset)])
495 (hxc-learnsets rom))))))
500 (defn hxc-evolution
501 "Hardcoded evolution data in memory. The data exists at ROM@34000,
502 sorted by internal order. Pointers to the data exist at ROM@3B1E5; see also, hxc-ptrs-evolve."
503 ([] (hxc-evolution com.aurellem.gb.gb-driver/original-rom))
504 ([rom]
505 (apply assoc {}
506 (interleave
507 (map format-name (hxc-pokenames rom))
508 (map
509 (comp
510 format-evo
511 (partial take-while (comp not zero?))
512 #(drop % rom))
513 (hxc-ptrs-evolve rom)
514 )))))
516 (defn hxc-evolution-pretty
517 "Like hxc-evolution, except it uses the names of items and pokemon
518 --- grabbed from ROM --- rather than their numerical identifiers."
519 ([] (hxc-evolution-pretty com.aurellem.gb.gb-driver/original-rom))
520 ([rom]
521 (let
522 [poke-names (vec (map format-name (hxc-pokenames rom)))
523 item-names (vec (map format-name (hxc-items rom)))
524 use-names
525 (fn [m]
526 (loop [ks (keys m) new-map m]
527 (let [k (first ks)]
528 (cond (nil? ks) new-map
529 (= k :into)
530 (recur
531 (next ks)
532 (assoc new-map
533 :into
534 (poke-names
535 (:into
536 new-map))))
537 (= k :item)
538 (recur
539 (next ks)
540 (assoc new-map
541 :item
542 (item-names
543 (:item new-map))))
544 :else
545 (recur
546 (next ks)
547 new-map)
548 ))))]
550 (into {}
551 (map (fn [[pkmn evo-coll]]
552 [pkmn (map use-names evo-coll)])
553 (hxc-evolution rom))))))
559 (defn hxc-pokemon-base
560 ([] (hxc-pokemon-base com.aurellem.gb.gb-driver/original-rom))
561 ([rom]
562 (let [entry-size 28
563 pkmn-count (count (hxc-pokedex-text rom))
564 types (apply assoc {}
565 (interleave
566 (range)
567 pkmn-types)) ;;!! softcoded
568 moves (apply assoc {}
569 (interleave
570 (range)
571 (map format-name
572 (hxc-move-names rom))))
573 ]
574 (map
576 (fn [[n
577 rating-hp
578 rating-atk
579 rating-def
580 rating-speed
581 rating-special
582 type-1
583 type-2
584 rarity
585 rating-xp
586 pic-dimensions
587 ptr-pic-obverse-1
588 ptr-pic-obverse-2
589 ptr-pic-reverse-1
590 ptr-pic-reverse-2
591 move-1
592 move-2
593 move-3
594 move-4
595 growth-rate
596 &
597 TMs|HMs]]
598 (let
599 [base-moves
600 (mapv moves
601 ((comp
602 ;; since the game uses zero as a delimiter,
603 ;; it must also increment all move indices by 1.
604 ;; heren we decrement to correct this.
605 (partial map dec)
606 (partial take-while (comp not zero?)))
607 [move-1 move-2 move-3 move-4]))
609 types
610 (set (list (types type-1)
611 (types type-2)))
612 TMs|HMs
613 (map
614 (comp
615 (partial map first)
616 (partial remove (comp zero? second)))
617 (split-at
618 50
619 (map vector
620 (rest(range))
621 (reduce concat
622 (map
623 #(take 8
624 (concat (bit-list %)
625 (repeat 0)))
627 TMs|HMs)))))
629 TMs (vec (first TMs|HMs))
630 HMs (take 5 (map (partial + -50) (vec (second TMs|HMs))))
633 ]
636 {:dex# n
637 :base-moves base-moves
638 :types types
639 :TMs TMs
640 :HMs HMs
641 :base-hp rating-hp
642 :base-atk rating-atk
643 :base-def rating-def
644 :base-speed rating-speed
645 :base-special rating-special
646 }))
648 (partition entry-size
649 (take (* entry-size pkmn-count)
650 (drop 0x383DE
651 rom)))))))
654 ;; ********************** MANIPULATION FNS
659 (defn submap?
660 "Compares the two maps. Returns true if map-big has the same associations as map-small, otherwise false."
661 [map-small map-big]
662 (cond (empty? map-small) true
663 (and
664 (contains? map-big (ffirst map-small))
665 (= (get map-big (ffirst map-small))
666 (second (first map-small))))
667 (recur (next map-small) map-big)
669 :else false))
672 (defn search-map [proto-map maps]
673 "Returns all the maps that make the same associations as proto-map."
674 (some (partial submap? proto-map) maps))
676 (defn filter-vals
677 "Returns a map consisting of all the pairs [key val] for
678 which (pred key) returns true."
679 [pred map]
680 (reduce (partial apply assoc) {}
681 (filter (fn [[k v]] (pred v)) map)))
684 (defn search-moves
685 "Returns a subcollection of all hardcoded moves with the
686 given attributes. Attributes consist of :name :power
687 :accuracy :pp :fx-id
688 (and also :fx-txt, but it contains the same information
689 as :fx-id)"
690 ([attribute-map]
691 (search-moves
692 com.aurellem.gb.gb-driver/original-rom attribute-map))
693 ([rom attribute-map]
694 (filter-vals (partial submap? attribute-map)
695 (hxc-move-data rom))))
701 ;; note for later: credits start at F1290
705 (comment
707 (def hxc-later
708 "Running this code produces, e.g. hardcoded names NPCs give
709 their pokemon. Will sort through it later."
710 (print (character-codes->str(take 10000
711 (drop 0x71597
712 (rom (root)))))))
714 (let [dex
715 (partition-by #(= 0x50 %)
716 (take 2540
717 (drop 0x40687
718 (rom (root)))))]
719 (def dex dex)
720 (def hxc-species
721 (map character-codes->str
722 (take-nth 4 dex))))
723 )