view clojure/com/aurellem/gb/util.clj @ 360:51aa6486c2ab

repairing route
author Robert McIntyre <rlm@mit.edu>
date Mon, 09 Apr 2012 08:51:47 -0500
parents 92f0011925d2
children 1f14c1b8af7e
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 [state]
7 (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))
9 (defn B [state]
10 (bit-shift-right (bit-and 0x0000FF00 (BC state)) 8))
12 (defn D [state]
13 (bit-shift-right (bit-and 0x0000FF00 (DE state)) 8))
15 (defn H [state]
16 (bit-shift-right (bit-and 0x0000FF00 (HL state)) 8))
18 (defn C [state]
19 (bit-and 0xFF (BC state)))
20 (defn F [state]
21 (bit-and 0xFF (AF state)))
22 (defn E [state]
23 (bit-and 0xFF (DE state)))
24 (defn L [state]
25 (bit-and 0xFF (HL state)))
27 (defn binary-str [num]
28 (format "%08d"
29 (Integer/parseInt
30 (Integer/toBinaryString num) 10)))
32 (defn bit-list
33 "List the bits of n in order of decreasing significance."
34 [n]
35 ((fn this [coll n]
36 (if (zero? n) coll
37 (recur
38 (conj coll (rem n 2))
39 (int (/ n 2)))))
40 [] n))
43 (defn low-high
44 [low high]
45 (+ low (* 256 high)))
48 (defn format-name
49 "Convert the string of alphabetic/space characters into a keyword by
50 replacing spaces with hyphens and converting to lowercase."
51 [s]
52 (if (nil? s) nil
53 (keyword (.toLowerCase
54 (apply str
55 (map #(if (= % \space) "-" %) s))))))
58 ;; used to decode item prices
60 (defn decode-bcd
61 "Take a sequence of binary-coded digits (in written order) and return the number they represent."
62 [digits]
63 ((fn self [coll]
64 (if (empty? coll) 0
65 (+ (first coll) (* 100 (self (rest coll))))))
66 (map
67 #(+ (* 10 (int (/ % 16)))
68 (rem % 16))
69 (reverse digits))))
74 (defn view-register [state name reg-fn]
75 (println (format "%s: %s" name
76 (binary-str (reg-fn state))))
77 state)
79 (defn view-memory
80 ([^SaveState state mem]
81 (let [val (aget (memory state) mem)]
82 (println (format "0x%04X = %s 0x%02X %d" mem
83 (binary-str val) val val)))
84 state)
85 ([mem]
86 (view-memory @current-state mem)))
88 (defn print-listing
89 ([^SaveState state begin end]
90 (dorun (map
91 (fn [opcode line]
92 (println (format "0x%04X: 0x%02X %s %d"
93 line
94 opcode (binary-str opcode)
95 opcode)))
96 (subvec (vec (memory state)) begin end)
97 (range begin end)))
98 state)
99 ([begin end]
100 (print-listing @current-state begin end)))
102 (defn print-pc
103 ([^SaveState state]
104 (println (format "PC: 0x%04X" (PC state)))
105 state)
106 ([] (print-pc @current-state)))
108 (defn print-op
109 ([^SaveState state]
110 (println (format "OP: 0x%02X" (aget (memory state) (PC state))))
111 state)
112 ([] (print-op @current-state)))
114 (defn d-tick
115 ([state]
116 (-> state print-pc print-op tick)))
118 (defn print-interrupt
119 [^SaveState state]
120 (println (format "IE: %d" (IE state)))
121 state)
123 (defn set-memory
124 ([state location value]
125 (set-state! state)
126 (let [mem (memory state)]
127 (aset mem location value)
128 (write-memory! mem)
129 (update-state)))
130 ([location value]
131 (set-memory @current-state location value)))
133 (defn set-memory-range
134 ([state start values]
135 (set-state! state)
136 (let [mem (memory state)]
138 (dorun (map (fn [index val]
139 (aset mem index val))
140 (range start
141 (+ start (count values))) values))
142 (write-memory! mem)
143 (update-state)))
144 ([start values]
145 (set-memory-range
146 @current-state start values)))
148 (defn common-differences [& seqs]
149 (let [backbone (range (count (first seqs)))]
150 (sort-by
151 first
152 (filter
153 (comp (partial apply distinct?) second)
154 (zipmap backbone
155 (apply (partial map list) seqs))))))
157 (defn memory-compare [& states]
158 (apply common-differences
159 (map (comp vec memory)
160 states)))
162 (defn different-every-time [& seqs]
163 (let [backbone (range (count (first seqs)))]
164 (sort-by
165 first
166 (filter
167 (comp (fn [seq] (not (contains? (set (map - seq (rest seq)))
168 0))) second)
169 (zipmap backbone
170 (apply (partial map list) seqs))))))
173 (defn harmonic-compare [& states]
174 (apply different-every-time
175 (map (comp vec memory)
176 states)))
178 (defn mid-game []
179 (read-state "mid-game"))
181 (defn watch-memory
182 ([^SaveState state address]
183 (set-state! state)
184 (loop [] (step) (view-memory address) (recur)))
185 ([address] (watch-memory @current-state address)))
187 (defn watch-fn
188 ([^SaveState state state-fn]
189 (set-state! state)
190 (loop [] (step) (state-fn @current-state) (recur)))
191 ([state-fn] (watch-fn @current-state state-fn)))
193 (defn disect-bytes-2
194 "return a vector consiting of the last 16 bytes of the
195 integer expressed as two 8 bit numbers (inside an integer)
196 in the form [high-bits low-bits]."
197 [num]
198 [(bit-shift-right
199 (bit-and num 0xFF00) 8)
200 (bit-and num 0xFF)])
202 (defn disect-bytes-3
203 "same as disect-bytes-2 except that it assumes the input is a
204 24 bit number and returns [high-bits medium-bits low-bits]"
205 [num]
206 (vec
207 (concat
208 [(bit-shift-right (bit-and num 0xFF0000) 16)]
209 (disect-bytes-2 num))))
211 (defn glue-bytes
212 "Given two or three 8-bit numbers inside 32-bit integers,
213 combine them into the integer number that they together
214 represent."
215 ([h l]
216 (+ l (bit-shift-left h 8)))
218 ([h m l]
219 (+ (glue-bytes m l)
220 (bit-shift-left h 16))))
222 (def cartography
223 (File. user-home
224 "proj/vba-clojure/clojure/com/aurellem/exp/cartography"))
226 (defn print-D-memory
227 ([^SaveState state]
228 (let [descriptions
229 (clojure.string/split-lines
230 (slurp cartography))]
231 (dorun
232 (map
233 (fn [line data desc]
234 (printf "%04X %02X%s\n"
235 line data (apply str
236 (drop 20 desc))))
237 (range pokemon-record-begin
238 (inc D-memory-end))
240 (subvec (vec (memory state))
241 pokemon-record-begin
242 (inc D-memory-end))
243 descriptions))))
244 ([] (print-D-memory @current-state)))
247 (defn signed-8-bits
248 "the lower 8 bits of an integer interpreted as a signed 8
249 bit number"
250 [n]
251 (let [lower-seven (bit-and n 127)]
252 (if (bit-test n 7)
253 (- lower-seven 128)
254 lower-seven)))