Mercurial > vba-clojure
view clojure/com/aurellem/gb/util.clj @ 276:18336ab5d6ea
merge.
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Tue, 27 Mar 2012 12:37:48 -0500 |
parents | 69184558fcf3 |
children | eec3e69500d9 |
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)))33 (defn view-register [state name reg-fn]34 (println (format "%s: %s" name35 (binary-str (reg-fn state))))36 state)38 (defn view-memory39 ([^SaveState state mem]40 (let [val (aget (memory state) mem)]41 (println (format "0x%04X = %s 0x%02X %d" mem42 (binary-str val) val val)))43 state)44 ([mem]45 (view-memory @current-state mem)))47 (defn print-listing48 ([^SaveState state begin end]49 (dorun (map50 (fn [opcode line]51 (println (format "0x%04X: 0x%02X %s %d"52 line53 opcode (binary-str opcode)54 opcode)))55 (subvec (vec (memory state)) begin end)56 (range begin end)))57 state)58 ([begin end]59 (print-listing @current-state begin end)))61 (defn print-pc62 ([^SaveState state]63 (println (format "PC: 0x%04X" (PC state)))64 state)65 ([] (print-pc @current-state)))67 (defn print-op68 ([^SaveState state]69 (println (format "OP: 0x%02X" (aget (memory state) (PC state))))70 state)71 ([] (print-op @current-state)))73 (defn d-tick74 ([state]75 (-> state print-pc print-op tick)))77 (defn print-interrupt78 [^SaveState state]79 (println (format "IE: %d" (IE state)))80 state)82 (defn set-memory83 ([state location value]84 (set-state! state)85 (let [mem (memory state)]86 (aset mem location value)87 (write-memory! mem)88 (update-state)))89 ([location value]90 (set-memory @current-state location value)))92 (defn set-memory-range93 ([state start values]94 (set-state! state)95 (let [mem (memory state)]97 (dorun (map (fn [index val]98 (aset mem index val))99 (range start100 (+ start (count values))) values))101 (write-memory! mem)102 (update-state)))103 ([start values]104 (set-memory-range105 @current-state start values)))107 (defn common-differences [& seqs]108 (let [backbone (range (count (first seqs)))]109 (filter110 (comp (partial apply distinct?) second)111 (zipmap backbone112 (apply (partial map list) seqs)))))114 (defn temporal-compare [& states]115 (apply common-differences116 (map (comp vec memory)117 states)))119 (defn mid-game []120 (read-state "mid-game"))124 (defn disect-bytes-2125 "return a vector consiting of the last 16 bytes of the126 integer expressed as two 8 bit numbers (inside an integer)127 in the form [high-bits low-bits]."128 [num]129 [(bit-shift-right130 (bit-and num 0xFF00) 8)131 (bit-and num 0xFF)])133 (defn disect-bytes-3134 "same as disect-bytes-2 except that it assumes the input is a135 24 bit number and returns [high-bits medium-bits low-bits]"136 [num]137 (vec138 (concat139 [(bit-shift-right (bit-and num 0xFF0000) 16)]140 (disect-bytes-2 num))))142 (defn glue-bytes143 "Given two or three 8-bit numbers inside 32-bit integers,144 combine them into the integer number that they together145 represent."146 ([h l]147 (+ l (bit-shift-left h 8)))149 ([h m l]150 (+ (glue-bytes m l)151 (bit-shift-left h 16))))153 (def cartography154 (File. user-home155 "proj/vba-clojure/clojure/com/aurellem/exp/cartography"))159 (defn print-D-memory160 ([^SaveState state]162 (let [descriptions163 (clojure.string/split-lines164 (slurp cartography))]165 (dorun166 (map167 (fn [line data desc]168 (printf "%04X %02X%s\n"169 line data (apply str170 (drop 20 desc))))171 (range pokemon-record-begin172 (inc D-memory-end))174 (subvec (vec (memory state))175 pokemon-record-begin176 (inc D-memory-end))177 descriptions))))178 ([] (print-D-memory @current-state)))