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

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