view clojure/com/aurellem/gb/pokemon.clj @ 197:659764a2ea40

break for eating!
author Robert McIntyre <rlm@mit.edu>
date Fri, 23 Mar 2012 00:14:37 -0500
parents 8dd17081829f
children 1e2aa688e6e4
line wrap: on
line source
1 (ns com.aurellem.gb.pokemon
2 (:use (com.aurellem.gb gb-driver util constants characters
3 moves types items status dv species
4 experience stats
5 ))
6 (:import [com.aurellem.gb.gb_driver SaveState]))
8 (def pokemon-names-start 0xD2B4)
10 (defn set-party-number
11 ([^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-number
19 ([^SaveState state]
20 (aget (memory state) party-number-address))
21 ([] (party-number @current-state)))
23 (defn party-names
24 ([^SaveState state]
25 (let [raw-names
26 (subvec (vec (memory state))
27 pokemon-names-start
28 (+ pokemon-names-start
29 (* name-width 6)))]
30 (map
31 read-name
32 (take
33 (party-number state)
34 (partition name-width
35 raw-names)))))
36 ([] (party-names @current-state)))
38 (defn pokemon-nickname
39 ([^SaveState state poke-num]
40 (nth (party-names state) poke-num))
41 ([poke-num]
42 (pokemon-nickname @current-state poke-num)))
44 (defn rename-pokemon
45 ([^SaveState state n new-name]
46 (assert (<= 0 n (dec (party-number state))))
47 (assert (<= (count new-name) max-name-length))
48 (set-memory-range
49 state
50 (+ (* 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-trainers
58 ([^SaveState state]
59 (let [raw-names
60 (subvec (vec (memory state))
61 OT-start
62 (+ OT-start
63 (* name-width 6)))]
64 (map read-name
65 (take (party-number state)
66 (partition name-width raw-names)))))
67 ([] (original-trainers @current-state)))
69 (defn read-OT-name
70 ([^SaveState state poke-num]
71 (nth (original-trainers state) poke-num))
72 ([poke-num] (read-OT @current-state poke-num)))
74 (defn set-OT-name
75 "Set the OT name for a pokemon.
76 Note that a pokemon is still considered 'yours' if
77 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-range
82 state
83 (+ (* 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-id
91 ([^SaveState state poke-num]
92 (let [mem (memory state)
93 start (OT-ID-addresses poke-num)]
94 (glue-bytes
95 (aget mem start)
96 (aget mem (inc start)))))
97 ([poke-num] (read-OT-id @current-state poke-num)))
99 (defn set-OT-id
100 ([^SaveState state poke-num new-OT-num]
101 (assert (<= 0 poke-num 5))
102 (assert (<= 0 new-OT-num 0xFFFF))
103 (set-memory-range
104 state
105 (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-record
115 {0xD16A "Color Map" ;; 0
116 0xD16B "Current-HP (h)" ;; 1
117 0xD16C "Current-HP (l)" ;; 2
118 0XD16D "Unused" ;; 3
119 0xD16E "Status" ;; 4
120 0xD16F "Type 1" ;; 5
121 0xD170 "Type 2" ;; 6
122 0xD171 "scratch/C.R." ;; 7
123 0xD172 "Move 1 ID" ;; 8
124 0xD173 "Move 2 ID" ;; 9
125 0xD174 "Move 3 ID" ;; 10
126 0xD175 "Move 4 ID" ;; 11
127 0xD176 "OT-ID (h)" ;; 12
128 0xD177 "OT-ID (l)" ;; 13
129 0xD178 "Exp. Points (h)" ;; 14
130 0xD179 "Exp. Points (m)" ;; 15
131 0xD17A "Exp. Points (l)" ;; 16
132 0xD17B "HP Exp. (h)" ;; 17
133 0xD17C "HP Exp. (l)" ;; 18
134 0xD17D "Attack Exp. (h)" ;; 19
135 0xD17E "Attack Exp. (l)" ;; 20
136 0xD17F "Defense Exp. (h)" ;; 21
137 0xD180 "Defense Exp. (l)" ;; 22
138 0xD181 "Speed Exp. (h)" ;; 23
139 0xD182 "Speed Exp. (l)" ;; 24
140 0xD183 "Special Exp. (h)" ;; 25
141 0xD184 "Special Exp. (l)" ;; 26
142 0xD185 "DV Atk/Def" ;; 27
143 0xD186 "DV Speed/Spc" ;; 28
144 0xD187 "PP Move 1" ;; 29
145 0xD188 "PP Move 2" ;; 30
146 0xD189 "PP Move 3" ;; 31
147 0xD18A "PP Move 4" ;; 32
148 0xD18B "Current Level" ;; 33
149 0xD18C "HP Total (h)" ;; 34
150 0xD18D "HP Total (l)" ;; 35
151 0xD18E "Attack (h)" ;; 36
152 0xD18F "Attack (l)" ;; 37
153 0xD190 "Defense (h)" ;; 38
154 0xD191 "Defense (l)" ;; 39
155 0xD192 "Speed (h)" ;; 40
156 0xD193 "Speed (l)" ;; 41
157 0xD194 "Special (h)" ;; 42
158 0xD195 "Special (l)" ;; 43
159 })
161 (defn pokemon-record
162 ([^SaveState state pokemon-num]
163 (assert (<= 0 pokemon-num 5))
164 (let [base (+ (* pokemon-num pokemon-record-width) 0xD16A)]
165 (subvec (vec (memory state)) base
166 (+ base pokemon-record-width))))
167 ([pokemon-num] (pokemon-record @current-state pokemon-num)))
169 (defn set-pokemon-record
170 ([^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-record
178 ([^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 (dorun
189 (map
190 (comp println
191 (fn [desc data]
192 (format "%-16s | 0x%02X | %3d | %s |"
193 desc data data
194 (let [s (Integer/toBinaryString data)]
195 (apply
196 str
197 (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-info
207 ([^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 state
215 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 {;; persistent
224 :name nickname
225 :species species
226 :species2 species2
227 :type type
228 :dv dv-values
229 :original-trainer OT-name
230 :ID ID
231 :moves (mapv vector moves moves-pp)
233 ;; ephemerial
234 :satus status
235 :stats stats
236 :experience experience
237 }))
238 ([poke-num]
239 (pokemon-info @current-state poke-num)))
241 (defn print-pokemon
242 ([^SaveState state poke-num]
243 (let [info (pokemon-info state poke-num)]
244 (printf
245 (str
246 "##################################"
247 "##################################\n"
248 "# "
249 " #\n"
250 "# %-44s"
251 "%-20s#\n"
252 "# "
253 " #\n"
254 "##################################"
255 "##################################\n\n")
257 (str
258 (:name info)
259 (str
260 " (" (.substring (str (:species info)) 1) ")")
261 (str " Lvl." (format "%-3d" (:level (:stats info)))))
262 (str (:original-trainer info) " / " (:ID info)))
264 (println
265 (str
266 (str "-----------------------------------"
267 "---------------------------------\n" )
268 (str "| Stats | HP | Attack "
269 "| Defense | Speed | Special |\n")
270 (str "+-----------+----------+----------"
271 "+----------+----------+----------+")))
273 (printf
274 (str "|%-11s| %5d | %5d "
275 "| %5d | %5d | %5d |\n")
276 "DV Values" (:hp (:dv info)) (:attack (:dv info))
277 (:defense (:dv info)) (:speed (:dv info))
278 (:special (:dv info)))
280 (let [c (:stats info)]
281 (printf
282 (str "|%-11s| %5d | %5d "
283 "| %5d | %5d | %5d |\n")
284 "Current" (:hp c) (:attack c)
285 (:defense c) (:speed c)
286 (:special c)))
288 (let [e (:experience info)]
289 (printf
290 (str "|%-11s| %5d | %5d "
291 "| %5d | %5d | %5d |\n")
292 "Experience" (:hp-exp e) (:attack-exp e)
293 (:defense-exp e) (:speed-exp e)
294 (:special-exp e)))
295 (println
296 (str "+-----------+----------+----------"
297 "+----------+----------+----------+"))
299 (print "\n")
300 (println "+------------------+----+--------+--------+")
301 (println "| Move | PP | Max PP | PP UPs |")
302 (println "+------------------+----+--------+--------+")
304 (dorun
305 (for [[name {:keys [pp-ups current-pp]}] (:moves info)]
306 (printf
307 "| %-17s| %2d | %02d | %02d |\n"
308 (.substring (str name) 1)
309 current-pp (max-pp name pp-ups) pp-ups)))
311 (println "+------------------+----+--------+--------+")
316 ))
317 ([poke-num]
318 (print-pokemon @current-state poke-num)))
320 (defn give-status-all
321 ([^SaveState state status]
322 (reduce (fn [state num]
323 (give-status state num status))
324 state
325 (range (party-number state))))
326 ([status]
327 (give-status-all @current-state status)))