Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/pokemon.clj @ 185:c8ec477beeac

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