Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/util.clj @ 316:d263df762c59

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