Mercurial > vba-clojure
view clojure/com/aurellem/gb/util.clj @ 261:1b5c33614b0d
merge
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Mon, 26 Mar 2012 19:57:25 -0500 |
parents | 22f58fa47c3c |
children | 69184558fcf3 |
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 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/parseInt30 (Integer/toBinaryString num) 10)))32 (defn view-register [state name reg-fn]33 (println (format "%s: %s" name34 (binary-str (reg-fn state))))35 state)37 (defn view-memory38 ([^SaveState state mem]39 (let [val (aget (memory state) mem)]40 (println (format "0x%04X = %s 0x%02X %d" mem41 (binary-str val) val val)))42 state)43 ([mem]44 (view-memory @current-state mem)))46 (defn print-listing47 ([^SaveState state begin end]48 (dorun (map49 (fn [opcode line]50 (println (format "0x%04X: 0x%02X %s %d"51 line52 opcode (binary-str opcode)53 opcode)))54 (subvec (vec (memory state)) begin end)55 (range begin end)))56 state)57 ([begin end]58 (print-listing @current-state begin end)))60 (defn print-pc61 ([^SaveState state]62 (println (format "PC: 0x%04X" (PC state)))63 state)64 ([] (print-pc @current-state)))66 (defn print-op67 ([^SaveState state]68 (println (format "OP: 0x%02X" (aget (memory state) (PC state))))69 state)70 ([] (print-op @current-state)))72 (defn d-tick73 ([state]74 (-> state print-pc print-op tick)))76 (defn print-interrupt77 [^SaveState state]78 (println (format "IE: %d" (IE state)))79 state)81 (defn set-memory82 ([state location value]83 (set-state! state)84 (let [mem (memory state)]85 (aset mem location value)86 (write-memory! mem)87 (update-state)))88 ([location value]89 (set-memory @current-state location value)))91 (defn set-memory-range92 ([state start values]93 (set-state! state)94 (let [mem (memory state)]96 (dorun (map (fn [index val]97 (aset mem index val))98 (range start99 (+ start (count values))) values))100 (write-memory! mem)101 (update-state)))102 ([start values]103 (set-memory-range104 @current-state start values)))106 (defn common-differences [& seqs]107 (let [backbone (range (count (first seqs)))]108 (filter109 (comp (partial apply distinct?) second)110 (zipmap backbone111 (apply (partial map list) seqs)))))113 (defn temporal-compare [& states]114 (apply common-differences115 (map (comp vec memory)116 states)))118 (defn mid-game []119 (read-state "mid-game"))123 (defn disect-bytes-2124 "return a vector consiting of the last 16 bytes of the125 integer expressed as two 8 bit nimbers (inside an integer)126 in the form [high-bits low-bits."127 [num]128 [(bit-shift-right129 (bit-and num 0xFF00) 8)130 (bit-and num 0xFF)])132 (defn disect-bytes-3133 "same as disect-bytes-2 except that it assumes the input is a134 24 bit number and returns [high-bits medium-bits low-bits]"135 [num]136 (vec137 (concat138 [(bit-shift-right (bit-and num 0xFF0000) 16)]139 (disect-bytes-2 num))))141 (defn glue-bytes142 "Given two or three 8-bit numbers inside 32-bit integers,143 combine them into the integer number that they together144 represent."145 ([h l]146 (+ l (bit-shift-left h 8)))148 ([h m l]149 (+ (glue-bytes m l)150 (bit-shift-left h 16))))152 (def cartography153 (File. user-home154 "proj/vba-clojure/clojure/com/aurellem/exp/cartography"))158 (defn print-D-memory159 ([^SaveState state]161 (let [descriptions162 (clojure.string/split-lines163 (slurp cartography))]164 (dorun165 (map166 (fn [line data desc]167 (printf "%04X %02X%s\n"168 line data (apply str169 (drop 20 desc))))170 (range pokemon-record-begin171 (inc D-memory-end))173 (subvec (vec (memory state))174 pokemon-record-begin175 (inc D-memory-end))176 descriptions))))177 ([] (print-D-memory @current-state)))