Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/hxc.clj @ 580:46bbeac1b329

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
saving progress.
author Robert McIntyre <rlm@mit.edu>
date Sat, 01 Sep 2012 06:15:23 -0500
parents acc3d1ad24e8
children
rev   line source
ocsenave@347 1
rlm@218 2 (ns com.aurellem.gb.hxc
ocsenave@308 3 (:use (com.aurellem.gb assembly characters gb-driver util mem-util
ocsenave@281 4 constants species))
rlm@218 5 (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@218 6
ocsenave@249 7 ; ************* HANDWRITTEN CONSTANTS
ocsenave@249 8
ocsenave@243 9 (def pkmn-types
ocsenave@272 10 [:normal ;;0
ocsenave@272 11 :fighting ;;1
ocsenave@272 12 :flying ;;2
ocsenave@272 13 :poison ;;3
ocsenave@272 14 :ground ;;4
ocsenave@272 15 :rock ;;5
ocsenave@272 16 :bird ;;6
ocsenave@272 17 :bug ;;7
ocsenave@272 18 :ghost ;;8
ocsenave@244 19 :A
ocsenave@244 20 :B
ocsenave@244 21 :C
ocsenave@244 22 :D
ocsenave@244 23 :E
ocsenave@244 24 :F
ocsenave@244 25 :G
ocsenave@244 26 :H
ocsenave@244 27 :I
ocsenave@244 28 :J
ocsenave@244 29 :K
ocsenave@272 30 :fire ;;20 (0x14)
ocsenave@272 31 :water ;;21 (0x15)
ocsenave@272 32 :grass ;;22 (0x16)
ocsenave@272 33 :electric ;;23 (0x17)
ocsenave@272 34 :psychic ;;24 (0x18)
ocsenave@272 35 :ice ;;25 (0x19)
ocsenave@272 36 :dragon ;;26 (0x1A)
ocsenave@244 37 ])
ocsenave@243 38
ocsenave@243 39
ocsenave@246 40 ;; question: when status effects claim to take
ocsenave@246 41 ;; their accuracy from the move accuracy, does
ocsenave@246 42 ;; this mean that the move always "hits" but the
ocsenave@246 43 ;; status effect may not?
ocsenave@246 44
ocsenave@246 45 (def move-effects
ocsenave@246 46 ["normal damage"
ocsenave@246 47 "no damage, just opponent sleep" ;; how many turns? is atk power ignored?
ocsenave@246 48 "0x4C chance of poison"
ocsenave@246 49 "leech half of inflicted damage"
ocsenave@246 50 "0x19 chance of burn"
ocsenave@246 51 "0x19 chance of freeze"
ocsenave@246 52 "0x19 chance of paralyze"
ocsenave@259 53 "user faints; opponent defense halved during attack."
ocsenave@246 54 "leech half of inflicted damage ONLY if sleeping opponent."
ocsenave@246 55 "imitate last attack"
ocsenave@246 56 "user atk +1"
ocsenave@246 57 "user def +1"
ocsenave@246 58 "user spd +1"
ocsenave@246 59 "user spc +1"
ocsenave@246 60 "user acr +1" ;; unused?!
ocsenave@246 61 "user evd +1"
ocsenave@246 62 "get post-battle $ = 2*level*uses"
ocsenave@246 63 "0xFE acr, no matter what."
ocsenave@246 64 "opponent atk -1" ;; acr taken from move acr?
ocsenave@246 65 "opponent def -1" ;;
ocsenave@246 66 "opponent spd -1" ;;
ocsenave@246 67 "opponent spc -1" ;;
ocsenave@246 68 "opponent acr -1";;
ocsenave@246 69 "opponent evd -1"
ocsenave@246 70 "converts user's type to opponent's."
ocsenave@246 71 "(haze)"
ocsenave@246 72 "(bide)"
ocsenave@246 73 "(thrash)"
ocsenave@246 74 "(teleport)"
ocsenave@246 75 "(fury swipes)"
ocsenave@246 76 "attacks 2-5 turns" ;; unused? like rollout?
ocsenave@246 77 "0x19 chance of flinch"
ocsenave@246 78 "opponent sleep for 1-7 turns"
ocsenave@246 79 "0x66 chance of poison"
ocsenave@246 80 "0x4D chance of burn"
ocsenave@246 81 "0x4D chance of freeze"
ocsenave@246 82 "0x4D chance of paralyze"
ocsenave@246 83 "0x4D chance of flinch"
ocsenave@246 84 "one-hit KO"
ocsenave@246 85 "charge one turn, atk next."
ocsenave@246 86 "fixed damage, leaves 1HP." ;; how is dmg determined?
ocsenave@246 87 "fixed damage." ;; cf seismic toss, dragon rage, psywave.
ocsenave@246 88 "atk 2-5 turns; opponent can't attack" ;; unnormalized? (0 0x60 0x60 0x20 0x20)
ocsenave@246 89 "charge one turn, atk next. (can't be hit when charging)"
ocsenave@246 90 "atk hits twice."
ocsenave@246 91 "user takes 1 damage if misses."
ocsenave@246 92 "evade status-lowering effects" ;;caused by you or also your opponent?
ocsenave@246 93 "(broken) if user is slower than opponent, makes critical hit impossible, otherwise has no effect"
ocsenave@246 94 "atk causes recoil dmg = 1/4 dmg dealt"
ocsenave@246 95 "confuses opponent" ;; acr taken from move acr
ocsenave@246 96 "user atk +2"
ocsenave@246 97 "user def +2"
ocsenave@246 98 "user spd +2"
ocsenave@246 99 "user spc +2"
ocsenave@246 100 "user acr +2" ;; unused!
ocsenave@246 101 "user evd +2" ;; unused!
ocsenave@246 102 "restores up to half of user's max hp." ;; broken: fails if the difference
ocsenave@246 103 ;; b/w max and current hp is one less than a multiple of 256.
ocsenave@246 104 "(transform)"
ocsenave@246 105 "opponent atk -2"
ocsenave@246 106 "opponent def -2"
ocsenave@246 107 "opponent spd -2"
ocsenave@246 108 "opponent spc -2"
ocsenave@246 109 "opponent acr -2"
ocsenave@246 110 "opponent evd -2"
ocsenave@246 111 "doubles user spc when attacked"
ocsenave@246 112 "doubles user def when attacked"
ocsenave@249 113 "just poisons opponent" ;;acr taken from move acr
ocsenave@249 114 "just paralyzes opponent" ;;
ocsenave@246 115 "0x19 chance opponent atk -1"
ocsenave@246 116 "0x19 chance opponent def -1"
ocsenave@246 117 "0x19 chance opponent spd -1"
ocsenave@246 118 "0x4C chance opponent spc -1" ;; context suggest chance is 0x19
ocsenave@246 119 "0x19 chance opponent acr -1"
ocsenave@246 120 "0x19 chance opponent evd -1"
ocsenave@246 121 "???" ;; unused? no effect?
ocsenave@246 122 "???" ;; unused? no effect?
ocsenave@246 123 "0x19 chance opponent confused"
ocsenave@246 124 "atk hits twice. 0x33 chance opponent poisioned."
ocsenave@246 125 "broken. crash the game after attack."
ocsenave@246 126 "(substitute)"
ocsenave@246 127 "unless opponent faints, user must recharge after atk. some
ocsenave@246 128 exceptions apply."
ocsenave@246 129 "(rage)"
ocsenave@246 130 "(mimic)"
ocsenave@246 131 "(metronome)"
ocsenave@246 132 "(leech seed)"
ocsenave@246 133 "does nothing (splash)"
ocsenave@246 134 "(disable)"
ocsenave@246 135 ])
ocsenave@246 136
ocsenave@249 137 ;; ************** HARDCODED DATA
ocsenave@246 138
ocsenave@249 139 (defn hxc-thunk
ocsenave@259 140 "Creates a thunk (nullary fn) that grabs data in a certain region of rom and
ocsenave@249 141 splits it into a collection by 0x50. If rom is not supplied, uses the
ocsenave@249 142 original rom data."
ocsenave@249 143 [start length]
ocsenave@249 144 (fn self
ocsenave@249 145 ([rom]
ocsenave@249 146 (take-nth 2
ocsenave@249 147 (partition-by #(= % 0x50)
ocsenave@249 148 (take length
ocsenave@249 149 (drop start rom)))))
ocsenave@249 150 ([]
ocsenave@249 151 (self com.aurellem.gb.gb-driver/original-rom))))
ocsenave@246 152
ocsenave@249 153 (def hxc-thunk-words
ocsenave@249 154 "Same as hxc-thunk, except it interprets the rom data as characters,
ocsenave@249 155 returning a collection of strings."
ocsenave@249 156 (comp
ocsenave@249 157 (partial comp (partial map character-codes->str))
ocsenave@249 158 hxc-thunk))
ocsenave@249 159
ocsenave@249 160 ;; --------------------------------------------------
ocsenave@246 161
ocsenave@288 162
ocsenave@288 163 (defn hxc-pokenames-raw
ocsenave@288 164 "The hardcoded names of the 190 species in memory. List begins at
ocsenave@288 165 ROM@E8000. Although names in memory are padded with 0x50 to be 10 characters
ocsenave@288 166 long, these names are stripped of padding. See also, hxc-pokedex-names"
ocsenave@288 167 ([]
ocsenave@288 168 (hxc-pokenames-raw com.aurellem.gb.gb-driver/original-rom))
ocsenave@288 169 ([rom]
ocsenave@288 170 (let [count-species 190
ocsenave@288 171 name-length 10]
ocsenave@288 172 (map character-codes->str
ocsenave@288 173 (partition name-length
ocsenave@288 174 (map #(if (= 0x50 %) 0x00 %)
ocsenave@288 175 (take (* count-species name-length)
ocsenave@288 176 (drop 0xE8000
ocsenave@288 177 rom))))))))
ocsenave@288 178 (def hxc-pokenames
ocsenave@288 179 (comp
ocsenave@288 180 (partial map format-name)
ocsenave@288 181 hxc-pokenames-raw))
ocsenave@288 182
ocsenave@288 183
ocsenave@288 184
ocsenave@288 185
ocsenave@288 186 (defn hxc-pokedex-names
ocsenave@420 187 "The names of the pokemon in hardcoded pokedex order. List of the
ocsenave@420 188 pokedex numbers of each pokemon (in internal order) begins at
ocsenave@288 189 ROM@410B1. See also, hxc-pokenames."
ocsenave@288 190 ([] (hxc-pokedex-names
ocsenave@288 191 com.aurellem.gb.gb-driver/original-rom))
ocsenave@288 192 ([rom]
ocsenave@288 193 (let [names (hxc-pokenames rom)]
ocsenave@288 194 (#(mapv %
ocsenave@288 195 ((comp range count keys) %))
ocsenave@288 196 (zipmap
ocsenave@288 197 (take (count names)
ocsenave@288 198 (drop 0x410b1 rom))
ocsenave@288 199
ocsenave@288 200 names)))))
ocsenave@288 201
ocsenave@348 202 (def hxc-types
ocsenave@348 203 "The hardcoded type names in memory. List begins at ROM@27D99,
ocsenave@348 204 shortly before hxc-titles."
ocsenave@348 205 (hxc-thunk-words 0x27D99 102))
ocsenave@288 206
ocsenave@288 207
ocsenave@306 208 ;; http://hax.iimarck.us/topic/581/
ocsenave@307 209 (defn hxc-cry
ocsenave@307 210 "The pokemon cry data in internal order. List begins at ROM@39462"
ocsenave@308 211 ([](hxc-cry com.aurellem.gb.gb-driver/original-rom))
ocsenave@307 212 ([rom]
ocsenave@307 213 (zipmap
ocsenave@307 214 (hxc-pokenames rom)
ocsenave@307 215 (map
ocsenave@307 216 (fn [[cry-id pitch length]]
ocsenave@307 217 {:cry-id cry-id
ocsenave@307 218 :pitch pitch
ocsenave@307 219 :length length}
ocsenave@307 220 )
ocsenave@307 221 (partition 3
ocsenave@308 222 (drop 0x39462 rom))))))
ocsenave@306 223
ocsenave@307 224 (defn hxc-cry-groups
ocsenave@308 225 ([] (hxc-cry-groups com.aurellem.gb.gb-driver/original-rom))
ocsenave@307 226 ([rom]
ocsenave@307 227 (map #(mapv first
ocsenave@307 228 (filter
ocsenave@307 229 (fn [[k v]]
ocsenave@307 230 (= % (:cry-id v)))
ocsenave@308 231 (hxc-cry)))
ocsenave@307 232 ((comp
ocsenave@307 233 range
ocsenave@307 234 count
ocsenave@307 235 set
ocsenave@307 236 (partial map :cry-id)
ocsenave@307 237 vals
ocsenave@307 238 hxc-cry)
ocsenave@307 239 rom))))
ocsenave@306 240
ocsenave@288 241
ocsenave@307 242 (defn cry-conversion!
ocsenave@307 243 "Convert Porygon's cry in ROM to be the cry of the given pokemon."
ocsenave@307 244 [pkmn]
ocsenave@307 245 (write-rom!
ocsenave@307 246 (rewrite-memory
ocsenave@307 247 (vec(rom))
ocsenave@307 248 0x3965D
ocsenave@307 249 (map second
ocsenave@307 250 ((hxc-cry) pkmn)))))
ocsenave@307 251
ocsenave@348 252
ocsenave@348 253
ocsenave@348 254
ocsenave@288 255 (def hxc-items-raw
ocsenave@249 256 "The hardcoded names of the items in memory. List begins at
ocsenave@249 257 ROM@045B7"
ocsenave@249 258 (hxc-thunk-words 0x45B7 870))
ocsenave@246 259
ocsenave@348 260 (def hxc-items
ocsenave@348 261 "The hardcoded names of the items in memory, presented as
ocsenave@348 262 keywords. List begins at ROM@045B7. See also, hxc-items-raw."
ocsenave@348 263 (comp (partial map format-name) hxc-items-raw))
ocsenave@348 264
ocsenave@348 265
ocsenave@246 266
ocsenave@246 267 (def hxc-titles
ocsenave@246 268 "The hardcoded names of the trainer titles in memory. List begins at
ocsenave@246 269 ROM@27E77"
ocsenave@249 270 (hxc-thunk-words 0x27E77 196))
ocsenave@246 271
ocsenave@259 272
ocsenave@288 273 (def hxc-pokedex-text-raw
ocsenave@259 274 "The hardcoded pokedex entries in memory. List begins at
ocsenave@259 275 ROM@B8000, shortly before move names."
ocsenave@259 276 (hxc-thunk-words 0xB8000 14754))
ocsenave@259 277
ocsenave@288 278
ocsenave@288 279
ocsenave@288 280
ocsenave@285 281 (defn hxc-pokedex-text
ocsenave@285 282 "The hardcoded pokedex entries in memory, presented as an
ocsenave@285 283 associative hash map. List begins at ROM@B8000."
ocsenave@285 284 ([] (hxc-pokedex-text com.aurellem.gb.gb-driver/original-rom))
ocsenave@285 285 ([rom]
ocsenave@285 286 (zipmap
ocsenave@285 287 (hxc-pokedex-names rom)
ocsenave@285 288 (cons nil ;; for missingno.
ocsenave@288 289 (hxc-pokedex-text-raw rom)))))
ocsenave@259 290
ocsenave@272 291 ;; In red/blue, pokedex stats are in internal order.
ocsenave@272 292 ;; In yellow, pokedex stats are in pokedex order.
ocsenave@259 293 (defn hxc-pokedex-stats
ocsenave@272 294 "The hardcoded pokedex stats (species height weight) in memory. List
ocsenave@272 295 begins at ROM@40687"
ocsenave@259 296 ([] (hxc-pokedex-stats com.aurellem.gb.gb-driver/original-rom))
ocsenave@259 297 ([rom]
ocsenave@288 298 (let [pokedex-names (zipmap (range) (hxc-pokedex-names rom))
ocsenave@288 299 pkmn-count (count pokedex-names)
ocsenave@259 300 ]
ocsenave@259 301 ((fn capture-stats
ocsenave@259 302 [n stats data]
ocsenave@259 303 (if (zero? n) stats
ocsenave@259 304 (let [[species
ocsenave@259 305 [_
ocsenave@259 306 height-ft
ocsenave@259 307 height-in
ocsenave@259 308 weight-1
ocsenave@259 309 weight-2
ocsenave@259 310 _
ocsenave@259 311 dex-ptr-1
ocsenave@259 312 dex-ptr-2
ocsenave@259 313 dex-bank
ocsenave@259 314 _
ocsenave@259 315 & data]]
ocsenave@259 316 (split-with (partial not= 0x50) data)]
ocsenave@259 317 (recur (dec n)
ocsenave@259 318 (assoc stats
ocsenave@285 319 (pokedex-names (- pkmn-count (dec n)))
ocsenave@259 320 {:species
ocsenave@285 321 (format-name (character-codes->str species))
ocsenave@259 322 :height-ft
ocsenave@259 323 height-ft
ocsenave@259 324 :height-in
ocsenave@259 325 height-in
ocsenave@259 326 :weight
ocsenave@259 327 (/ (low-high weight-1 weight-2) 10.)
ocsenave@259 328
ocsenave@259 329 ;; :text
ocsenave@259 330 ;; (character-codes->str
ocsenave@259 331 ;; (take-while
ocsenave@259 332 ;; (partial not= 0x50)
ocsenave@259 333 ;; (drop
ocsenave@259 334 ;; (+ 0xB8000
ocsenave@259 335 ;; -0x4000
ocsenave@259 336 ;; (low-high dex-ptr-1 dex-ptr-2))
ocsenave@259 337 ;; rom)))
ocsenave@259 338 })
ocsenave@259 339
ocsenave@259 340 data)
ocsenave@259 341
ocsenave@259 342
ocsenave@259 343 )))
ocsenave@259 344
ocsenave@259 345 pkmn-count
ocsenave@259 346 {}
ocsenave@259 347 (drop 0x40687 rom))) ))
ocsenave@259 348
ocsenave@259 349
ocsenave@259 350
ocsenave@259 351
ocsenave@246 352 (def hxc-places
ocsenave@246 353 "The hardcoded place names in memory. List begins at
ocsenave@420 354 ROM@71500. [Cinnabar/Celadon] Mansion seems to be dynamically calculated."
ocsenave@249 355 (hxc-thunk-words 0x71500 560))
ocsenave@246 356
ocsenave@249 357 (defn hxc-dialog
ocsenave@249 358 "The hardcoded dialogue in memory, including in-game alerts. Dialog
ocsenave@249 359 seems to be separated by 0x57 instead of 0x50 (END). Begins at ROM@98000."
ocsenave@249 360 ([rom]
ocsenave@249 361 (map character-codes->str
ocsenave@249 362 (take-nth 2
ocsenave@249 363 (partition-by #(= % 0x57)
ocsenave@249 364 (take 0x0F728
ocsenave@249 365 (drop 0x98000 rom))))))
ocsenave@249 366 ([]
ocsenave@249 367 (hxc-dialog com.aurellem.gb.gb-driver/original-rom)))
ocsenave@249 368
ocsenave@246 369
ocsenave@246 370 (def hxc-move-names
ocsenave@246 371 "The hardcoded move names in memory. List begins at ROM@BC000"
ocsenave@249 372 (hxc-thunk-words 0xBC000 1551))
ocsenave@249 373 (defn hxc-move-data
ocsenave@246 374 "The hardcoded (basic (move effects)) in memory. List begins at
ocsenave@249 375 0x38000. Returns a map of {:name :power :accuracy :pp :fx-id
ocsenave@249 376 :fx-txt}. The move descriptions are handwritten, not hardcoded."
ocsenave@249 377 ([]
ocsenave@249 378 (hxc-move-data com.aurellem.gb.gb-driver/original-rom))
ocsenave@249 379 ([rom]
ocsenave@249 380 (let [names (vec (hxc-move-names rom))
ocsenave@249 381 move-count (count names)
ocsenave@281 382 move-size 6
ocsenave@281 383 types pkmn-types ;;; !! hardcoded types
ocsenave@281 384 ]
ocsenave@249 385 (zipmap (map format-name names)
ocsenave@249 386 (map
ocsenave@281 387 (fn [[idx effect power type-id accuracy pp]]
ocsenave@249 388 {:name (names (dec idx))
ocsenave@249 389 :power power
ocsenave@249 390 :accuracy accuracy
ocsenave@249 391 :pp pp
ocsenave@281 392 :type (types type-id)
ocsenave@249 393 :fx-id effect
ocsenave@249 394 :fx-txt (get move-effects effect)
ocsenave@249 395 }
ocsenave@249 396 )
ocsenave@249 397
ocsenave@249 398 (partition move-size
ocsenave@249 399 (take (* move-size move-count)
ocsenave@249 400 (drop 0x38000 rom))))))))
ocsenave@246 401
ocsenave@246 402
ocsenave@246 403
ocsenave@249 404 (defn hxc-move-data*
ocsenave@249 405 "Like hxc-move-data, but reports numbers as hexadecimal symbols instead."
ocsenave@249 406 ([]
ocsenave@249 407 (hxc-move-data* com.aurellem.gb.gb-driver/original-rom))
ocsenave@249 408 ([rom]
ocsenave@249 409 (let [names (vec (hxc-move-names rom))
ocsenave@249 410 move-count (count names)
ocsenave@249 411 move-size 6
ocsenave@249 412 format-name (fn [s]
ocsenave@249 413 (keyword (.toLowerCase
ocsenave@249 414 (apply str
ocsenave@249 415 (map #(if (= % \space) "-" %) s)))))
ocsenave@249 416 ]
ocsenave@249 417 (zipmap (map format-name names)
ocsenave@249 418 (map
ocsenave@249 419 (fn [[idx effect power type accuracy pp]]
ocsenave@249 420 {:name (names (dec idx))
ocsenave@249 421 :power power
ocsenave@249 422 :accuracy (hex accuracy)
ocsenave@249 423 :pp pp
ocsenave@249 424 :fx-id (hex effect)
ocsenave@249 425 :fx-txt (get move-effects effect)
ocsenave@249 426 }
ocsenave@249 427 )
ocsenave@249 428
ocsenave@249 429 (partition move-size
ocsenave@249 430 (take (* move-size move-count)
ocsenave@249 431 (drop 0x38000 rom))))))))
ocsenave@243 432
ocsenave@243 433
ocsenave@283 434 (defn hxc-machines
ocsenave@312 435 "The hardcoded moves taught by TMs and HMs. List begins at ROM@1232D."
ocsenave@283 436 ([] (hxc-machines
ocsenave@283 437 com.aurellem.gb.gb-driver/original-rom))
ocsenave@283 438 ([rom]
ocsenave@283 439 (let [moves (hxc-move-names rom)]
ocsenave@283 440 (zipmap
ocsenave@283 441 (range)
ocsenave@283 442 (take-while
ocsenave@283 443 (comp not nil?)
ocsenave@283 444 (map (comp
ocsenave@283 445 format-name
ocsenave@283 446 (zipmap
ocsenave@283 447 (range)
ocsenave@283 448 moves)
ocsenave@283 449 dec)
ocsenave@283 450 (take 100
ocsenave@283 451 (drop 0x1232D rom))))))))
ocsenave@285 452
ocsenave@285 453
ocsenave@259 454
ocsenave@348 455
ocsenave@259 456 (defn internal-id
ocsenave@259 457 ([rom]
ocsenave@259 458 (zipmap
ocsenave@288 459 (hxc-pokenames rom)
ocsenave@259 460 (range)))
ocsenave@259 461 ([]
ocsenave@259 462 (internal-id com.aurellem.gb.gb-driver/original-rom)))
ocsenave@285 463
ocsenave@285 464
ocsenave@285 465
ocsenave@259 466
ocsenave@259 467
ocsenave@263 468 ;; nidoran gender change upon levelup
ocsenave@263 469 ;; (->
ocsenave@263 470 ;; @current-state
ocsenave@263 471 ;; rom
ocsenave@263 472 ;; vec
ocsenave@263 473 ;; (rewrite-memory
ocsenave@263 474 ;; (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♂))
ocsenave@263 475 ;; [1 1 15])
ocsenave@263 476 ;; (rewrite-memory
ocsenave@263 477 ;; (nth (hxc-ptrs-evolve) ((internal-id) :nidoran♀))
ocsenave@263 478 ;; [1 1 3])
ocsenave@263 479 ;; (write-rom!)
ocsenave@263 480
ocsenave@263 481 ;; )
ocsenave@263 482
ocsenave@259 483
ocsenave@259 484
ocsenave@370 485 (defn hxc-advantage
ocsenave@370 486 ;; in-game multipliers are stored as 10x their effective value
ocsenave@370 487 ;; to allow for fractional multipliers like 1/2
ocsenave@370 488
ocsenave@370 489 "The hardcoded type advantages in memory, returned as tuples of
ocsenave@370 490 atk-type def-type multiplier. By default (i.e. if not listed here),
ocsenave@370 491 the multiplier is 1. List begins at 0x3E62D."
ocsenave@370 492 ([] (hxc-advantage com.aurellem.gb.gb-driver/original-rom))
ocsenave@370 493 ([rom]
ocsenave@370 494 (map
ocsenave@370 495 (fn [[atk def mult]] [(get pkmn-types atk (hex atk))
ocsenave@370 496 (get pkmn-types def (hex def))
ocsenave@370 497 (/ mult 10)])
ocsenave@370 498 (partition 3
ocsenave@370 499 (take-while (partial not= 0xFF)
ocsenave@370 500 (drop 0x3E62D rom))))))
ocsenave@243 501
ocsenave@243 502
ocsenave@281 503
ocsenave@263 504 (defn format-evo
ocsenave@347 505 "Parse a sequence of evolution data, returning a map. First is the
ocsenave@347 506 method: 0 = end-evolution-data. 1 = level-up, 2 = item, 3 = trade. Next is an item id, if the
ocsenave@347 507 method of evolution is by item (only stones will actually make pokemon
ocsenave@347 508 evolve, for some auxillary reason.) Finally, the minimum level for
ocsenave@347 509 evolution to occur (level 1 means no limit, which is used for trade
ocsenave@347 510 and item evolutions), followed by the internal id of the pokemon
ocsenave@347 511 into which to evolve. Hence, level up and trade evolutions are
ocsenave@347 512 described with 3
ocsenave@347 513 bytes; item evolutions with four."
ocsenave@263 514 [coll]
ocsenave@263 515 (let [method (first coll)]
ocsenave@263 516 (cond (empty? coll) []
ocsenave@263 517 (= 0 method) [] ;; just in case
ocsenave@263 518 (= 1 method) ;; level-up evolution
ocsenave@263 519 (conj (format-evo (drop 3 coll))
ocsenave@263 520 {:method :level-up
ocsenave@263 521 :min-level (nth coll 1)
ocsenave@263 522 :into (dec (nth coll 2))})
ocsenave@263 523
ocsenave@263 524 (= 2 method) ;; item evolution
ocsenave@263 525 (conj (format-evo (drop 4 coll))
ocsenave@263 526 {:method :item
ocsenave@263 527 :item (dec (nth coll 1))
ocsenave@263 528 :min-level (nth coll 2)
ocsenave@263 529 :into (dec (nth coll 3))})
ocsenave@243 530
ocsenave@263 531 (= 3 method) ;; trade evolution
ocsenave@263 532 (conj (format-evo (drop 3 coll))
ocsenave@263 533 {:method :trade
ocsenave@263 534 :min-level (nth coll 1) ;; always 1 for trade.
ocsenave@263 535 :into (dec (nth coll 2))}))))
ocsenave@243 536
ocsenave@243 537
ocsenave@263 538 (defn hxc-ptrs-evolve
ocsenave@267 539 "A hardcoded collection of 190 pointers to alternating evolution/learnset data,
ocsenave@263 540 in internal order."
ocsenave@263 541 ([]
ocsenave@263 542 (hxc-ptrs-evolve com.aurellem.gb.gb-driver/original-rom))
ocsenave@259 543 ([rom]
ocsenave@288 544 (let [
ocsenave@288 545 pkmn-count (count (hxc-pokenames-raw)) ;; 190
ocsenave@259 546 ptrs
ocsenave@263 547 (map (fn [[a b]] (low-high a b))
ocsenave@259 548 (partition 2
ocsenave@259 549 (take (* 2 pkmn-count)
ocsenave@263 550 (drop 0x3b1e5 rom))))]
ocsenave@263 551 (map (partial + 0x34000) ptrs)
ocsenave@263 552
ocsenave@263 553 )))
ocsenave@263 554
ocsenave@370 555 (defn hxc-evolution
ocsenave@370 556 "Hardcoded evolution data in memory. The data exists at ROM@34000,
ocsenave@370 557 sorted by internal order. Pointers to the data exist at ROM@3B1E5; see also, hxc-ptrs-evolve."
ocsenave@370 558 ([] (hxc-evolution com.aurellem.gb.gb-driver/original-rom))
ocsenave@370 559 ([rom]
ocsenave@370 560 (apply assoc {}
ocsenave@370 561 (interleave
ocsenave@370 562 (hxc-pokenames rom)
ocsenave@370 563 (map
ocsenave@370 564 (comp
ocsenave@370 565 format-evo
ocsenave@370 566 (partial take-while (comp not zero?))
ocsenave@370 567 #(drop % rom))
ocsenave@370 568 (hxc-ptrs-evolve rom)
ocsenave@370 569 )))))
ocsenave@370 570
ocsenave@370 571 (defn hxc-evolution-pretty
ocsenave@370 572 "Like hxc-evolution, except it uses the names of items and pokemon
ocsenave@370 573 --- grabbed from ROM --- rather than their numerical identifiers."
ocsenave@370 574 ([] (hxc-evolution-pretty com.aurellem.gb.gb-driver/original-rom))
ocsenave@370 575 ([rom]
ocsenave@370 576 (let
ocsenave@370 577 [poke-names (vec (hxc-pokenames rom))
ocsenave@370 578 item-names (vec (hxc-items rom))
ocsenave@370 579 use-names
ocsenave@370 580 (fn [m]
ocsenave@370 581 (loop [ks (keys m) new-map m]
ocsenave@370 582 (let [k (first ks)]
ocsenave@370 583 (cond (nil? ks) new-map
ocsenave@370 584 (= k :into)
ocsenave@370 585 (recur
ocsenave@370 586 (next ks)
ocsenave@370 587 (assoc new-map
ocsenave@370 588 :into
ocsenave@370 589 (poke-names
ocsenave@370 590 (:into
ocsenave@370 591 new-map))))
ocsenave@370 592 (= k :item)
ocsenave@370 593 (recur
ocsenave@370 594 (next ks)
ocsenave@370 595 (assoc new-map
ocsenave@370 596 :item
ocsenave@370 597 (item-names
ocsenave@370 598 (:item new-map))))
ocsenave@370 599 :else
ocsenave@370 600 (recur
ocsenave@370 601 (next ks)
ocsenave@370 602 new-map)
ocsenave@370 603 ))))]
ocsenave@370 604
ocsenave@370 605 (into {}
ocsenave@370 606 (map (fn [[pkmn evo-coll]]
ocsenave@370 607 [pkmn (map use-names evo-coll)])
ocsenave@370 608 (hxc-evolution rom))))))
ocsenave@370 609
ocsenave@370 610
ocsenave@370 611
ocsenave@267 612
ocsenave@267 613 (defn hxc-learnsets
ocsenave@267 614 "Hardcoded map associating pokemon names to lists of pairs [lvl
ocsenave@267 615 move] of abilities they learn as they level up. The data
ocsenave@347 616 exists at ROM@34000, sorted by internal order. Pointers to the data
ocsenave@267 617 exist at ROM@3B1E5; see also, hxc-ptrs-evolve"
ocsenave@267 618 ([] (hxc-learnsets com.aurellem.gb.gb-driver/original-rom))
ocsenave@267 619 ([rom]
ocsenave@267 620 (apply assoc
ocsenave@267 621 {}
ocsenave@267 622 (interleave
ocsenave@288 623 (hxc-pokenames rom)
ocsenave@267 624 (map (comp
ocsenave@268 625 (partial map
ocsenave@268 626 (fn [[lvl mv]] [lvl (dec mv)]))
ocsenave@267 627 (partial partition 2)
ocsenave@267 628 ;; keep the learnset data
ocsenave@267 629 (partial take-while (comp not zero?))
ocsenave@267 630 ;; skip the evolution data
ocsenave@267 631 rest
ocsenave@267 632 (partial drop-while (comp not zero?)))
ocsenave@267 633 (map #(drop % rom)
ocsenave@267 634 (hxc-ptrs-evolve rom)))))))
ocsenave@267 635
ocsenave@267 636 (defn hxc-learnsets-pretty
ocsenave@267 637 "Live hxc-learnsets except it reports the name of each move --- as
ocsenave@267 638 it appears in rom --- rather than the move index."
ocsenave@267 639 ([] (hxc-learnsets-pretty com.aurellem.gb.gb-driver/original-rom))
ocsenave@267 640 ([rom]
ocsenave@267 641 (let [moves (vec(map format-name (hxc-move-names)))]
ocsenave@267 642 (into {}
ocsenave@267 643 (map (fn [[pkmn learnset]]
ocsenave@268 644 [pkmn (map (fn [[lvl mv]] [lvl (moves mv)])
ocsenave@267 645 learnset)])
ocsenave@267 646 (hxc-learnsets rom))))))
ocsenave@267 647
ocsenave@267 648
ocsenave@267 649
ocsenave@273 650 (defn hxc-pokemon-base
ocsenave@273 651 ([] (hxc-pokemon-base com.aurellem.gb.gb-driver/original-rom))
ocsenave@273 652 ([rom]
ocsenave@273 653 (let [entry-size 28
ocsenave@371 654
ocsenave@285 655 pokemon (rest (hxc-pokedex-names))
ocsenave@371 656 pkmn-count (inc(count pokemon))
ocsenave@273 657 types (apply assoc {}
ocsenave@273 658 (interleave
ocsenave@273 659 (range)
ocsenave@273 660 pkmn-types)) ;;!! softcoded
ocsenave@273 661 moves (apply assoc {}
ocsenave@273 662 (interleave
ocsenave@273 663 (range)
ocsenave@273 664 (map format-name
ocsenave@273 665 (hxc-move-names rom))))
ocsenave@288 666 machines (hxc-machines)
ocsenave@273 667 ]
ocsenave@285 668 (zipmap
ocsenave@285 669 pokemon
ocsenave@285 670 (map
ocsenave@285 671 (fn [[n
ocsenave@285 672 rating-hp
ocsenave@285 673 rating-atk
ocsenave@285 674 rating-def
ocsenave@285 675 rating-speed
ocsenave@285 676 rating-special
ocsenave@285 677 type-1
ocsenave@285 678 type-2
ocsenave@285 679 rarity
ocsenave@285 680 rating-xp
ocsenave@285 681 pic-dimensions ;; tile_width|tile_height (8px/tile)
ocsenave@285 682 ptr-pic-obverse-1
ocsenave@285 683 ptr-pic-obverse-2
ocsenave@285 684 ptr-pic-reverse-1
ocsenave@285 685 ptr-pic-reverse-2
ocsenave@285 686 move-1
ocsenave@285 687 move-2
ocsenave@285 688 move-3
ocsenave@285 689 move-4
ocsenave@285 690 growth-rate
ocsenave@285 691 &
ocsenave@285 692 TMs|HMs]]
ocsenave@285 693 (let
ocsenave@285 694 [base-moves
ocsenave@285 695 (mapv moves
ocsenave@285 696 ((comp
ocsenave@285 697 ;; since the game uses zero as a delimiter,
ocsenave@285 698 ;; it must also increment all move indices by 1.
ocsenave@285 699 ;; heren we decrement to correct this.
ocsenave@285 700 (partial map dec)
ocsenave@285 701 (partial take-while (comp not zero?)))
ocsenave@285 702 [move-1 move-2 move-3 move-4]))
ocsenave@285 703
ocsenave@285 704 types
ocsenave@285 705 (set (list (types type-1)
ocsenave@285 706 (types type-2)))
ocsenave@285 707 TMs|HMs
ocsenave@285 708 (map
ocsenave@285 709 (comp
ocsenave@285 710 (partial map first)
ocsenave@285 711 (partial remove (comp zero? second)))
ocsenave@285 712 (split-at
ocsenave@285 713 50
ocsenave@285 714 (map vector
ocsenave@285 715 (rest(range))
ocsenave@285 716 (reduce concat
ocsenave@285 717 (map
ocsenave@285 718 #(take 8
ocsenave@285 719 (concat (bit-list %)
ocsenave@285 720 (repeat 0)))
ocsenave@285 721
ocsenave@273 722 TMs|HMs)))))
ocsenave@285 723
ocsenave@285 724 TMs (vec (first TMs|HMs))
ocsenave@285 725 HMs (take 5 (map (partial + -50) (vec (second TMs|HMs))))
ocsenave@285 726
ocsenave@285 727
ocsenave@285 728 ]
ocsenave@285 729
ocsenave@285 730
ocsenave@285 731 {:dex# n
ocsenave@285 732 :base-moves base-moves
ocsenave@285 733 :types types
ocsenave@285 734 :TMs TMs
ocsenave@285 735 :HMs HMs
ocsenave@285 736 :base-hp rating-hp
ocsenave@285 737 :base-atk rating-atk
ocsenave@285 738 :base-def rating-def
ocsenave@285 739 :base-speed rating-speed
ocsenave@285 740 :base-special rating-special
ocsenave@310 741 :o0 pic-dimensions
ocsenave@310 742 :o1 ptr-pic-obverse-1
ocsenave@310 743 :o2 ptr-pic-obverse-2
ocsenave@285 744 }))
ocsenave@285 745
ocsenave@285 746 (partition entry-size
ocsenave@285 747 (take (* entry-size pkmn-count)
ocsenave@285 748 (drop 0x383DE
ocsenave@285 749 rom))))))))
ocsenave@348 750
ocsenave@285 751
ocsenave@285 752
ocsenave@310 753 (defn hxc-intro-pkmn
ocsenave@310 754 "The hardcoded pokemon to display in Prof. Oak's introduction; the pokemon's
ocsenave@310 755 internal id is stored at ROM@5EDB."
ocsenave@310 756 ([] (hxc-intro-pkmn
ocsenave@310 757 com.aurellem.gb.gb-driver/original-rom))
ocsenave@310 758 ([rom]
ocsenave@310 759 (nth (hxc-pokenames rom) (nth rom 0x5EDB))))
ocsenave@310 760
ocsenave@310 761 (defn sxc-intro-pkmn!
ocsenave@310 762 "Set the hardcoded pokemon to display in Prof. Oak's introduction."
ocsenave@310 763 [pokemon]
ocsenave@310 764 (write-rom!
ocsenave@310 765 (rewrite-rom 0x5EDB
ocsenave@310 766 [
ocsenave@310 767 (inc
ocsenave@310 768 ((zipmap
ocsenave@310 769 (hxc-pokenames)
ocsenave@310 770 (range))
ocsenave@310 771 pokemon))])))
ocsenave@285 772
ocsenave@310 773
ocsenave@282 774 (defn hxc-item-prices
ocsenave@282 775 "The hardcoded list of item prices in memory. List begins at ROM@4495"
ocsenave@282 776 ([] (hxc-item-prices com.aurellem.gb.gb-driver/original-rom))
ocsenave@282 777 ([rom]
ocsenave@288 778 (let [items (hxc-items rom)
ocsenave@282 779 price-size 3]
ocsenave@282 780 (zipmap items
ocsenave@282 781 (map (comp
ocsenave@282 782 ;; zero-cost items are "priceless"
ocsenave@282 783 #(if (zero? %) :priceless %)
ocsenave@282 784 decode-bcd butlast)
ocsenave@282 785 (partition price-size
ocsenave@282 786 (take (* price-size (count items))
ocsenave@282 787 (drop 0x4495 rom))))))))
ocsenave@273 788
ocsenave@281 789 (defn hxc-shops
ocsenave@281 790 ([] (hxc-shops com.aurellem.gb.gb-driver/original-rom))
ocsenave@281 791 ([rom]
ocsenave@288 792 (let [items (zipmap (range) (hxc-items rom))
ocsenave@281 793
ocsenave@281 794 ;; temporarily softcode the TM items
ocsenave@281 795 items (into
ocsenave@281 796 items
ocsenave@281 797 (map (juxt identity
ocsenave@281 798 (comp keyword
ocsenave@281 799 (partial str "tm-")
ocsenave@281 800 (partial + 1 -200)
ocsenave@281 801 ))
ocsenave@281 802 (take 200 (drop 200 (range)))))
ocsenave@282 803
ocsenave@281 804 ]
ocsenave@281 805
ocsenave@281 806 ((fn parse-shop [coll [num-items & items-etc]]
ocsenave@282 807 (let [inventory (take-while
ocsenave@282 808 (partial not= 0xFF)
ocsenave@282 809 items-etc)
ocsenave@281 810 [separator & items-etc] (drop num-items (rest items-etc))]
ocsenave@281 811 (if (= separator 0x50)
ocsenave@281 812 (map (partial mapv (comp items dec)) (conj coll inventory))
ocsenave@281 813 (recur (conj coll inventory) items-etc)
ocsenave@281 814 )
ocsenave@281 815 ))
ocsenave@281 816
ocsenave@281 817 '()
ocsenave@282 818 (drop 0x233C rom))
ocsenave@281 819
ocsenave@281 820
ocsenave@281 821 )))
ocsenave@281 822
ocsenave@281 823
ocsenave@273 824
ocsenave@292 825
ocsenave@292 826 (defn hxc-ptrs-wild
ocsenave@292 827 "A list of the hardcoded wild encounter data in memory. Pointers
ocsenave@292 828 begin at ROM@0CB95; data begins at ROM@0x04D89"
ocsenave@292 829 ([] (hxc-ptrs-wild com.aurellem.gb.gb-driver/original-rom))
ocsenave@292 830 ([rom]
ocsenave@292 831 (let [ptrs
ocsenave@292 832 (map (fn [[a b]] (+ a (* 0x100 b)))
ocsenave@292 833 (take-while (partial not= (list 0xFF 0xFF))
ocsenave@292 834 (partition 2 (drop 0xCB95 rom))))]
ocsenave@292 835 ptrs)))
ocsenave@292 836
ocsenave@292 837
ocsenave@292 838
ocsenave@292 839 (defn hxc-wilds
ocsenave@292 840 "A list of the hardcoded wild encounter data in memory. Pointers
ocsenave@292 841 begin at ROM@0CB95; data begins at ROM@0x04D89"
ocsenave@292 842 ([] (hxc-wilds com.aurellem.gb.gb-driver/original-rom))
ocsenave@292 843 ([rom]
ocsenave@292 844 (let [pokenames (zipmap (range) (hxc-pokenames rom))]
ocsenave@292 845 (map
ocsenave@292 846 (partial map (fn [[a b]] {:species (pokenames (dec b)) :level
ocsenave@292 847 a}))
ocsenave@292 848 (partition 10
ocsenave@292 849
ocsenave@292 850 (take-while (comp (partial not= 1)
ocsenave@292 851 first)
ocsenave@292 852 (partition 2
ocsenave@292 853 (drop 0xCD8C rom))
ocsenave@292 854
ocsenave@292 855 ))))))
ocsenave@292 856
ocsenave@292 857
ocsenave@292 858
ocsenave@249 859 ;; ********************** MANIPULATION FNS
ocsenave@249 860
ocsenave@249 861
ocsenave@285 862 (defn same-type
ocsenave@285 863 ([pkmn move]
ocsenave@288 864 (same-type
ocsenave@285 865 com.aurellem.gb.gb-driver/original-rom pkmn move))
ocsenave@285 866 ([rom pkmn move]
ocsenave@285 867 (((comp :types (hxc-pokemon-base rom)) pkmn)
ocsenave@285 868 ((comp :type (hxc-move-data rom)) move))))
ocsenave@285 869
ocsenave@285 870
ocsenave@249 871
ocsenave@249 872
ocsenave@249 873 (defn submap?
ocsenave@249 874 "Compares the two maps. Returns true if map-big has the same associations as map-small, otherwise false."
ocsenave@249 875 [map-small map-big]
ocsenave@249 876 (cond (empty? map-small) true
ocsenave@249 877 (and
ocsenave@249 878 (contains? map-big (ffirst map-small))
ocsenave@249 879 (= (get map-big (ffirst map-small))
ocsenave@249 880 (second (first map-small))))
ocsenave@249 881 (recur (next map-small) map-big)
ocsenave@249 882
ocsenave@249 883 :else false))
ocsenave@249 884
ocsenave@249 885
ocsenave@249 886 (defn search-map [proto-map maps]
ocsenave@249 887 "Returns all the maps that make the same associations as proto-map."
ocsenave@249 888 (some (partial submap? proto-map) maps))
ocsenave@249 889
rlm@252 890 (defn filter-vals
rlm@252 891 "Returns a map consisting of all the pairs [key val] for
rlm@252 892 which (pred key) returns true."
rlm@252 893 [pred map]
rlm@252 894 (reduce (partial apply assoc) {}
rlm@252 895 (filter (fn [[k v]] (pred v)) map)))
ocsenave@249 896
ocsenave@249 897
ocsenave@249 898 (defn search-moves
rlm@252 899 "Returns a subcollection of all hardcoded moves with the
rlm@252 900 given attributes. Attributes consist of :name :power
rlm@252 901 :accuracy :pp :fx-id
rlm@252 902 (and also :fx-txt, but it contains the same information
rlm@252 903 as :fx-id)"
ocsenave@249 904 ([attribute-map]
rlm@252 905 (search-moves
rlm@252 906 com.aurellem.gb.gb-driver/original-rom attribute-map))
ocsenave@249 907 ([rom attribute-map]
rlm@252 908 (filter-vals (partial submap? attribute-map)
rlm@252 909 (hxc-move-data rom))))
ocsenave@249 910
ocsenave@249 911
ocsenave@249 912
ocsenave@249 913
ocsenave@243 914
ocsenave@283 915 ;; note: 0x2f31 contains the names "TM" "HM"?
ocsenave@283 916
ocsenave@246 917 ;; note for later: credits start at F1290
ocsenave@243 918
ocsenave@346 919 ;; note: DADB hyper-potion-hp _ _ _ super-potion-hp _ _ _ potion-hp ??
ocsenave@243 920
ocsenave@346 921 ;; note: DD4D spells out pokemon vital stat names ("speed", etc.)
ocsenave@346 922
ocsenave@346 923 ;; note: 1195C-6A says ABLE#NOT ABLE#, but so does 119C0-119CE.
ocsenave@346 924 ;; The first instance is for Machines; the second, for stones.
ocsenave@243 925
ocsenave@420 926 ;; note: according to
ocsenave@420 927 ;; http://www.upokecenter.com/games/rby/guides/rgbtrainers.php
ocsenave@420 928 ;; the amount of money given by a trainer is equal to the
ocsenave@420 929 ;; base money times the level of the last Pokemon on that trainer's
ocsenave@420 930 ;; list. Other sources say it's the the level of the last pokemon
ocsenave@420 931 ;; /defeated/.
ocsenave@420 932
ocsenave@420 933 ;; todo: find base money.
ocsenave@420 934
ocsenave@420 935
ocsenave@420 936 ;; note: 0xDFEA (in indexable mem) is the dex# of the currently-viewed Pokemon in
ocsenave@420 937 ;; in the pokedex. It's used for other purposes if there is none.
ocsenave@420 938
ocsenave@420 939 ;; note: 0x9D35 (index.) switches from 0xFF to 0x00 temporarily when
ocsenave@420 940 ;; you walk between areas.
ocsenave@420 941
ocsenave@420 942 ;; note: 0xD059 (index.) is the special battle type of your next battle:
ocsenave@420 943 ;; - 00 is a usual battle
ocsenave@420 944 ;; - 01 is a pre-scripted OLD MAN battle which always fails to catch the
ocsenave@420 945 ;; target Pokemon.
ocsenave@420 946 ;; - 02 is a safari zone battle
ocsenave@420 947 ;; - 03 obligates you to run away. (unused)
ocsenave@420 948 ;; - 04 is a pre-scripted OAK battle, which (temporarily) causes the
ocsenave@420 949 ;; enemy Pokemon to cry PIKAAA, and which always catches the target
ocsenave@420 950 ;; Pokemon. The target Pokemon is erased after the battle.
ocsenave@420 951 ;; - 05+ are glitch states in which you are sort of the Pokemon.
ocsenave@420 952
ocsenave@420 953
ocsenave@420 954 ;; note: 0x251A (in indexable mem): image decompression routine seems to begin here.
ocsenave@420 955
ocsenave@420 956 ;; note: 0x4845 (index): vending inventory is loaded here. possibly
ocsenave@420 957 ;; other things, too.
ocsenave@420 958 (comment
ocsenave@420 959 ;; temporarily intercept/adjust what pops out of the vending
ocsenave@420 960 ;; machine.
ocsenave@420 961 ;; (and how much it costs)
ocsenave@420 962
ocsenave@420 963 ;; located at 0x4845
ocsenave@420 964 ;; not to be confused with shop inventory, 0xCF7B
ocsenave@420 965 (do
ocsenave@420 966 (step (read-state "vend-menu"))
ocsenave@420 967 (write-memory! (rewrite-memory (vec(memory)) 0x4845 [2 0 1 0]))
ocsenave@420 968 (step @current-state [:a])
ocsenave@420 969 (step @current-state [])
ocsenave@420 970 (nstep @current-state 200) ))
ocsenave@347 971
ocsenave@347 972
rlm@376 973 ;; Note: There are two tile tables, one from 8000-8FFF, the other from
rlm@376 974 ;; 8800-97FF. The latter contains symbols, possibly map tiles(?), with some japanese chars and stuff at the end.
rlm@376 975 (defn print-pixel-letters!
rlm@376 976 "The pixel tiles representing letters. Neat!"
ocsenave@420 977 ([] (print-pixel-letters! (read-state "oak-speaks")))
ocsenave@420 978 ([state]
ocsenave@420 979 (map
ocsenave@420 980 (comp
ocsenave@420 981 println
ocsenave@420 982 (partial map #(if (zero? %) \space 0))
ocsenave@420 983 #(if (< (count %) 8)
ocsenave@420 984 (recur (cons 0 %))
ocsenave@420 985 %)
ocsenave@420 986 reverse bit-list)
ocsenave@420 987
ocsenave@420 988 (take 0xFFF (drop 0x8800 (memory state))))))
ocsenave@420 989
ocsenave@420 990
ocsenave@420 991 ;; (defn test-2 []
ocsenave@420 992 ;; (loop [n 0
ocsenave@420 993 ;; pc-1 (pc-trail (-> state-defend (tick) (step [:a]) (step [:a]) (step []) (nstep 100)) 100000)
ocsenave@420 994 ;; pc-2 (pc-trail (-> state-speed (tick) (step [:a]) (step [:a])
ocsenave@420 995 ;; (step []) (nstep 100)) 100000)]
ocsenave@420 996 ;; (cond (empty? (drop n pc-1)) [pc-1 n]
ocsenave@420 997 ;; (not= (take 10 (drop n pc-1)) (take 10 pc-2))
ocsenave@420 998 ;; (recur pc-1 pc-2 (inc n))
ocsenave@420 999 ;; :else
ocsenave@420 1000 ;; [(take 1000 pc-2) n])))
ocsenave@420 1001
ocsenave@420 1002
ocsenave@420 1003
ocsenave@420 1004
ocsenave@420 1005 (defn test-3
ocsenave@420 1006 "Explore trainer data"
ocsenave@420 1007 ([] (test-3 0x3A289))
ocsenave@420 1008 ([start]
ocsenave@420 1009 (let [pokenames (vec(hxc-pokenames-raw))]
ocsenave@420 1010 (println
ocsenave@420 1011 (reduce
ocsenave@420 1012 str
ocsenave@420 1013 (map
ocsenave@420 1014 (fn [[adr lvl pkmn]]
ocsenave@420 1015 (str (format "%-11s %4d %02X %02X \t %05X\n"
ocsenave@420 1016
ocsenave@420 1017 (cond
ocsenave@420 1018 (zero? lvl) "+"
ocsenave@420 1019 (nil? (get pokenames (dec pkmn)))
ocsenave@420 1020 "-"
ocsenave@420 1021 :else
ocsenave@420 1022 (get pokenames (dec pkmn)))
ocsenave@420 1023 lvl
ocsenave@420 1024 pkmn
ocsenave@420 1025 lvl
ocsenave@420 1026 adr
ocsenave@420 1027 )))
ocsenave@420 1028 (map cons
ocsenave@420 1029 (take-nth 2 (drop start (range)))
ocsenave@420 1030 (partition 2
ocsenave@420 1031 (take 400;;703
ocsenave@420 1032 (drop
ocsenave@420 1033 start
ocsenave@420 1034 ;; 0x3A75D
ocsenave@420 1035 (rom)))))))))))
ocsenave@420 1036
ocsenave@420 1037 (defn search-memory* [mem codes k]
ocsenave@420 1038 (loop [index 0
ocsenave@420 1039 index-next 1
ocsenave@420 1040 start-match 0
ocsenave@420 1041 to-match codes
ocsenave@420 1042 matches []]
ocsenave@420 1043 (cond
ocsenave@420 1044 (>= index (count mem)) matches
ocsenave@420 1045
ocsenave@420 1046 (empty? to-match)
ocsenave@420 1047 (recur
ocsenave@420 1048 index-next
ocsenave@420 1049 (inc index-next)
ocsenave@420 1050 index-next
ocsenave@420 1051 codes
ocsenave@420 1052 (conj matches
ocsenave@420 1053 [(hex start-match) (take k (drop start-match mem))])
ocsenave@420 1054 )
ocsenave@420 1055
ocsenave@420 1056 (or (= (first to-match) \_) ;; wildcard
ocsenave@420 1057 (= (first to-match) (nth mem index)))
ocsenave@420 1058 (recur
ocsenave@420 1059 (inc index)
ocsenave@420 1060 index-next
ocsenave@420 1061 start-match
ocsenave@420 1062 (rest to-match)
ocsenave@420 1063 matches)
ocsenave@420 1064
ocsenave@420 1065 :else
ocsenave@420 1066 (recur
ocsenave@420 1067 index-next
ocsenave@420 1068 (inc index-next)
ocsenave@420 1069 index-next
ocsenave@420 1070 codes
ocsenave@420 1071 matches))))
rlm@376 1072
ocsenave@420 1073
ocsenave@420 1074 (defn search-pattern [ptn coll]
ocsenave@420 1075 (loop
ocsenave@420 1076 [index 0
ocsenave@420 1077 to-match ptn
ocsenave@420 1078 binds {}
ocsenave@420 1079
ocsenave@420 1080 next-index 1
ocsenave@420 1081 match-start 0
ocsenave@420 1082 matches []]
ocsenave@420 1083
ocsenave@420 1084 (cond
ocsenave@420 1085 (>= index (count coll)) matches
ocsenave@420 1086 (empty? to-match)
ocsenave@420 1087 (recur
ocsenave@420 1088 next-index
ocsenave@420 1089 ptn
ocsenave@420 1090 {}
ocsenave@420 1091 (inc next-index)
ocsenave@420 1092 next-index
ocsenave@420 1093 (conj match-start
ocsenave@420 1094 [(hex match-start) binds]))
ocsenave@420 1095
ocsenave@420 1096 :else
ocsenave@420 1097 (let [k (first to-match)
ocsenave@420 1098 v (nth coll index)]
ocsenave@420 1099 (cond
ocsenave@420 1100 (= k \_) ;; wildcard
ocsenave@420 1101 (recur
ocsenave@420 1102 (inc index)
ocsenave@420 1103 (rest to-match)
ocsenave@420 1104 binds
ocsenave@420 1105
ocsenave@420 1106 next-index
ocsenave@420 1107 match-start
ocsenave@420 1108 matches)
ocsenave@420 1109
ocsenave@420 1110 (keyword? k)
ocsenave@420 1111 (if (binds k)
ocsenave@420 1112 (if (= (binds k) v)
ocsenave@420 1113
ocsenave@420 1114 ;; consistent bindings
ocsenave@420 1115 (recur
ocsenave@420 1116 (inc index)
ocsenave@420 1117 (rest to-match)
ocsenave@420 1118 binds
ocsenave@420 1119
ocsenave@420 1120 next-index
ocsenave@420 1121 match-start
ocsenave@420 1122 matches)
ocsenave@420 1123
ocsenave@420 1124 ;; inconsistent bindings
ocsenave@420 1125 (recur
ocsenave@420 1126 next-index
ocsenave@420 1127 ptn
ocsenave@420 1128 {}
ocsenave@420 1129 (inc next-index)
ocsenave@420 1130 next-index
ocsenave@420 1131 matches))
ocsenave@420 1132
ocsenave@420 1133 (if ((set (vals binds)) v)
ocsenave@420 1134 ;; bindings are not unique
ocsenave@420 1135 (recur
ocsenave@420 1136 next-index
ocsenave@420 1137 ptn
ocsenave@420 1138 {}
ocsenave@420 1139 (inc next-index)
ocsenave@420 1140 next-index
ocsenave@420 1141 matches)
ocsenave@420 1142
ocsenave@420 1143 ;; bindings are unique
ocsenave@420 1144 (recur
ocsenave@420 1145 (inc index)
ocsenave@420 1146 (rest to-match)
ocsenave@420 1147 (assoc binds k v)
ocsenave@420 1148
ocsenave@420 1149 next-index
ocsenave@420 1150 match-start
ocsenave@420 1151 matches)))
ocsenave@420 1152
ocsenave@420 1153 :else ;; k is just a number
ocsenave@420 1154 (if (= k v)
ocsenave@420 1155 (recur
ocsenave@420 1156 (inc index)
ocsenave@420 1157 (rest to-match)
ocsenave@420 1158 binds
ocsenave@420 1159
ocsenave@420 1160 next-index
ocsenave@420 1161 match-start
ocsenave@420 1162 matches)
ocsenave@420 1163
ocsenave@420 1164 (recur
ocsenave@420 1165 next-index
ocsenave@420 1166 ptn
ocsenave@420 1167 {}
ocsenave@420 1168 (inc next-index)
ocsenave@420 1169 next-index
ocsenave@420 1170 matches)))))))
ocsenave@420 1171
ocsenave@420 1172
ocsenave@420 1173
ocsenave@420 1174
ocsenave@420 1175
ocsenave@420 1176
ocsenave@420 1177
ocsenave@420 1178
ocsenave@420 1179
ocsenave@420 1180 (defn search-pattern* [ptn coll]
ocsenave@420 1181 (loop
ocsenave@420 1182 [
ocsenave@420 1183 binds {}
ocsenave@420 1184 index 0
ocsenave@420 1185 index-next 1
ocsenave@420 1186 start-match 0
ocsenave@420 1187 to-match ptn
ocsenave@420 1188 matches []]
ocsenave@420 1189
ocsenave@420 1190 (cond
ocsenave@420 1191 (>= index (count coll)) matches
ocsenave@420 1192 (empty? to-match)
ocsenave@420 1193 (recur
ocsenave@420 1194 {}
ocsenave@420 1195 index-next
ocsenave@420 1196 (inc index-next)
ocsenave@420 1197 index-next
ocsenave@420 1198 ptn
ocsenave@420 1199 (conj matches
ocsenave@420 1200 [(hex start-match) binds]))
ocsenave@420 1201
ocsenave@420 1202 :else
ocsenave@420 1203 (let [k (first to-match)
ocsenave@420 1204 v (nth coll index)]
ocsenave@420 1205 (cond
ocsenave@420 1206 (= k \_) ;; wildcard
ocsenave@420 1207 (recur
ocsenave@420 1208 binds
ocsenave@420 1209 (inc index)
ocsenave@420 1210 index-next
ocsenave@420 1211 start-match
ocsenave@420 1212 (rest to-match)
ocsenave@420 1213 matches)
ocsenave@420 1214
ocsenave@420 1215 (keyword? k)
ocsenave@420 1216 (if (binds k)
ocsenave@420 1217 (if (= (binds k) v)
ocsenave@420 1218 (recur
ocsenave@420 1219 binds
ocsenave@420 1220 (inc index)
ocsenave@420 1221 index-next
ocsenave@420 1222 start-match
ocsenave@420 1223 (rest to-match)
ocsenave@420 1224 matches)
ocsenave@420 1225 (recur
ocsenave@420 1226 {}
ocsenave@420 1227 index-next
ocsenave@420 1228 (inc index-next)
ocsenave@420 1229 index-next
ocsenave@420 1230 ptn
ocsenave@420 1231 matches))
ocsenave@420 1232 (if
ocsenave@420 1233 ;; every symbol must be bound to a different thing.
ocsenave@420 1234 ((set (vals binds)) v)
ocsenave@420 1235 (recur
ocsenave@420 1236 {}
ocsenave@420 1237 index-next
ocsenave@420 1238 (inc index-next)
ocsenave@420 1239 index-next
ocsenave@420 1240 ptn
ocsenave@420 1241 matches)
ocsenave@420 1242 (recur
ocsenave@420 1243 (assoc binds k v)
ocsenave@420 1244 (inc index)
ocsenave@420 1245 index-next
ocsenave@420 1246 start-match
ocsenave@420 1247 (rest to-match)
ocsenave@420 1248 matches))))))))
ocsenave@420 1249
ocsenave@420 1250
ocsenave@420 1251
ocsenave@420 1252
ocsenave@420 1253 ;; look for the rainbow badge in memory
ocsenave@420 1254 (println (reduce str (map #(str (first %) "\t" (vec(second %)) "\n") (search-memory (rom) [221] 10))))
rlm@376 1255
rlm@376 1256
ocsenave@246 1257 (comment
ocsenave@243 1258
rlm@218 1259 (def hxc-later
rlm@218 1260 "Running this code produces, e.g. hardcoded names NPCs give
rlm@218 1261 their pokemon. Will sort through it later."
rlm@218 1262 (print (character-codes->str(take 10000
rlm@218 1263 (drop 0x71597
rlm@218 1264 (rom (root)))))))
rlm@218 1265
rlm@218 1266 (let [dex
rlm@218 1267 (partition-by #(= 0x50 %)
rlm@218 1268 (take 2540
rlm@218 1269 (drop 0x40687
rlm@218 1270 (rom (root)))))]
rlm@218 1271 (def dex dex)
rlm@218 1272 (def hxc-species
rlm@218 1273 (map character-codes->str
rlm@218 1274 (take-nth 4 dex))))
ocsenave@259 1275 )