Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/hxc.clj @ 300:bc1f62b269b5

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