Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/util.clj @ 561:c57398047795

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