Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/pokemon.clj @ 176:95b2758dd517

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
wrote functions to read and write pokemon DV values and status
author Robert McIntyre <rlm@mit.edu>
date Wed, 21 Mar 2012 22:13:43 -0500
parents
children 8d9e2804af9b
rev   line source
rlm@176 1 (ns com.aurellem.gb.pokemon
rlm@176 2 (:use (com.aurellem.gb gb-driver util constants characters))
rlm@176 3 (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@176 4
rlm@176 5 (def pokemon-names-start 0xD2B4)
rlm@176 6
rlm@176 7 (defn change-party-number [^SaveState state new-num]
rlm@176 8 (set-memory state 0xD162 new-num))
rlm@176 9
rlm@176 10 (def party-number-address 0xD162)
rlm@176 11
rlm@176 12 (defn party-number
rlm@176 13 ([^SaveState state]
rlm@176 14 (aget (memory state) party-number-address))
rlm@176 15 ([] (party-number @current-state)))
rlm@176 16
rlm@176 17 (defn party-names
rlm@176 18 ([^SaveState state]
rlm@176 19 (let [raw-names
rlm@176 20 (subvec (vec (memory state))
rlm@176 21 pokemon-names-start
rlm@176 22 (+ pokemon-names-start
rlm@176 23 (* name-width 6)))]
rlm@176 24 (map
rlm@176 25 read-name
rlm@176 26 (take
rlm@176 27 (party-number state)
rlm@176 28 (partition name-width
rlm@176 29 raw-names)))))
rlm@176 30 ([] (party-names @current-state)))
rlm@176 31
rlm@176 32 (defn rename-pokemon
rlm@176 33 ([^SaveState state n new-name]
rlm@176 34 (assert (<= 0 n (dec (party-number state))))
rlm@176 35 (assert (<= (count new-name) max-name-length))
rlm@176 36 (set-memory-range
rlm@176 37 state
rlm@176 38 (+ (* n name-width) pokemon-names-start)
rlm@176 39 (concat (str->character-codes new-name) [end-of-name-marker])))
rlm@176 40 ([n new-name]
rlm@176 41 (rename-pokemon @current-state n new-name)))
rlm@176 42
rlm@176 43 (def OT-start 0xD272)
rlm@176 44
rlm@176 45 (defn original-trainers
rlm@176 46 ([^SaveState state]
rlm@176 47 (let [raw-names
rlm@176 48 (subvec (vec (memory state))
rlm@176 49 OT-start
rlm@176 50 (+ OT-start
rlm@176 51 (* name-width 6)))]
rlm@176 52 (map read-name
rlm@176 53 (take (party-number state)
rlm@176 54 (partition name-width raw-names)))))
rlm@176 55 ([] (original-trainers @current-state)))
rlm@176 56
rlm@176 57 (defn set-original-trainer
rlm@176 58 "Set the OT name for a pokemon.
rlm@176 59 Note that a pokemon is still considered 'yours' if
rlm@176 60 the OT ID is the same as your own."
rlm@176 61 ([^SaveState state poke-num new-name]
rlm@176 62 (assert (<= 0 poke-num (dec (party-number state))))
rlm@176 63 (assert (<= (count new-name) max-name-length))
rlm@176 64 (set-memory-range
rlm@176 65 state
rlm@176 66 (+ (* poke-num name-width) OT-start)
rlm@176 67 (concat (str->character-codes new-name) [end-of-name-marker])))
rlm@176 68 ([n new-name]
rlm@176 69 (set-original-trainer @current-state n new-name)))
rlm@176 70
rlm@176 71 (def OT-ID-addresses [0xD176 0xD1A2 0xD1CE 0xD1FA 0xD228 0xD252])
rlm@176 72
rlm@176 73 (defn set-pokemon-id
rlm@176 74 ([^SaveState state n new-id]
rlm@176 75 (assert (<= 0 n (dec (party-number state))))
rlm@176 76 (assert (<= 0 new-id 0xFFFF))
rlm@176 77 (set-memory-range
rlm@176 78 state
rlm@176 79 (OT-ID-addresses n)
rlm@176 80 [(bit-shift-right (bit-and new-id 0xFF00) 8)
rlm@176 81 (bit-and new-id 0xFF)
rlm@176 82 ]))
rlm@176 83 ([n new-id]
rlm@176 84 (set-pokemon-id @current-state n new-id)))
rlm@176 85
rlm@176 86 (def unknown "[[[UNKNOWN]]]")
rlm@176 87
rlm@176 88 (def unknown "")
rlm@176 89
rlm@176 90 (def pokemon-1-info
rlm@176 91 {0xD16A "Color Map" ;; 0
rlm@176 92 0xD16B "Current-HP (h)" ;; 1
rlm@176 93 0xD16C "Current-HP (l)" ;; 2
rlm@176 94 0XD16D unknown ;; 3
rlm@176 95 0xD16E unknown ;; 4
rlm@176 96 0xD16F unknown ;; 5
rlm@176 97 0xD170 unknown ;; 6
rlm@176 98 0xD171 unknown ;; 7
rlm@176 99 0xD172 "Move 1 ID" ;; 8
rlm@176 100 0xD173 "Move 2 ID" ;; 9
rlm@176 101 0xD174 "Move 3 ID" ;; 10
rlm@176 102 0xD175 "Move 4 ID" ;; 11
rlm@176 103 0xD176 "OT-ID (h)" ;; 12
rlm@176 104 0xD177 "OT-ID (l)" ;; 13
rlm@176 105 0xD178 "Exp. Points (h)" ;; 14
rlm@176 106 0xD179 "Exp. Points (m)" ;; 15
rlm@176 107 0xD17A "Exp. Points (l)" ;; 16
rlm@176 108 0xD17B "HP Exp. (h)" ;; 17
rlm@176 109 0xD17C "HP Exp. (l)" ;; 18
rlm@176 110 0xD17D "Attack Exp. (h)" ;; 19
rlm@176 111 0xD17E "Attack Exp. (l)" ;; 20
rlm@176 112 0xD17F "Defense Exp. (h)" ;; 21
rlm@176 113 0xD180 "Defense Exp. (l)" ;; 22
rlm@176 114 0xD181 "Speed Exp. (h)" ;; 23
rlm@176 115 0xD182 "Speed Exp. (l)" ;; 24
rlm@176 116 0xD183 "Special Exp. (h)" ;; 25
rlm@176 117 0xD184 "Special Exp. (l)" ;; 26
rlm@176 118 0xD185 "DV Atk/Def" ;; 27
rlm@176 119 0xD186 "DV Speed/Spc" ;; 28
rlm@176 120 0xD187 "PP Move 1" ;; 29
rlm@176 121 0xD188 "PP Move 2" ;; 30
rlm@176 122 0xD189 "PP Move 3" ;; 31
rlm@176 123 0xD18A "PP Move 4" ;; 32
rlm@176 124 0xD18B "Current Level" ;; 33
rlm@176 125 0xD18C "HP Total (h)" ;; 34
rlm@176 126 0xD18D "HP Total (l)" ;; 35
rlm@176 127 0xD18E "Attack (h)" ;; 36
rlm@176 128 0xD18F "Attack (l)" ;; 37
rlm@176 129 0xD190 "Defense (h)" ;; 38
rlm@176 130 0xD191 "Defense (l)" ;; 39
rlm@176 131 0xD192 "Speed (h)" ;; 40
rlm@176 132 0xD193 "Speed (l)" ;; 41
rlm@176 133 0xD194 "Special (h)" ;; 42
rlm@176 134 0xD195 "Special (l)" ;; 43
rlm@176 135 })
rlm@176 136
rlm@176 137 (defn pokemon-data
rlm@176 138 ([^SaveState state pokemon-num]
rlm@176 139 (assert (<= 0 pokemon-num 5))
rlm@176 140 (let [base (+ (* pokemon-num pokemon-record-width) 0xD16A)]
rlm@176 141 (subvec (vec (memory state)) base
rlm@176 142 (+ base pokemon-record-width))))
rlm@176 143 ([pokemon-num] (pokemon-data @current-state pokemon-num)))
rlm@176 144
rlm@176 145 (defn set-pokemon-data
rlm@176 146 ([^SaveState state pokemon-num new-data]
rlm@176 147 (assert (<= 0 pokemon-num 5))
rlm@176 148 (let [base (+ (* pokemon-num pokemon-record-width) 0xD16A)]
rlm@176 149 (set-memory-range state base new-data)))
rlm@176 150 ([pokemon-num new-data]
rlm@176 151 (set-pokemon-data @current-state pokemon-num new-data)))
rlm@176 152
rlm@176 153 (defn print-pokemon-data
rlm@176 154 ([^SaveState state pokemon-num]
rlm@176 155 (assert (<= 0 pokemon-num 5))
rlm@176 156 (let [poke-data (pokemon-data state pokemon-num)
rlm@176 157 backbone (sort (keys pokemon-1-info))]
rlm@176 158 (println "Pokemon " pokemon-num " -- "
rlm@176 159 (nth (party-names state)
rlm@176 160 pokemon-num) \newline)
rlm@176 161
rlm@176 162 (println " Desc. | Hex | Dec | Binary |")
rlm@176 163 (println "-------------------+------+-----+----------+")
rlm@176 164 (dorun
rlm@176 165 (map
rlm@176 166 (comp println
rlm@176 167 (fn [desc data]
rlm@176 168 (format "%-16s | 0x%02X | %3d | %s |"
rlm@176 169 desc data data
rlm@176 170 (let [s (Integer/toBinaryString data)]
rlm@176 171 (apply
rlm@176 172 str
rlm@176 173 (concat (repeat (- 8 (count s)) "0" )
rlm@176 174 s))))))
rlm@176 175 (map pokemon-1-info backbone)
rlm@176 176 poke-data))))
rlm@176 177 ([pokemon-num]
rlm@176 178 (print-pokemon-data @current-state pokemon-num)))