Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/pokemon.clj @ 494:79606f173658

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
improbed color display kernel.
author Robert McIntyre <rlm@mit.edu>
date Thu, 07 Jun 2012 23:11:18 -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)))