view clojure/com/aurellem/gb/hxc.clj @ 269:d68a191997ca

script: made it to oak's lab from viridian mart.
author Robert McIntyre <rlm@mit.edu>
date Mon, 26 Mar 2012 23:34:53 -0500
parents 82ee2704c973
children a60ea8632ff4
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
31 :fighting
32 :flying
33 :poison
34 :ground
35 :rock
36 :bird
37 :bug
38 :ghost
39 :A
40 :B
41 :C
42 :D
43 :E
44 :F
45 :G
46 :H
47 :I
48 :J
49 :K
50 :fire
51 :water
52 :grass
53 :electric
54 :psychic
55 :ice
56 :dragon
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, pokemon are in internal order.
207 ;; In yellow, pokemon are in pokedex order.
209 (defn hxc-pokedex-stats
210 ;; uses hxc-pokedex-text to count pokemon
211 ;; since hxc-pokenames includes several missingno"
212 ([] (hxc-pokedex-stats com.aurellem.gb.gb-driver/original-rom))
213 ([rom]
214 (let [poketext (hxc-pokedex-text)
215 pkmn-count (count poketext)
216 ]
217 ((fn capture-stats
218 [n stats data]
219 (if (zero? n) stats
220 (let [[species
221 [_
222 height-ft
223 height-in
224 weight-1
225 weight-2
226 _
227 dex-ptr-1
228 dex-ptr-2
229 dex-bank
230 _
231 & data]]
232 (split-with (partial not= 0x50) data)]
233 (recur (dec n)
234 (assoc stats
235 (- pkmn-count n)
236 {:species
237 (character-codes->str species)
238 :height-ft
239 height-ft
240 :height-in
241 height-in
242 :weight
243 (/ (low-high weight-1 weight-2) 10.)
245 ;; :text
246 ;; (character-codes->str
247 ;; (take-while
248 ;; (partial not= 0x50)
249 ;; (drop
250 ;; (+ 0xB8000
251 ;; -0x4000
252 ;; (low-high dex-ptr-1 dex-ptr-2))
253 ;; rom)))
254 })
256 data)
259 )))
261 pkmn-count
262 {}
263 (drop 0x40687 rom))) ))
271 (def hxc-places
272 "The hardcoded place names in memory. List begins at
273 ROM@71500. [Cinnabar] Mansion seems to be dynamically calculated."
274 (hxc-thunk-words 0x71500 560))
277 (defn hxc-dialog
278 "The hardcoded dialogue in memory, including in-game alerts. Dialog
279 seems to be separated by 0x57 instead of 0x50 (END). Begins at ROM@98000."
280 ([rom]
281 (map character-codes->str
282 (take-nth 2
283 (partition-by #(= % 0x57)
284 (take 0x0F728
285 (drop 0x98000 rom))))))
286 ([]
287 (hxc-dialog com.aurellem.gb.gb-driver/original-rom)))
292 (def hxc-move-names
293 "The hardcoded move names in memory. List begins at ROM@BC000"
294 (hxc-thunk-words 0xBC000 1551))
297 (defn hxc-move-data
298 "The hardcoded (basic (move effects)) in memory. List begins at
299 0x38000. Returns a map of {:name :power :accuracy :pp :fx-id
300 :fx-txt}. The move descriptions are handwritten, not hardcoded."
301 ([]
302 (hxc-move-data com.aurellem.gb.gb-driver/original-rom))
303 ([rom]
304 (let [names (vec (hxc-move-names rom))
305 move-count (count names)
306 move-size 6]
307 (zipmap (map format-name names)
308 (map
309 (fn [[idx effect power type accuracy pp]]
310 {:name (names (dec idx))
311 :power power
312 :accuracy accuracy
313 :pp pp
314 :fx-id effect
315 :fx-txt (get move-effects effect)
316 }
317 )
319 (partition move-size
320 (take (* move-size move-count)
321 (drop 0x38000 rom))))))))
325 (defn hxc-move-data*
326 "Like hxc-move-data, but reports numbers as hexadecimal symbols instead."
327 ([]
328 (hxc-move-data* com.aurellem.gb.gb-driver/original-rom))
329 ([rom]
330 (let [names (vec (hxc-move-names rom))
331 move-count (count names)
332 move-size 6
333 format-name (fn [s]
334 (keyword (.toLowerCase
335 (apply str
336 (map #(if (= % \space) "-" %) s)))))
337 ]
338 (zipmap (map format-name names)
339 (map
340 (fn [[idx effect power type accuracy pp]]
341 {:name (names (dec idx))
342 :power power
343 :accuracy (hex accuracy)
344 :pp pp
345 :fx-id (hex effect)
346 :fx-txt (get move-effects effect)
347 }
348 )
350 (partition move-size
351 (take (* move-size move-count)
352 (drop 0x38000 rom))))))))
356 (defn hxc-pokenames
357 "The hardcoded names of the 190 species in memory. List begins at
358 ROM@E8000. Although names in memory are padded with 0x50 to be 10 characters
359 long, these names are stripped of padding."
360 ([]
361 (hxc-pokenames com.aurellem.gb.gb-driver/original-rom))
362 ([rom]
363 (let [count-species 190
364 name-length 10]
365 (map character-codes->str
366 (partition name-length
367 (map #(if (= 0x50 %) 0x00 %)
368 (take (* count-species name-length)
369 (drop 0xE8000
370 rom))))))))
375 (defn internal-id
376 ([rom]
377 (zipmap
378 (map format-name (hxc-pokenames rom))
379 (range)))
380 ([]
381 (internal-id com.aurellem.gb.gb-driver/original-rom)))
385 ;; nidoran gender change upon levelup
386 ;; (->
387 ;; @current-state
388 ;; rom
389 ;; vec
390 ;; (rewrite-memory
391 ;; (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♂))
392 ;; [1 1 15])
393 ;; (rewrite-memory
394 ;; (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♀))
395 ;; [1 1 3])
396 ;; (write-rom!)
398 ;; )
403 (defn hxc-advantage
404 "The hardcoded type advantages in memory, returned as tuples of atk-type def-type multiplier. By default (i.e. if not listed here),
405 the multiplier is 1."
406 ([] (hxc-advantage com.aurellem.gb.gb-driver/original-rom))
407 ([rom]
408 (map
409 (fn [[atk def mult]] [(get pkmn-types atk (hex atk))
410 (get pkmn-types def (hex def))
411 (/ mult 10)])
412 (partition 3
413 (take-while (partial not= 0xFF)
414 (drop 0x3E62D rom))))))
417 (defn format-evo
418 [coll]
419 (let [method (first coll)]
420 (cond (empty? coll) []
421 (= 0 method) [] ;; just in case
422 (= 1 method) ;; level-up evolution
423 (conj (format-evo (drop 3 coll))
424 {:method :level-up
425 :min-level (nth coll 1)
426 :into (dec (nth coll 2))})
428 (= 2 method) ;; item evolution
429 (conj (format-evo (drop 4 coll))
430 {:method :item
431 :item (dec (nth coll 1))
432 :min-level (nth coll 2)
433 :into (dec (nth coll 3))})
435 (= 3 method) ;; trade evolution
436 (conj (format-evo (drop 3 coll))
437 {:method :trade
438 :min-level (nth coll 1) ;; always 1 for trade.
439 :into (dec (nth coll 2))}))))
442 (defn hxc-ptrs-evolve
443 "A hardcoded collection of 190 pointers to alternating evolution/learnset data,
444 in internal order."
445 ([]
446 (hxc-ptrs-evolve com.aurellem.gb.gb-driver/original-rom))
447 ([rom]
448 (let [names (hxc-pokenames rom)
449 pkmn-count (count names)
450 ptrs
451 (map (fn [[a b]] (low-high a b))
452 (partition 2
453 (take (* 2 pkmn-count)
454 (drop 0x3b1e5 rom))))]
455 (map (partial + 0x34000) ptrs)
457 )))
460 (defn hxc-learnsets
461 "Hardcoded map associating pokemon names to lists of pairs [lvl
462 move] of abilities they learn as they level up. The data
463 exists at ROM@3400, sorted by internal order. Pointers to the data
464 exist at ROM@3B1E5; see also, hxc-ptrs-evolve"
465 ([] (hxc-learnsets com.aurellem.gb.gb-driver/original-rom))
466 ([rom]
467 (apply assoc
468 {}
469 (interleave
470 (map format-name (hxc-pokenames rom))
471 (map (comp
472 (partial map
473 (fn [[lvl mv]] [lvl (dec mv)]))
474 (partial partition 2)
475 ;; keep the learnset data
476 (partial take-while (comp not zero?))
477 ;; skip the evolution data
478 rest
479 (partial drop-while (comp not zero?)))
480 (map #(drop % rom)
481 (hxc-ptrs-evolve rom)))))))
483 (defn hxc-learnsets-pretty
484 "Live hxc-learnsets except it reports the name of each move --- as
485 it appears in rom --- rather than the move index."
486 ([] (hxc-learnsets-pretty com.aurellem.gb.gb-driver/original-rom))
487 ([rom]
488 (let [moves (vec(map format-name (hxc-move-names)))]
489 (into {}
490 (map (fn [[pkmn learnset]]
491 [pkmn (map (fn [[lvl mv]] [lvl (moves mv)])
492 learnset)])
493 (hxc-learnsets rom))))))
498 (defn hxc-evolution
499 "Hardcoded evolution data in memory. The data exists at ROM@34000,
500 sorted by internal order. Pointers to the data exist at ROM@3B1E5; see also, hxc-ptrs-evolve."
501 ([] (hxc-evolution com.aurellem.gb.gb-driver/original-rom))
502 ([rom]
503 (apply assoc {}
504 (interleave
505 (map format-name (hxc-pokenames rom))
506 (map
507 (comp
508 format-evo
509 (partial take-while (comp not zero?))
510 #(drop % rom))
511 (hxc-ptrs-evolve rom)
512 )))))
514 (defn hxc-evolution-pretty
515 "Like hxc-evolution, except it uses the names of items and pokemon
516 --- grabbed from ROM --- rather than their numerical identifiers."
517 ([] (hxc-evolution-pretty com.aurellem.gb.gb-driver/original-rom))
518 ([rom]
519 (let
520 [poke-names (vec (map format-name (hxc-pokenames rom)))
521 item-names (vec (map format-name (hxc-items rom)))
522 use-names
523 (fn [m]
524 (loop [ks (keys m) new-map m]
525 (let [k (first ks)]
526 (cond (nil? ks) new-map
527 (= k :into)
528 (recur
529 (next ks)
530 (assoc new-map
531 :into
532 (poke-names
533 (:into
534 new-map))))
535 (= k :item)
536 (recur
537 (next ks)
538 (assoc new-map
539 :item
540 (item-names
541 (:item new-map))))
542 :else
543 (recur
544 (next ks)
545 new-map)
546 ))))]
548 (into {}
549 (map (fn [[pkmn evo-coll]]
550 [pkmn (map use-names evo-coll)])
551 (hxc-evolution rom))))))
557 ;; ********************** MANIPULATION FNS
562 (defn submap?
563 "Compares the two maps. Returns true if map-big has the same associations as map-small, otherwise false."
564 [map-small map-big]
565 (cond (empty? map-small) true
566 (and
567 (contains? map-big (ffirst map-small))
568 (= (get map-big (ffirst map-small))
569 (second (first map-small))))
570 (recur (next map-small) map-big)
572 :else false))
575 (defn search-map [proto-map maps]
576 "Returns all the maps that make the same associations as proto-map."
577 (some (partial submap? proto-map) maps))
579 (defn filter-vals
580 "Returns a map consisting of all the pairs [key val] for
581 which (pred key) returns true."
582 [pred map]
583 (reduce (partial apply assoc) {}
584 (filter (fn [[k v]] (pred v)) map)))
587 (defn search-moves
588 "Returns a subcollection of all hardcoded moves with the
589 given attributes. Attributes consist of :name :power
590 :accuracy :pp :fx-id
591 (and also :fx-txt, but it contains the same information
592 as :fx-id)"
593 ([attribute-map]
594 (search-moves
595 com.aurellem.gb.gb-driver/original-rom attribute-map))
596 ([rom attribute-map]
597 (filter-vals (partial submap? attribute-map)
598 (hxc-move-data rom))))
604 ;; note for later: credits start at F1290
608 (comment
610 (def hxc-later
611 "Running this code produces, e.g. hardcoded names NPCs give
612 their pokemon. Will sort through it later."
613 (print (character-codes->str(take 10000
614 (drop 0x71597
615 (rom (root)))))))
617 (let [dex
618 (partition-by #(= 0x50 %)
619 (take 2540
620 (drop 0x40687
621 (rom (root)))))]
622 (def dex dex)
623 (def hxc-species
624 (map character-codes->str
625 (take-nth 4 dex))))
626 )