Mercurial > vba-clojure
view clojure/com/aurellem/gb/util.clj @ 467:ac0ed5c1a1c4
working on drums.
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Fri, 04 May 2012 05:17:18 -0500 |
parents | 0b6624c1291c |
children | 385799ea1e9c |
line wrap: on
line source
1 (ns com.aurellem.gb.util2 (:use (com.aurellem.gb gb-driver vbm constants))3 (:import java.io.File)4 (:import [com.aurellem.gb.gb_driver SaveState]))6 (defn A7 ([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/parseInt32 (Integer/toBinaryString num) 10)))34 (defn bit-list35 "List the bits of n in order of decreasing significance."36 [n]37 ((fn this [coll n]38 (if (zero? n) coll39 (recur40 (conj coll (rem n 2))41 (int (/ n 2)))))42 [] n))45 (defn low-high46 [low high]47 (+ low (* 256 high)))50 (defn format-name51 "Convert the string of alphabetic/space characters into a keyword by52 replacing spaces with hyphens and converting to lowercase."53 [s]54 (if (nil? s) nil55 (keyword (.toLowerCase56 (apply str57 (map #(if (= % \space) "-" %) s))))))60 ;; used to decode item prices62 (defn decode-bcd63 "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) 067 (+ (first coll) (* 100 (self (rest coll))))))68 (map69 #(+ (* 10 (int (/ % 16)))70 (rem % 16))71 (reverse digits))))76 (defn view-register [state name reg-fn]77 (println (format "%s: %s" name78 (binary-str (reg-fn state))))79 state)81 (defn view-memory82 ([^SaveState state mem]83 (let [val (aget (memory state) mem)]84 (println (format "0x%04X = %s 0x%02X %d" mem85 (binary-str val) val val)))86 state)87 ([mem]88 (view-memory @current-state mem)))90 (defn print-listing91 ([^SaveState state begin end]92 (dorun (map93 (fn [opcode line]94 (println (format "0x%04X: 0x%02X %s %d"95 line96 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-pc105 ([^SaveState state]106 (println (format "PC: 0x%04X" (PC state)))107 state)108 ([] (print-pc @current-state)))110 (defn print-op111 ([^SaveState state]112 (println (format "OP: 0x%02X" (aget (memory state) (PC state))))113 state)114 ([] (print-op @current-state)))116 (defn d-tick117 ([] (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-interrupt125 [^SaveState state]126 (println (format "IE: %d" (IE state)))127 state)129 (defn set-memory130 ([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-range140 ([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 start147 (+ start (count values))) values))148 (write-memory! mem)149 (update-state)))150 ([start values]151 (set-memory-range152 @current-state start values)))154 (defn common-differences [& seqs]155 (let [backbone (range (count (first seqs)))]156 (sort-by157 first158 (filter159 (comp (partial apply distinct?) second)160 (zipmap backbone161 (apply (partial map list) seqs))))))163 (defn memory-compare [& states]164 (apply common-differences165 (map (comp vec memory)166 states)))168 (defn different-every-time [& seqs]169 (let [backbone (range (count (first seqs)))]170 (sort-by171 first172 (filter173 (comp (fn [seq] (not (contains? (set (map - seq (rest seq)))174 0))) second)175 (zipmap backbone176 (apply (partial map list) seqs))))))179 (defn harmonic-compare [& states]180 (apply different-every-time181 (map (comp vec memory)182 states)))184 (defn mid-game []185 (read-state "mid-game"))187 (defn watch-memory188 ([^SaveState state address]189 (set-state! state)190 (loop [] (step) (view-memory address) (recur)))191 ([address] (watch-memory @current-state address)))193 (defn watch-fn194 ([^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-2200 "return a vector consiting of the last 16 bytes of the201 integer expressed as two 8 bit numbers (inside an integer)202 in the form [high-bits low-bits]."203 [num]204 [(bit-shift-right205 (bit-and num 0xFF00) 8)206 (bit-and num 0xFF)])208 (defn disect-bytes-3209 "same as disect-bytes-2 except that it assumes the input is a210 24 bit number and returns [high-bits medium-bits low-bits]"211 [num]212 (vec213 (concat214 [(bit-shift-right (bit-and num 0xFF0000) 16)]215 (disect-bytes-2 num))))217 (defn glue-bytes218 "Given two or three 8-bit numbers inside 32-bit integers,219 combine them into the integer number that they together220 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 cartography229 (File. user-home230 "proj/vba-clojure/clojure/com/aurellem/exp/cartography"))232 (defn print-D-memory233 ([^SaveState state]234 (let [descriptions235 (clojure.string/split-lines236 (slurp cartography))]237 (dorun238 (map239 (fn [line data desc]240 (printf "%04X %02X%s\n"241 line data (apply str242 (drop 20 desc))))243 (range pokemon-record-begin244 (inc D-memory-end))246 (subvec (vec (memory state))247 pokemon-record-begin248 (inc D-memory-end))249 descriptions))))250 ([] (print-D-memory @current-state)))253 (defn signed-8-bits254 "the lower 8 bits of an integer interpreted as a signed 8255 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-counter264 "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-counter276 "Records the program counter for each tick"277 [^SaveState state ticks]278 (tick state)280 (loop [i 0281 pcs []]282 (if (= i ticks)283 (filter (partial < 0x2000)(sort (set pcs)))284 (do285 (com.aurellem.gb.Gb/tick)286 (recur (inc i)287 (conj pcs (first (registers))))))))