vba-clojure: clojure/com/aurellem/gb/hxc.clj annotate

annotate clojure/com/aurellem/gb/hxc.clj @ 281:ca1afcef3542

Replaced manually listed move data in gb.moves with a call to hxc-move-data. Also, began work on hxc-shops, which lists shop inventory. todo: find out how the game converts internal order to pokedex order; todo: get hardcoded tm data.

author	Dylan Holmes <ocsenave@gmail.com>
date	Tue, 27 Mar 2012 22:41:24 -0500
parents	69184558fcf3
children	0c3fbb313e49

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

Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/hxc.clj @ 281:ca1afcef3542