Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/pokemon.clj @ 583:21e4ab461506

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fixed glyph display bug, going to apply cosmetic corrections now and remove testing cruft.
author Robert McIntyre <rlm@mit.edu>
date Sat, 01 Sep 2012 09:54:48 -0500
parents fe6fd2323264
children
rev   line source
rlm@176 1 (ns com.aurellem.gb.pokemon
rlm@190 2 (:use (com.aurellem.gb gb-driver util constants characters
rlm@190 3 moves types items status dv species
rlm@326 4 experience stats pokemon-presets
rlm@190 5 ))
rlm@176 6 (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@176 7
rlm@176 8 (def pokemon-names-start 0xD2B4)
rlm@176 9
rlm@179 10 (defn set-party-number
rlm@179 11 ([^SaveState state new-party-num]
rlm@237 12 (-> state
rlm@237 13 (set-memory 0xD162 new-party-num)
rlm@237 14 (set-memory (+ 0xD162 new-party-num 1) 0xFF)))
rlm@179 15 ([new-party-num]
rlm@179 16 (set-party-number @current-state new-party-num)))
rlm@176 17
rlm@176 18 (def party-number-address 0xD162)
rlm@176 19
rlm@176 20 (defn party-number
rlm@176 21 ([^SaveState state]
rlm@176 22 (aget (memory state) party-number-address))
rlm@176 23 ([] (party-number @current-state)))
rlm@176 24
rlm@176 25 (defn party-names
rlm@176 26 ([^SaveState state]
rlm@176 27 (let [raw-names
rlm@176 28 (subvec (vec (memory state))
rlm@176 29 pokemon-names-start
rlm@176 30 (+ pokemon-names-start
rlm@176 31 (* name-width 6)))]
rlm@176 32 (map
rlm@176 33 read-name
rlm@176 34 (take
rlm@176 35 (party-number state)
rlm@176 36 (partition name-width
rlm@176 37 raw-names)))))
rlm@176 38 ([] (party-names @current-state)))
rlm@176 39
rlm@191 40 (defn pokemon-nickname
rlm@191 41 ([^SaveState state poke-num]
rlm@191 42 (nth (party-names state) poke-num))
rlm@191 43 ([poke-num]
rlm@191 44 (pokemon-nickname @current-state poke-num)))
rlm@191 45
rlm@176 46 (defn rename-pokemon
rlm@176 47 ([^SaveState state n new-name]
rlm@176 48 (assert (<= 0 n (dec (party-number state))))
rlm@176 49 (assert (<= (count new-name) max-name-length))
rlm@176 50 (set-memory-range
rlm@176 51 state
rlm@176 52 (+ (* n name-width) pokemon-names-start)
rlm@176 53 (concat (str->character-codes new-name) [end-of-name-marker])))
rlm@176 54 ([n new-name]
rlm@176 55 (rename-pokemon @current-state n new-name)))
rlm@176 56
rlm@176 57 (def OT-start 0xD272)
rlm@176 58
rlm@176 59 (defn original-trainers
rlm@176 60 ([^SaveState state]
rlm@176 61 (let [raw-names
rlm@176 62 (subvec (vec (memory state))
rlm@176 63 OT-start
rlm@176 64 (+ OT-start
rlm@176 65 (* name-width 6)))]
rlm@176 66 (map read-name
rlm@176 67 (take (party-number state)
rlm@176 68 (partition name-width raw-names)))))
rlm@176 69 ([] (original-trainers @current-state)))
rlm@176 70
rlm@192 71 (defn read-OT-name
rlm@192 72 ([^SaveState state poke-num]
rlm@192 73 (nth (original-trainers state) poke-num))
rlm@209 74 ([poke-num] (read-OT-name @current-state poke-num)))
rlm@192 75
rlm@192 76 (defn set-OT-name
rlm@176 77 "Set the OT name for a pokemon.
rlm@176 78 Note that a pokemon is still considered 'yours' if
rlm@176 79 the OT ID is the same as your own."
rlm@176 80 ([^SaveState state poke-num new-name]
rlm@176 81 (assert (<= 0 poke-num (dec (party-number state))))
rlm@176 82 (assert (<= (count new-name) max-name-length))
rlm@176 83 (set-memory-range
rlm@176 84 state
rlm@176 85 (+ (* poke-num name-width) OT-start)
rlm@176 86 (concat (str->character-codes new-name) [end-of-name-marker])))
rlm@176 87 ([n new-name]
rlm@209 88 (set-OT-name @current-state n new-name)))
rlm@176 89
rlm@197 90 (def OT-ID-addresses [0xD176 0xD1A2 0xD1CE 0xD1FA 0xD226 0xD252])
rlm@176 91
rlm@192 92 (defn read-OT-id
rlm@192 93 ([^SaveState state poke-num]
rlm@192 94 (let [mem (memory state)
rlm@192 95 start (OT-ID-addresses poke-num)]
rlm@192 96 (glue-bytes
rlm@192 97 (aget mem start)
rlm@192 98 (aget mem (inc start)))))
rlm@192 99 ([poke-num] (read-OT-id @current-state poke-num)))
rlm@192 100
rlm@192 101 (defn set-OT-id
rlm@192 102 ([^SaveState state poke-num new-OT-num]
rlm@192 103 (assert (<= 0 poke-num 5))
rlm@192 104 (assert (<= 0 new-OT-num 0xFFFF))
rlm@176 105 (set-memory-range
rlm@176 106 state
rlm@192 107 (OT-ID-addresses poke-num)
rlm@192 108 (disect-bytes-2 new-OT-num)))
rlm@192 109 ([poke-num new-OT-num]
rlm@209 110 (set-OT-id @current-state poke-num new-OT-num)))
rlm@176 111
rlm@176 112 (def unknown "[[[UNKNOWN]]]")
rlm@176 113
rlm@176 114 (def unknown "")
rlm@176 115
rlm@189 116 (def pokemon-1-record
rlm@176 117 {0xD16A "Color Map" ;; 0
rlm@176 118 0xD16B "Current-HP (h)" ;; 1
rlm@176 119 0xD16C "Current-HP (l)" ;; 2
rlm@182 120 0XD16D "Unused" ;; 3
rlm@178 121 0xD16E "Status" ;; 4
rlm@182 122 0xD16F "Type 1" ;; 5
rlm@182 123 0xD170 "Type 2" ;; 6
rlm@182 124 0xD171 "scratch/C.R." ;; 7
rlm@176 125 0xD172 "Move 1 ID" ;; 8
rlm@176 126 0xD173 "Move 2 ID" ;; 9
rlm@176 127 0xD174 "Move 3 ID" ;; 10
rlm@176 128 0xD175 "Move 4 ID" ;; 11
rlm@176 129 0xD176 "OT-ID (h)" ;; 12
rlm@176 130 0xD177 "OT-ID (l)" ;; 13
rlm@176 131 0xD178 "Exp. Points (h)" ;; 14
rlm@176 132 0xD179 "Exp. Points (m)" ;; 15
rlm@176 133 0xD17A "Exp. Points (l)" ;; 16
rlm@176 134 0xD17B "HP Exp. (h)" ;; 17
rlm@176 135 0xD17C "HP Exp. (l)" ;; 18
rlm@176 136 0xD17D "Attack Exp. (h)" ;; 19
rlm@176 137 0xD17E "Attack Exp. (l)" ;; 20
rlm@176 138 0xD17F "Defense Exp. (h)" ;; 21
rlm@176 139 0xD180 "Defense Exp. (l)" ;; 22
rlm@176 140 0xD181 "Speed Exp. (h)" ;; 23
rlm@176 141 0xD182 "Speed Exp. (l)" ;; 24
rlm@176 142 0xD183 "Special Exp. (h)" ;; 25
rlm@176 143 0xD184 "Special Exp. (l)" ;; 26
rlm@176 144 0xD185 "DV Atk/Def" ;; 27
rlm@176 145 0xD186 "DV Speed/Spc" ;; 28
rlm@176 146 0xD187 "PP Move 1" ;; 29
rlm@176 147 0xD188 "PP Move 2" ;; 30
rlm@176 148 0xD189 "PP Move 3" ;; 31
rlm@176 149 0xD18A "PP Move 4" ;; 32
rlm@176 150 0xD18B "Current Level" ;; 33
rlm@176 151 0xD18C "HP Total (h)" ;; 34
rlm@176 152 0xD18D "HP Total (l)" ;; 35
rlm@176 153 0xD18E "Attack (h)" ;; 36
rlm@176 154 0xD18F "Attack (l)" ;; 37
rlm@176 155 0xD190 "Defense (h)" ;; 38
rlm@176 156 0xD191 "Defense (l)" ;; 39
rlm@176 157 0xD192 "Speed (h)" ;; 40
rlm@176 158 0xD193 "Speed (l)" ;; 41
rlm@176 159 0xD194 "Special (h)" ;; 42
rlm@176 160 0xD195 "Special (l)" ;; 43
rlm@176 161 })
rlm@176 162
rlm@189 163 (defn pokemon-record
rlm@176 164 ([^SaveState state pokemon-num]
rlm@176 165 (assert (<= 0 pokemon-num 5))
rlm@176 166 (let [base (+ (* pokemon-num pokemon-record-width) 0xD16A)]
rlm@176 167 (subvec (vec (memory state)) base
rlm@176 168 (+ base pokemon-record-width))))
rlm@189 169 ([pokemon-num] (pokemon-record @current-state pokemon-num)))
rlm@176 170
rlm@189 171 (defn set-pokemon-record
rlm@176 172 ([^SaveState state pokemon-num new-data]
rlm@176 173 (assert (<= 0 pokemon-num 5))
rlm@176 174 (let [base (+ (* pokemon-num pokemon-record-width) 0xD16A)]
rlm@176 175 (set-memory-range state base new-data)))
rlm@176 176 ([pokemon-num new-data]
rlm@189 177 (set-pokemon-record @current-state pokemon-num new-data)))
rlm@176 178
rlm@189 179 (defn print-pokemon-record
rlm@176 180 ([^SaveState state pokemon-num]
rlm@176 181 (assert (<= 0 pokemon-num 5))
rlm@189 182 (let [poke-data (pokemon-record state pokemon-num)
rlm@189 183 backbone (sort (keys pokemon-1-record))]
rlm@176 184 (println "Pokemon " pokemon-num " -- "
rlm@176 185 (nth (party-names state)
rlm@176 186 pokemon-num) \newline)
rlm@176 187
rlm@176 188 (println " Desc. | Hex | Dec | Binary |")
rlm@176 189 (println "-------------------+------+-----+----------+")
rlm@176 190 (dorun
rlm@176 191 (map
rlm@176 192 (comp println
rlm@176 193 (fn [desc data]
rlm@176 194 (format "%-16s | 0x%02X | %3d | %s |"
rlm@176 195 desc data data
rlm@176 196 (let [s (Integer/toBinaryString data)]
rlm@176 197 (apply
rlm@176 198 str
rlm@176 199 (concat (repeat (- 8 (count s)) "0" )
rlm@176 200 s))))))
rlm@189 201 (map pokemon-1-record backbone)
rlm@176 202 poke-data))))
rlm@176 203 ([pokemon-num]
rlm@189 204 (print-pokemon-record @current-state pokemon-num)))
rlm@190 205
rlm@209 206 (defn pokemon
rlm@191 207 ([^SaveState state poke-num]
rlm@191 208 (assert (<= 0 poke-num 5))
rlm@191 209 (let [dv-values (read-DV state poke-num)
rlm@191 210 type (read-type state poke-num)
rlm@191 211 species (read-species state poke-num)
rlm@191 212 species2 (read-species2 state poke-num)
rlm@191 213 moves (read-moves state poke-num)
rlm@191 214 moves-pp (mapv (partial read-pp state
rlm@191 215 poke-num)
rlm@191 216 (range (count moves)))
rlm@191 217 nickname (pokemon-nickname state poke-num)
rlm@191 218 status (read-status state poke-num)
rlm@192 219 stats (read-stats state poke-num)
rlm@191 220 experience (read-experience state poke-num)
rlm@192 221 OT-name (read-OT-name state poke-num)
rlm@193 222 ID (read-OT-id state poke-num)]
rlm@193 223 {;; persistent
rlm@193 224 :name nickname
rlm@191 225 :species species
rlm@191 226 :species2 species2
rlm@191 227 :type type
rlm@191 228 :dv dv-values
rlm@192 229 :original-trainer OT-name
rlm@192 230 :ID ID
rlm@196 231 :moves (mapv vector moves moves-pp)
rlm@190 232
rlm@193 233 ;; ephemerial
rlm@200 234 :status status
rlm@192 235 :stats stats
rlm@191 236 :experience experience
rlm@193 237 }))
rlm@191 238 ([poke-num]
rlm@209 239 (pokemon @current-state poke-num)))
rlm@195 240
rlm@202 241 (def status-message
rlm@202 242 {:sleep-6 "sleeping. It will wake in six turns."
rlm@202 243 :sleep-5 "sleeping. It will wake in five turns."
rlm@202 244 :sleep-4 "sleeping. It will wake in four turns."
rlm@202 245 :sleep-3 "sleeping. It will wake in three turns."
rlm@202 246 :sleep-2 "sleeping. It will wake in two turns."
rlm@202 247 :sleep-1 "sleeping. It will wake in one turn."
rlm@202 248 :poisoned "poisoned."
rlm@202 249 :frozen "frozen solid."
rlm@202 250 :burned "burned."
rlm@202 251 :paralyzed "paralyzed."})
rlm@202 252
rlm@202 253
rlm@195 254 (defn print-pokemon
rlm@195 255 ([^SaveState state poke-num]
rlm@209 256 (let [info (pokemon state poke-num)]
rlm@195 257 (printf
rlm@195 258 (str
rlm@195 259 "##################################"
rlm@195 260 "##################################\n"
rlm@195 261 "# "
rlm@195 262 " #\n"
rlm@195 263 "# %-44s"
rlm@195 264 "%-20s#\n"
rlm@195 265 "# "
rlm@195 266 " #\n"
rlm@195 267 "##################################"
rlm@195 268 "##################################\n\n")
rlm@195 269
rlm@195 270 (str
rlm@195 271 (:name info)
rlm@195 272 (str
rlm@202 273 " [" (.toUpperCase
rlm@202 274 (.substring (str (:species info)) 1)) "]")
rlm@195 275 (str " Lvl." (format "%-3d" (:level (:stats info)))))
rlm@195 276 (str (:original-trainer info) " / " (:ID info)))
rlm@195 277
rlm@195 278 (println
rlm@195 279 (str
rlm@195 280 (str "-----------------------------------"
rlm@195 281 "---------------------------------\n" )
rlm@195 282 (str "| Stats | HP | Attack "
rlm@195 283 "| Defense | Speed | Special |\n")
rlm@195 284 (str "+-----------+----------+----------"
rlm@195 285 "+----------+----------+----------+")))
rlm@195 286
rlm@195 287 (printf
rlm@202 288 (str "|%-11s| %5d | %5d "
rlm@202 289 "| %5d | %5d | %5d |\n")
rlm@195 290 "DV Values" (:hp (:dv info)) (:attack (:dv info))
rlm@195 291 (:defense (:dv info)) (:speed (:dv info))
rlm@195 292 (:special (:dv info)))
rlm@195 293
rlm@195 294 (let [c (:stats info)]
rlm@195 295 (printf
rlm@202 296 (str "|%-11s|%8s | %5d "
rlm@202 297 "| %5d | %5d | %5d |\n")
rlm@202 298 "Current" (str (:current-hp c) "/" (:hp c)) (:attack c)
rlm@195 299 (:defense c) (:speed c)
rlm@195 300 (:special c)))
rlm@195 301
rlm@195 302 (let [e (:experience info)]
rlm@195 303 (printf
rlm@202 304 (str "|%-11s| %5d | %5d "
rlm@202 305 "| %5d | %5d | %5d |\n")
rlm@195 306 "Experience" (:hp-exp e) (:attack-exp e)
rlm@195 307 (:defense-exp e) (:speed-exp e)
rlm@195 308 (:special-exp e)))
rlm@195 309 (println
rlm@195 310 (str "+-----------+----------+----------"
rlm@195 311 "+----------+----------+----------+"))
rlm@195 312
rlm@195 313 (print "\n")
rlm@195 314 (println "+------------------+----+--------+--------+")
rlm@195 315 (println "| Move | PP | Max PP | PP UPs |")
rlm@196 316 (println "+------------------+----+--------+--------+")
rlm@196 317
rlm@197 318 (dorun
rlm@197 319 (for [[name {:keys [pp-ups current-pp]}] (:moves info)]
rlm@197 320 (printf
rlm@197 321 "| %-17s| %2d | %02d | %02d |\n"
rlm@197 322 (.substring (str name) 1)
rlm@197 323 current-pp (max-pp name pp-ups) pp-ups)))
rlm@195 324
rlm@200 325 (println "+------------------+----+--------+--------+\n")
rlm@195 326
rlm@200 327 (println "Total Experience:" (:main-exp (:experience info)))
rlm@202 328 (if (not= :normal (:status info))
rlm@202 329 (println "\n* This pokemon is currently"
rlm@202 330 (status-message (:status info))))
rlm@200 331 (if (not= (:species info) (:species2 info))
rlm@202 332 (println "\n* This pokemon has a secondary species"
rlm@200 333 (str
rlm@200 334 "("
rlm@200 335 (.substring (str (:species2 info)) 1) ")\n")
rlm@206 336 " that does not match its primary species."))
rlm@206 337 (if (not= (:type info) (pokemon->type (:species info)))
rlm@206 338 (println "\n* This pokemon has a type"
rlm@206 339 (str (:type info))
rlm@206 340 "which \n"
rlm@206 341 " is inconsistent with the default type for its"
rlm@206 342 "species."))))
rlm@195 343 ([poke-num]
rlm@195 344 (print-pokemon @current-state poke-num)))
rlm@192 345
rlm@202 346 (defn print-team []
rlm@202 347 (dorun (map print-pokemon (range (party-number)))))
rlm@202 348
rlm@202 349
rlm@192 350 (defn give-status-all
rlm@192 351 ([^SaveState state status]
rlm@192 352 (reduce (fn [state num]
rlm@192 353 (give-status state num status))
rlm@192 354 state
rlm@192 355 (range (party-number state))))
rlm@192 356 ([status]
rlm@192 357 (give-status-all @current-state status)))
rlm@203 358
rlm@203 359 (defn expand-pokemon
rlm@203 360 "Given a map describing a pokemon, fill in any missing
rlm@203 361 values based on the ones already present."
rlm@203 362 [pokemon]
rlm@203 363 (-> (merge pokemon-base pokemon)
rlm@203 364 ;; if no nickname is supplied, default to the
rlm@203 365 ;; uppercase name of the species, as r/b/y do
rlm@203 366 ;; when a pokemon is captured.
rlm@203 367 ((fn [pokemon]
rlm@203 368 (if (nil? (:name pokemon))
rlm@203 369 (assoc pokemon :name (.toUpperCase
rlm@203 370 (.substring
rlm@203 371 (str (:species pokemon)) 1)))
rlm@203 372 pokemon)))
rlm@203 373 ;; species2 should almost always just be the
rlm@203 374 ;; same as species.
rlm@203 375 ((fn [pokemon]
rlm@203 376 (if (nil? (:species2 pokemon))
rlm@209 377 (assoc pokemon :species2 (:species pokemon))
rlm@209 378 pokemon)))
rlm@203 379
rlm@203 380 ;; enable the date in :moves to be any combo of
rlm@203 381 ;; [:move-1 :move-2]
rlm@203 382 ;; [[:move-1 {:pp 20}] :move-2]
rlm@203 383 ;; [[:move-1 {:pp 20 :pp-up 3}] :move-2]
rlm@203 384 ;; default to full pp for the move, with no
rlm@203 385 ;; pp-ups.
rlm@203 386 ((fn [pokemon]
rlm@203 387 (let [moves (:moves pokemon)]
rlm@203 388 (assoc pokemon :moves
rlm@203 389 (for [move moves]
rlm@203 390 (cond
rlm@203 391 (keyword? move)
rlm@327 392 [move {:current-pp (max-pp move 3) :pp-ups 3}]
rlm@203 393 (vector? move)
rlm@203 394 [(first move)
rlm@327 395 (merge {:current-pp (max-pp (first move) 3)
rlm@327 396 :pp-ups 3} (second move))]))))))
rlm@206 397 ;; The game stores the pokemon's type redundantly
rlm@206 398 ;; along with the species. If it's not specified
rlm@206 399 ;; then it should default to that species default type.
rlm@206 400 ((fn [pokemon]
rlm@206 401 (if (nil? (:type pokemon))
rlm@206 402 (assoc pokemon :type
rlm@206 403 (pokemon->type (:species pokemon)))
rlm@208 404 pokemon)))))
rlm@208 405
rlm@237 406 (def mint-berry-item-code-gsc 0x54)
rlm@237 407
rlm@209 408 (defn give-pokemon
rlm@209 409 ([^SaveState state poke-num pokemon]
rlm@209 410 (let [pokemon* (expand-pokemon pokemon)]
rlm@209 411 (-> state
rlm@209 412 ;; expand roster if necessary
rlm@209 413 ((fn [state]
rlm@209 414 (if (< (dec (party-number state)) poke-num)
rlm@209 415 (set-party-number state (inc poke-num)) state)))
rlm@209 416 (rename-pokemon poke-num (:name pokemon*))
rlm@209 417 (give-DV poke-num (:dv pokemon*))
rlm@209 418 (give-type poke-num (:type pokemon*))
rlm@209 419 (set-species poke-num (:species pokemon*))
rlm@209 420 (set-species2 poke-num (:species2 pokemon*))
rlm@209 421 (set-OT-id poke-num (:ID pokemon*))
rlm@209 422 (set-OT-name poke-num (:original-trainer pokemon*))
rlm@209 423 (give-moves-pps poke-num (:moves pokemon*))
rlm@209 424 (give-status poke-num (:status pokemon*))
rlm@209 425 (give-stats poke-num (:stats pokemon*))
rlm@212 426 (give-experience poke-num (:experience pokemon*))
rlm@212 427 (set-memory (+ 0xD16D
rlm@212 428 (* pokemon-record-width poke-num))
rlm@237 429 mint-berry-item-code-gsc))))
rlm@209 430 ([poke-num pokemon]
rlm@212 431 (give-pokemon @current-state poke-num pokemon)))
rlm@212 432
rlm@212 433 (defn edit-pokemon
rlm@212 434 ([^SaveState state poke-num new-pokemon-data]
rlm@212 435 (give-pokemon state poke-num
rlm@212 436 (merge (pokemon state poke-num)
rlm@212 437 new-pokemon-data)))
rlm@212 438 ([poke-num new-pokemon-data]
rlm@212 439 (edit-pokemon @current-state poke-num new-pokemon-data)))
rlm@326 440
rlm@326 441 (defn give-powerful-party
rlm@326 442 ([^SaveState state]
rlm@326 443 (-> state
rlm@326 444 (give-pokemon 0 tauros)
rlm@326 445 (give-pokemon 1 chansey)
rlm@326 446 (give-pokemon 2 alakazam)
rlm@326 447 (give-pokemon 3 golem)
rlm@326 448 (give-pokemon 4 exeggutor)
rlm@326 449 (give-pokemon 5 starmie)
rlm@326 450
rlm@326 451 ))
rlm@326 452 ([] (give-powerful-party @current-state)))