view clojure/com/aurellem/gb/util.clj @ 521:bad7b7430245

going to work on functions relating to doing the final video, ram-display, sound, etc.
author Robert McIntyre <rlm@mit.edu>
date Sat, 23 Jun 2012 17:45:38 -0500
parents 0b6624c1291c
children 385799ea1e9c
line wrap: on
line source
1 (ns com.aurellem.gb.util
2 (:use (com.aurellem.gb gb-driver vbm constants))
3 (:import java.io.File)
4 (:import [com.aurellem.gb.gb_driver SaveState]))
6 (defn A
7 ([state]
8 (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))
9 ([] (A @current-state)))
11 (defn B [state]
12 (bit-shift-right (bit-and 0x0000FF00 (BC state)) 8))
14 (defn D [state]
15 (bit-shift-right (bit-and 0x0000FF00 (DE state)) 8))
17 (defn H [state]
18 (bit-shift-right (bit-and 0x0000FF00 (HL state)) 8))
20 (defn C [state]
21 (bit-and 0xFF (BC state)))
22 (defn F [state]
23 (bit-and 0xFF (AF state)))
24 (defn E [state]
25 (bit-and 0xFF (DE state)))
26 (defn L [state]
27 (bit-and 0xFF (HL state)))
29 (defn binary-str [num]
30 (format "%08d"
31 (Integer/parseInt
32 (Integer/toBinaryString num) 10)))
34 (defn bit-list
35 "List the bits of n in order of decreasing significance."
36 [n]
37 ((fn this [coll n]
38 (if (zero? n) coll
39 (recur
40 (conj coll (rem n 2))
41 (int (/ n 2)))))
42 [] n))
45 (defn low-high
46 [low high]
47 (+ low (* 256 high)))
50 (defn format-name
51 "Convert the string of alphabetic/space characters into a keyword by
52 replacing spaces with hyphens and converting to lowercase."
53 [s]
54 (if (nil? s) nil
55 (keyword (.toLowerCase
56 (apply str
57 (map #(if (= % \space) "-" %) s))))))
60 ;; used to decode item prices
62 (defn decode-bcd
63 "Take a sequence of binary-coded digits (in written order) and return the number they represent."
64 [digits]
65 ((fn self [coll]
66 (if (empty? coll) 0
67 (+ (first coll) (* 100 (self (rest coll))))))
68 (map
69 #(+ (* 10 (int (/ % 16)))
70 (rem % 16))
71 (reverse digits))))
76 (defn view-register [state name reg-fn]
77 (println (format "%s: %s" name
78 (binary-str (reg-fn state))))
79 state)
81 (defn view-memory
82 ([^SaveState state mem]
83 (let [val (aget (memory state) mem)]
84 (println (format "0x%04X = %s 0x%02X %d" mem
85 (binary-str val) val val)))
86 state)
87 ([mem]
88 (view-memory @current-state mem)))
90 (defn print-listing
91 ([^SaveState state begin end]
92 (dorun (map
93 (fn [opcode line]
94 (println (format "0x%04X: 0x%02X %s %d"
95 line
96 opcode (binary-str opcode)
97 opcode)))
98 (subvec (vec (memory state)) begin end)
99 (range begin end)))
100 state)
101 ([begin end]
102 (print-listing @current-state begin end)))
104 (defn print-pc
105 ([^SaveState state]
106 (println (format "PC: 0x%04X" (PC state)))
107 state)
108 ([] (print-pc @current-state)))
110 (defn print-op
111 ([^SaveState state]
112 (println (format "OP: 0x%02X" (aget (memory state) (PC state))))
113 state)
114 ([] (print-op @current-state)))
116 (defn d-tick
117 ([] (d-tick 1))
118 ([n] (d-tick n @current-state))
119 ([n state]
120 (reduce (fn [state _]
121 (-> state print-pc print-op tick))
122 state (range n))))
124 (defn print-interrupt
125 [^SaveState state]
126 (println (format "IE: %d" (IE state)))
127 state)
129 (defn set-memory
130 ([state location value]
131 (set-state! state)
132 (let [mem (memory state)]
133 (aset mem location value)
134 (write-memory! mem)
135 (update-state)))
136 ([location value]
137 (set-memory @current-state location value)))
139 (defn set-memory-range
140 ([state start values]
141 (set-state! state)
142 (let [mem (memory state)]
144 (dorun (map (fn [index val]
145 (aset mem index val))
146 (range start
147 (+ start (count values))) values))
148 (write-memory! mem)
149 (update-state)))
150 ([start values]
151 (set-memory-range
152 @current-state start values)))
154 (defn common-differences [& seqs]
155 (let [backbone (range (count (first seqs)))]
156 (sort-by
157 first
158 (filter
159 (comp (partial apply distinct?) second)
160 (zipmap backbone
161 (apply (partial map list) seqs))))))
163 (defn memory-compare [& states]
164 (apply common-differences
165 (map (comp vec memory)
166 states)))
168 (defn different-every-time [& seqs]
169 (let [backbone (range (count (first seqs)))]
170 (sort-by
171 first
172 (filter
173 (comp (fn [seq] (not (contains? (set (map - seq (rest seq)))
174 0))) second)
175 (zipmap backbone
176 (apply (partial map list) seqs))))))
179 (defn harmonic-compare [& states]
180 (apply different-every-time
181 (map (comp vec memory)
182 states)))
184 (defn mid-game []
185 (read-state "mid-game"))
187 (defn watch-memory
188 ([^SaveState state address]
189 (set-state! state)
190 (loop [] (step) (view-memory address) (recur)))
191 ([address] (watch-memory @current-state address)))
193 (defn watch-fn
194 ([^SaveState state state-fn]
195 (set-state! state)
196 (loop [] (step) (state-fn @current-state) (recur)))
197 ([state-fn] (watch-fn @current-state state-fn)))
199 (defn disect-bytes-2
200 "return a vector consiting of the last 16 bytes of the
201 integer expressed as two 8 bit numbers (inside an integer)
202 in the form [high-bits low-bits]."
203 [num]
204 [(bit-shift-right
205 (bit-and num 0xFF00) 8)
206 (bit-and num 0xFF)])
208 (defn disect-bytes-3
209 "same as disect-bytes-2 except that it assumes the input is a
210 24 bit number and returns [high-bits medium-bits low-bits]"
211 [num]
212 (vec
213 (concat
214 [(bit-shift-right (bit-and num 0xFF0000) 16)]
215 (disect-bytes-2 num))))
217 (defn glue-bytes
218 "Given two or three 8-bit numbers inside 32-bit integers,
219 combine them into the integer number that they together
220 represent."
221 ([h l]
222 (+ l (bit-shift-left h 8)))
224 ([h m l]
225 (+ (glue-bytes m l)
226 (bit-shift-left h 16))))
228 (def cartography
229 (File. user-home
230 "proj/vba-clojure/clojure/com/aurellem/exp/cartography"))
232 (defn print-D-memory
233 ([^SaveState state]
234 (let [descriptions
235 (clojure.string/split-lines
236 (slurp cartography))]
237 (dorun
238 (map
239 (fn [line data desc]
240 (printf "%04X %02X%s\n"
241 line data (apply str
242 (drop 20 desc))))
243 (range pokemon-record-begin
244 (inc D-memory-end))
246 (subvec (vec (memory state))
247 pokemon-record-begin
248 (inc D-memory-end))
249 descriptions))))
250 ([] (print-D-memory @current-state)))
253 (defn signed-8-bits
254 "the lower 8 bits of an integer interpreted as a signed 8
255 bit number"
256 [n]
257 (let [lower-seven (bit-and n 127)]
258 (if (bit-test n 7)
259 (- lower-seven 128)
260 lower-seven)))
263 (defn capture-program-counter
264 "records the program counter for each tick"
265 [^SaveState state ticks]
266 (let [i (atom 0)]
267 (reduce (fn [[program-counters state] _]
268 (swap! i inc)
269 (if (= (rem @i 1000) 0) (println @i))
270 [(conj program-counters (PC state))
271 (tick state)])
272 [[] state]
273 (range ticks))))
275 (defn capture-program-counter
276 "Records the program counter for each tick"
277 [^SaveState state ticks]
278 (tick state)
280 (loop [i 0
281 pcs []]
282 (if (= i ticks)
283 (filter (partial < 0x2000)(sort (set pcs)))
284 (do
285 (com.aurellem.gb.Gb/tick)
286 (recur (inc i)
287 (conj pcs (first (registers))))))))