Mercurial > vba-clojure
view clojure/com/aurellem/gb/pokemon.clj @ 208:45f1376b578c
saving progress
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Fri, 23 Mar 2012 04:39:24 -0500 |
parents | 32ac21c9a30d |
children | 912496041f98 |
line wrap: on
line source
1 (ns com.aurellem.gb.pokemon2 (:use (com.aurellem.gb gb-driver util constants characters3 moves types items status dv species4 experience stats5 ))6 (:import [com.aurellem.gb.gb_driver SaveState]))8 (def pokemon-names-start 0xD2B4)10 (defn set-party-number11 ([^SaveState state new-party-num]12 (set-memory state 0xD162 new-party-num))13 ([new-party-num]14 (set-party-number @current-state new-party-num)))16 (def party-number-address 0xD162)18 (defn party-number19 ([^SaveState state]20 (aget (memory state) party-number-address))21 ([] (party-number @current-state)))23 (defn party-names24 ([^SaveState state]25 (let [raw-names26 (subvec (vec (memory state))27 pokemon-names-start28 (+ pokemon-names-start29 (* name-width 6)))]30 (map31 read-name32 (take33 (party-number state)34 (partition name-width35 raw-names)))))36 ([] (party-names @current-state)))38 (defn pokemon-nickname39 ([^SaveState state poke-num]40 (nth (party-names state) poke-num))41 ([poke-num]42 (pokemon-nickname @current-state poke-num)))44 (defn rename-pokemon45 ([^SaveState state n new-name]46 (assert (<= 0 n (dec (party-number state))))47 (assert (<= (count new-name) max-name-length))48 (set-memory-range49 state50 (+ (* n name-width) pokemon-names-start)51 (concat (str->character-codes new-name) [end-of-name-marker])))52 ([n new-name]53 (rename-pokemon @current-state n new-name)))55 (def OT-start 0xD272)57 (defn original-trainers58 ([^SaveState state]59 (let [raw-names60 (subvec (vec (memory state))61 OT-start62 (+ OT-start63 (* name-width 6)))]64 (map read-name65 (take (party-number state)66 (partition name-width raw-names)))))67 ([] (original-trainers @current-state)))69 (defn read-OT-name70 ([^SaveState state poke-num]71 (nth (original-trainers state) poke-num))72 ([poke-num] (read-OT @current-state poke-num)))74 (defn set-OT-name75 "Set the OT name for a pokemon.76 Note that a pokemon is still considered 'yours' if77 the OT ID is the same as your own."78 ([^SaveState state poke-num new-name]79 (assert (<= 0 poke-num (dec (party-number state))))80 (assert (<= (count new-name) max-name-length))81 (set-memory-range82 state83 (+ (* poke-num name-width) OT-start)84 (concat (str->character-codes new-name) [end-of-name-marker])))85 ([n new-name]86 (set-original-trainer @current-state n new-name)))88 (def OT-ID-addresses [0xD176 0xD1A2 0xD1CE 0xD1FA 0xD226 0xD252])90 (defn read-OT-id91 ([^SaveState state poke-num]92 (let [mem (memory state)93 start (OT-ID-addresses poke-num)]94 (glue-bytes95 (aget mem start)96 (aget mem (inc start)))))97 ([poke-num] (read-OT-id @current-state poke-num)))99 (defn set-OT-id100 ([^SaveState state poke-num new-OT-num]101 (assert (<= 0 poke-num 5))102 (assert (<= 0 new-OT-num 0xFFFF))103 (set-memory-range104 state105 (OT-ID-addresses poke-num)106 (disect-bytes-2 new-OT-num)))107 ([poke-num new-OT-num]108 (set-pokemon-id @current-state poke-num new-OT-num)))110 (def unknown "[[[UNKNOWN]]]")112 (def unknown "")114 (def pokemon-1-record115 {0xD16A "Color Map" ;; 0116 0xD16B "Current-HP (h)" ;; 1117 0xD16C "Current-HP (l)" ;; 2118 0XD16D "Unused" ;; 3119 0xD16E "Status" ;; 4120 0xD16F "Type 1" ;; 5121 0xD170 "Type 2" ;; 6122 0xD171 "scratch/C.R." ;; 7123 0xD172 "Move 1 ID" ;; 8124 0xD173 "Move 2 ID" ;; 9125 0xD174 "Move 3 ID" ;; 10126 0xD175 "Move 4 ID" ;; 11127 0xD176 "OT-ID (h)" ;; 12128 0xD177 "OT-ID (l)" ;; 13129 0xD178 "Exp. Points (h)" ;; 14130 0xD179 "Exp. Points (m)" ;; 15131 0xD17A "Exp. Points (l)" ;; 16132 0xD17B "HP Exp. (h)" ;; 17133 0xD17C "HP Exp. (l)" ;; 18134 0xD17D "Attack Exp. (h)" ;; 19135 0xD17E "Attack Exp. (l)" ;; 20136 0xD17F "Defense Exp. (h)" ;; 21137 0xD180 "Defense Exp. (l)" ;; 22138 0xD181 "Speed Exp. (h)" ;; 23139 0xD182 "Speed Exp. (l)" ;; 24140 0xD183 "Special Exp. (h)" ;; 25141 0xD184 "Special Exp. (l)" ;; 26142 0xD185 "DV Atk/Def" ;; 27143 0xD186 "DV Speed/Spc" ;; 28144 0xD187 "PP Move 1" ;; 29145 0xD188 "PP Move 2" ;; 30146 0xD189 "PP Move 3" ;; 31147 0xD18A "PP Move 4" ;; 32148 0xD18B "Current Level" ;; 33149 0xD18C "HP Total (h)" ;; 34150 0xD18D "HP Total (l)" ;; 35151 0xD18E "Attack (h)" ;; 36152 0xD18F "Attack (l)" ;; 37153 0xD190 "Defense (h)" ;; 38154 0xD191 "Defense (l)" ;; 39155 0xD192 "Speed (h)" ;; 40156 0xD193 "Speed (l)" ;; 41157 0xD194 "Special (h)" ;; 42158 0xD195 "Special (l)" ;; 43159 })161 (defn pokemon-record162 ([^SaveState state pokemon-num]163 (assert (<= 0 pokemon-num 5))164 (let [base (+ (* pokemon-num pokemon-record-width) 0xD16A)]165 (subvec (vec (memory state)) base166 (+ base pokemon-record-width))))167 ([pokemon-num] (pokemon-record @current-state pokemon-num)))169 (defn set-pokemon-record170 ([^SaveState state pokemon-num new-data]171 (assert (<= 0 pokemon-num 5))172 (let [base (+ (* pokemon-num pokemon-record-width) 0xD16A)]173 (set-memory-range state base new-data)))174 ([pokemon-num new-data]175 (set-pokemon-record @current-state pokemon-num new-data)))177 (defn print-pokemon-record178 ([^SaveState state pokemon-num]179 (assert (<= 0 pokemon-num 5))180 (let [poke-data (pokemon-record state pokemon-num)181 backbone (sort (keys pokemon-1-record))]182 (println "Pokemon " pokemon-num " -- "183 (nth (party-names state)184 pokemon-num) \newline)186 (println " Desc. | Hex | Dec | Binary |")187 (println "-------------------+------+-----+----------+")188 (dorun189 (map190 (comp println191 (fn [desc data]192 (format "%-16s | 0x%02X | %3d | %s |"193 desc data data194 (let [s (Integer/toBinaryString data)]195 (apply196 str197 (concat (repeat (- 8 (count s)) "0" )198 s))))))199 (map pokemon-1-record backbone)200 poke-data))))201 ([pokemon-num]202 (print-pokemon-record @current-state pokemon-num)))204 (def mint-berry-item-code-gsc 0x54)206 (defn pokemon-info207 ([^SaveState state poke-num]208 (assert (<= 0 poke-num 5))209 (let [dv-values (read-DV state poke-num)210 type (read-type state poke-num)211 species (read-species state poke-num)212 species2 (read-species2 state poke-num)213 moves (read-moves state poke-num)214 moves-pp (mapv (partial read-pp state215 poke-num)216 (range (count moves)))217 nickname (pokemon-nickname state poke-num)218 status (read-status state poke-num)219 stats (read-stats state poke-num)220 experience (read-experience state poke-num)221 OT-name (read-OT-name state poke-num)222 ID (read-OT-id state poke-num)]223 {;; persistent224 :name nickname225 :species species226 :species2 species2227 :type type228 :dv dv-values229 :original-trainer OT-name230 :ID ID231 :moves (mapv vector moves moves-pp)233 ;; ephemerial234 :status status235 :stats stats236 :experience experience237 }))238 ([poke-num]239 (pokemon-info @current-state poke-num)))241 (def status-message242 {:sleep-6 "sleeping. It will wake in six turns."243 :sleep-5 "sleeping. It will wake in five turns."244 :sleep-4 "sleeping. It will wake in four turns."245 :sleep-3 "sleeping. It will wake in three turns."246 :sleep-2 "sleeping. It will wake in two turns."247 :sleep-1 "sleeping. It will wake in one turn."248 :poisoned "poisoned."249 :frozen "frozen solid."250 :burned "burned."251 :paralyzed "paralyzed."})254 (defn print-pokemon255 ([^SaveState state poke-num]256 (let [info (pokemon-info state poke-num)]257 (printf258 (str259 "##################################"260 "##################################\n"261 "# "262 " #\n"263 "# %-44s"264 "%-20s#\n"265 "# "266 " #\n"267 "##################################"268 "##################################\n\n")270 (str271 (:name info)272 (str273 " [" (.toUpperCase274 (.substring (str (:species info)) 1)) "]")275 (str " Lvl." (format "%-3d" (:level (:stats info)))))276 (str (:original-trainer info) " / " (:ID info)))278 (println279 (str280 (str "-----------------------------------"281 "---------------------------------\n" )282 (str "| Stats | HP | Attack "283 "| Defense | Speed | Special |\n")284 (str "+-----------+----------+----------"285 "+----------+----------+----------+")))287 (printf288 (str "|%-11s| %5d | %5d "289 "| %5d | %5d | %5d |\n")290 "DV Values" (:hp (:dv info)) (:attack (:dv info))291 (:defense (:dv info)) (:speed (:dv info))292 (:special (:dv info)))294 (let [c (:stats info)]295 (printf296 (str "|%-11s|%8s | %5d "297 "| %5d | %5d | %5d |\n")298 "Current" (str (:current-hp c) "/" (:hp c)) (:attack c)299 (:defense c) (:speed c)300 (:special c)))302 (let [e (:experience info)]303 (printf304 (str "|%-11s| %5d | %5d "305 "| %5d | %5d | %5d |\n")306 "Experience" (:hp-exp e) (:attack-exp e)307 (:defense-exp e) (:speed-exp e)308 (:special-exp e)))309 (println310 (str "+-----------+----------+----------"311 "+----------+----------+----------+"))313 (print "\n")314 (println "+------------------+----+--------+--------+")315 (println "| Move | PP | Max PP | PP UPs |")316 (println "+------------------+----+--------+--------+")318 (dorun319 (for [[name {:keys [pp-ups current-pp]}] (:moves info)]320 (printf321 "| %-17s| %2d | %02d | %02d |\n"322 (.substring (str name) 1)323 current-pp (max-pp name pp-ups) pp-ups)))325 (println "+------------------+----+--------+--------+\n")327 (println "Total Experience:" (:main-exp (:experience info)))328 (if (not= :normal (:status info))329 (println "\n* This pokemon is currently"330 (status-message (:status info))))331 (if (not= (:species info) (:species2 info))332 (println "\n* This pokemon has a secondary species"333 (str334 "("335 (.substring (str (:species2 info)) 1) ")\n")336 " that does not match its primary species."))337 (if (not= (:type info) (pokemon->type (:species info)))338 (println "\n* This pokemon has a type"339 (str (:type info))340 "which \n"341 " is inconsistent with the default type for its"342 "species."))))343 ([poke-num]344 (print-pokemon @current-state poke-num)))346 (defn print-team []347 (dorun (map print-pokemon (range (party-number)))))350 (defn give-status-all351 ([^SaveState state status]352 (reduce (fn [state num]353 (give-status state num status))354 state355 (range (party-number state))))356 ([status]357 (give-status-all @current-state status)))360 (def pokemon-base361 {:dv {:attack 15 :hp 15 :defense 15362 :special 15 :speed 15}363 :species :ditto364 :original-trainer "RLM"365 :ID 5195366 :status :normal367 :experience368 {:main-exp 500369 :attack-exp 0xFFFF370 :defense-exp 0xFFFF371 :speed-exp 0xFFFF372 :special-exp 0xFFFF373 :hp-exp 0xFFFF}375 :stats376 ;; TODO recalculate these from a real ditto377 {:level 7378 :current-hp 50379 :hp 50380 :attack 50381 :defense 50382 :speed 50383 :special 50}384 :moves [[:transform {:pp-up 3 :pp 5}]]})386 (defn expand-pokemon387 "Given a map describing a pokemon, fill in any missing388 values based on the ones already present."389 [pokemon]390 (-> (merge pokemon-base pokemon)391 ;; if no nickname is supplied, default to the392 ;; uppercase name of the species, as r/b/y do393 ;; when a pokemon is captured.394 ((fn [pokemon]395 (if (nil? (:name pokemon))396 (assoc pokemon :name (.toUpperCase397 (.substring398 (str (:species pokemon)) 1)))399 pokemon)))400 ;; species2 should almost always just be the401 ;; same as species.402 ((fn [pokemon]403 (if (nil? (:species2 pokemon))404 (assoc pokemon :species2 (:species pokemon)))))406 ;; enable the date in :moves to be any combo of407 ;; [:move-1 :move-2]408 ;; [[:move-1 {:pp 20}] :move-2]409 ;; [[:move-1 {:pp 20 :pp-up 3}] :move-2]410 ;; default to full pp for the move, with no411 ;; pp-ups.412 ((fn [pokemon]413 (let [moves (:moves pokemon)]414 (assoc pokemon :moves415 (for [move moves]416 (cond417 (keyword? move)418 [move {:pp (max-pp move) :pp-up 0}]419 (vector? move)420 [(first move)421 (merge {:pp (max-pp (first move) 0)422 :pp-up 0} (second move))]))))))423 ;; The game stores the pokemon's type redundantly424 ;; along with the species. If it's not specified425 ;; then it should default to that species default type.426 ((fn [pokemon]427 (if (nil? (:type pokemon))428 (assoc pokemon :type429 (pokemon->type (:species pokemon)))430 pokemon)))))