view clojure/com/aurellem/gb/pokemon.clj @ 324:7876781520ea

fixed set-cursor so that moving the cursor backwards works
author Robert McIntyre <rlm@mit.edu>
date Wed, 04 Apr 2012 01:04:06 -0500
parents ff37bc3004a7
children 8484e6f6db2c
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 (-> state
13 (set-memory 0xD162 new-party-num)
14 (set-memory (+ 0xD162 new-party-num 1) 0xFF)))
15 ([new-party-num]
16 (set-party-number @current-state new-party-num)))
18 (def party-number-address 0xD162)
20 (defn party-number
21 ([^SaveState state]
22 (aget (memory state) party-number-address))
23 ([] (party-number @current-state)))
25 (defn party-names
26 ([^SaveState state]
27 (let [raw-names
28 (subvec (vec (memory state))
29 pokemon-names-start
30 (+ pokemon-names-start
31 (* name-width 6)))]
32 (map
33 read-name
34 (take
35 (party-number state)
36 (partition name-width
37 raw-names)))))
38 ([] (party-names @current-state)))
40 (defn pokemon-nickname
41 ([^SaveState state poke-num]
42 (nth (party-names state) poke-num))
43 ([poke-num]
44 (pokemon-nickname @current-state poke-num)))
46 (defn rename-pokemon
47 ([^SaveState state n new-name]
48 (assert (<= 0 n (dec (party-number state))))
49 (assert (<= (count new-name) max-name-length))
50 (set-memory-range
51 state
52 (+ (* n name-width) pokemon-names-start)
53 (concat (str->character-codes new-name) [end-of-name-marker])))
54 ([n new-name]
55 (rename-pokemon @current-state n new-name)))
57 (def OT-start 0xD272)
59 (defn original-trainers
60 ([^SaveState state]
61 (let [raw-names
62 (subvec (vec (memory state))
63 OT-start
64 (+ OT-start
65 (* name-width 6)))]
66 (map read-name
67 (take (party-number state)
68 (partition name-width raw-names)))))
69 ([] (original-trainers @current-state)))
71 (defn read-OT-name
72 ([^SaveState state poke-num]
73 (nth (original-trainers state) poke-num))
74 ([poke-num] (read-OT-name @current-state poke-num)))
76 (defn set-OT-name
77 "Set the OT name for a pokemon.
78 Note that a pokemon is still considered 'yours' if
79 the OT ID is the same as your own."
80 ([^SaveState state poke-num new-name]
81 (assert (<= 0 poke-num (dec (party-number state))))
82 (assert (<= (count new-name) max-name-length))
83 (set-memory-range
84 state
85 (+ (* poke-num name-width) OT-start)
86 (concat (str->character-codes new-name) [end-of-name-marker])))
87 ([n new-name]
88 (set-OT-name @current-state n new-name)))
90 (def OT-ID-addresses [0xD176 0xD1A2 0xD1CE 0xD1FA 0xD226 0xD252])
92 (defn read-OT-id
93 ([^SaveState state poke-num]
94 (let [mem (memory state)
95 start (OT-ID-addresses poke-num)]
96 (glue-bytes
97 (aget mem start)
98 (aget mem (inc start)))))
99 ([poke-num] (read-OT-id @current-state poke-num)))
101 (defn set-OT-id
102 ([^SaveState state poke-num new-OT-num]
103 (assert (<= 0 poke-num 5))
104 (assert (<= 0 new-OT-num 0xFFFF))
105 (set-memory-range
106 state
107 (OT-ID-addresses poke-num)
108 (disect-bytes-2 new-OT-num)))
109 ([poke-num new-OT-num]
110 (set-OT-id @current-state poke-num new-OT-num)))
112 (def unknown "[[[UNKNOWN]]]")
114 (def unknown "")
116 (def pokemon-1-record
117 {0xD16A "Color Map" ;; 0
118 0xD16B "Current-HP (h)" ;; 1
119 0xD16C "Current-HP (l)" ;; 2
120 0XD16D "Unused" ;; 3
121 0xD16E "Status" ;; 4
122 0xD16F "Type 1" ;; 5
123 0xD170 "Type 2" ;; 6
124 0xD171 "scratch/C.R." ;; 7
125 0xD172 "Move 1 ID" ;; 8
126 0xD173 "Move 2 ID" ;; 9
127 0xD174 "Move 3 ID" ;; 10
128 0xD175 "Move 4 ID" ;; 11
129 0xD176 "OT-ID (h)" ;; 12
130 0xD177 "OT-ID (l)" ;; 13
131 0xD178 "Exp. Points (h)" ;; 14
132 0xD179 "Exp. Points (m)" ;; 15
133 0xD17A "Exp. Points (l)" ;; 16
134 0xD17B "HP Exp. (h)" ;; 17
135 0xD17C "HP Exp. (l)" ;; 18
136 0xD17D "Attack Exp. (h)" ;; 19
137 0xD17E "Attack Exp. (l)" ;; 20
138 0xD17F "Defense Exp. (h)" ;; 21
139 0xD180 "Defense Exp. (l)" ;; 22
140 0xD181 "Speed Exp. (h)" ;; 23
141 0xD182 "Speed Exp. (l)" ;; 24
142 0xD183 "Special Exp. (h)" ;; 25
143 0xD184 "Special Exp. (l)" ;; 26
144 0xD185 "DV Atk/Def" ;; 27
145 0xD186 "DV Speed/Spc" ;; 28
146 0xD187 "PP Move 1" ;; 29
147 0xD188 "PP Move 2" ;; 30
148 0xD189 "PP Move 3" ;; 31
149 0xD18A "PP Move 4" ;; 32
150 0xD18B "Current Level" ;; 33
151 0xD18C "HP Total (h)" ;; 34
152 0xD18D "HP Total (l)" ;; 35
153 0xD18E "Attack (h)" ;; 36
154 0xD18F "Attack (l)" ;; 37
155 0xD190 "Defense (h)" ;; 38
156 0xD191 "Defense (l)" ;; 39
157 0xD192 "Speed (h)" ;; 40
158 0xD193 "Speed (l)" ;; 41
159 0xD194 "Special (h)" ;; 42
160 0xD195 "Special (l)" ;; 43
161 })
163 (defn pokemon-record
164 ([^SaveState state pokemon-num]
165 (assert (<= 0 pokemon-num 5))
166 (let [base (+ (* pokemon-num pokemon-record-width) 0xD16A)]
167 (subvec (vec (memory state)) base
168 (+ base pokemon-record-width))))
169 ([pokemon-num] (pokemon-record @current-state pokemon-num)))
171 (defn set-pokemon-record
172 ([^SaveState state pokemon-num new-data]
173 (assert (<= 0 pokemon-num 5))
174 (let [base (+ (* pokemon-num pokemon-record-width) 0xD16A)]
175 (set-memory-range state base new-data)))
176 ([pokemon-num new-data]
177 (set-pokemon-record @current-state pokemon-num new-data)))
179 (defn print-pokemon-record
180 ([^SaveState state pokemon-num]
181 (assert (<= 0 pokemon-num 5))
182 (let [poke-data (pokemon-record state pokemon-num)
183 backbone (sort (keys pokemon-1-record))]
184 (println "Pokemon " pokemon-num " -- "
185 (nth (party-names state)
186 pokemon-num) \newline)
188 (println " Desc. | Hex | Dec | Binary |")
189 (println "-------------------+------+-----+----------+")
190 (dorun
191 (map
192 (comp println
193 (fn [desc data]
194 (format "%-16s | 0x%02X | %3d | %s |"
195 desc data data
196 (let [s (Integer/toBinaryString data)]
197 (apply
198 str
199 (concat (repeat (- 8 (count s)) "0" )
200 s))))))
201 (map pokemon-1-record backbone)
202 poke-data))))
203 ([pokemon-num]
204 (print-pokemon-record @current-state pokemon-num)))
206 (defn pokemon
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 :status status
235 :stats stats
236 :experience experience
237 }))
238 ([poke-num]
239 (pokemon @current-state poke-num)))
241 (def status-message
242 {: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-pokemon
255 ([^SaveState state poke-num]
256 (let [info (pokemon state poke-num)]
257 (printf
258 (str
259 "##################################"
260 "##################################\n"
261 "# "
262 " #\n"
263 "# %-44s"
264 "%-20s#\n"
265 "# "
266 " #\n"
267 "##################################"
268 "##################################\n\n")
270 (str
271 (:name info)
272 (str
273 " [" (.toUpperCase
274 (.substring (str (:species info)) 1)) "]")
275 (str " Lvl." (format "%-3d" (:level (:stats info)))))
276 (str (:original-trainer info) " / " (:ID info)))
278 (println
279 (str
280 (str "-----------------------------------"
281 "---------------------------------\n" )
282 (str "| Stats | HP | Attack "
283 "| Defense | Speed | Special |\n")
284 (str "+-----------+----------+----------"
285 "+----------+----------+----------+")))
287 (printf
288 (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 (printf
296 (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 (printf
304 (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 (println
310 (str "+-----------+----------+----------"
311 "+----------+----------+----------+"))
313 (print "\n")
314 (println "+------------------+----+--------+--------+")
315 (println "| Move | PP | Max PP | PP UPs |")
316 (println "+------------------+----+--------+--------+")
318 (dorun
319 (for [[name {:keys [pp-ups current-pp]}] (:moves info)]
320 (printf
321 "| %-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 (str
334 "("
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-all
351 ([^SaveState state status]
352 (reduce (fn [state num]
353 (give-status state num status))
354 state
355 (range (party-number state))))
356 ([status]
357 (give-status-all @current-state status)))
360 (def pokemon-base
361 {:dv {:attack 15 :hp 15 :defense 15
362 :special 15 :speed 15}
363 :species :ditto
364 :original-trainer "RLM"
365 :ID 5195
366 :status :normal
367 :experience
368 {:main-exp 500
369 :attack-exp 0xFFFF
370 :defense-exp 0xFFFF
371 :speed-exp 0xFFFF
372 :special-exp 0xFFFF
373 :hp-exp 0xFFFF}
375 :stats
376 {:level 7
377 :current-hp 30
378 :hp 30
379 :attack 18
380 :defense 18
381 :speed 18
382 :special 18}
383 :moves [[:transform {:pp-ups 0 :current-pp 5}]]})
385 (defn expand-pokemon
386 "Given a map describing a pokemon, fill in any missing
387 values based on the ones already present."
388 [pokemon]
389 (-> (merge pokemon-base pokemon)
390 ;; if no nickname is supplied, default to the
391 ;; uppercase name of the species, as r/b/y do
392 ;; when a pokemon is captured.
393 ((fn [pokemon]
394 (if (nil? (:name pokemon))
395 (assoc pokemon :name (.toUpperCase
396 (.substring
397 (str (:species pokemon)) 1)))
398 pokemon)))
399 ;; species2 should almost always just be the
400 ;; same as species.
401 ((fn [pokemon]
402 (if (nil? (:species2 pokemon))
403 (assoc pokemon :species2 (:species pokemon))
404 pokemon)))
406 ;; enable the date in :moves to be any combo of
407 ;; [: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 no
411 ;; pp-ups.
412 ((fn [pokemon]
413 (let [moves (:moves pokemon)]
414 (assoc pokemon :moves
415 (for [move moves]
416 (cond
417 (keyword? move)
418 [move {:current-pp (max-pp move 0) :pp-ups 0}]
419 (vector? move)
420 [(first move)
421 (merge {:current-pp (max-pp (first move) 0)
422 :pp-ups 0} (second move))]))))))
423 ;; The game stores the pokemon's type redundantly
424 ;; along with the species. If it's not specified
425 ;; then it should default to that species default type.
426 ((fn [pokemon]
427 (if (nil? (:type pokemon))
428 (assoc pokemon :type
429 (pokemon->type (:species pokemon)))
430 pokemon)))))
432 (def mint-berry-item-code-gsc 0x54)
434 (defn give-pokemon
435 ([^SaveState state poke-num pokemon]
436 (let [pokemon* (expand-pokemon pokemon)]
437 (-> state
438 ;; expand roster if necessary
439 ((fn [state]
440 (if (< (dec (party-number state)) poke-num)
441 (set-party-number state (inc poke-num)) state)))
442 (rename-pokemon poke-num (:name pokemon*))
443 (give-DV poke-num (:dv pokemon*))
444 (give-type poke-num (:type pokemon*))
445 (set-species poke-num (:species pokemon*))
446 (set-species2 poke-num (:species2 pokemon*))
447 (set-OT-id poke-num (:ID pokemon*))
448 (set-OT-name poke-num (:original-trainer pokemon*))
449 (give-moves-pps poke-num (:moves pokemon*))
450 (give-status poke-num (:status pokemon*))
451 (give-stats poke-num (:stats pokemon*))
452 (give-experience poke-num (:experience pokemon*))
453 (set-memory (+ 0xD16D
454 (* pokemon-record-width poke-num))
455 mint-berry-item-code-gsc))))
456 ([poke-num pokemon]
457 (give-pokemon @current-state poke-num pokemon)))
459 (defn edit-pokemon
460 ([^SaveState state poke-num new-pokemon-data]
461 (give-pokemon state poke-num
462 (merge (pokemon state poke-num)
463 new-pokemon-data)))
464 ([poke-num new-pokemon-data]
465 (edit-pokemon @current-state poke-num new-pokemon-data)))