Mercurial > vba-clojure

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