Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/hxc.clj @ 302:0b3e89103dc2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
going to test bootstrapping program.
author Robert McIntyre <rlm@mit.edu>
date Sat, 31 Mar 2012 00:05:39 -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