Mercurial > vba-clojure
view clojure/com/aurellem/gb/util.clj @ 349:37616a97beaa
fixed a few blocks that were not tangling properly.
author | Dylan Holmes <ocsenave@gmail.com> |
---|---|
date | Sun, 08 Apr 2012 07:57:52 -0500 |
parents | 92f0011925d2 |
children | 1f14c1b8af7e |
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 bit-list33 "List the bits of n in order of decreasing significance."34 [n]35 ((fn this [coll n]36 (if (zero? n) coll37 (recur38 (conj coll (rem n 2))39 (int (/ n 2)))))40 [] n))43 (defn low-high44 [low high]45 (+ low (* 256 high)))48 (defn format-name49 "Convert the string of alphabetic/space characters into a keyword by50 replacing spaces with hyphens and converting to lowercase."51 [s]52 (if (nil? s) nil53 (keyword (.toLowerCase54 (apply str55 (map #(if (= % \space) "-" %) s))))))58 ;; used to decode item prices60 (defn decode-bcd61 "Take a sequence of binary-coded digits (in written order) and return the number they represent."62 [digits]63 ((fn self [coll]64 (if (empty? coll) 065 (+ (first coll) (* 100 (self (rest coll))))))66 (map67 #(+ (* 10 (int (/ % 16)))68 (rem % 16))69 (reverse digits))))74 (defn view-register [state name reg-fn]75 (println (format "%s: %s" name76 (binary-str (reg-fn state))))77 state)79 (defn view-memory80 ([^SaveState state mem]81 (let [val (aget (memory state) mem)]82 (println (format "0x%04X = %s 0x%02X %d" mem83 (binary-str val) val val)))84 state)85 ([mem]86 (view-memory @current-state mem)))88 (defn print-listing89 ([^SaveState state begin end]90 (dorun (map91 (fn [opcode line]92 (println (format "0x%04X: 0x%02X %s %d"93 line94 opcode (binary-str opcode)95 opcode)))96 (subvec (vec (memory state)) begin end)97 (range begin end)))98 state)99 ([begin end]100 (print-listing @current-state begin end)))102 (defn print-pc103 ([^SaveState state]104 (println (format "PC: 0x%04X" (PC state)))105 state)106 ([] (print-pc @current-state)))108 (defn print-op109 ([^SaveState state]110 (println (format "OP: 0x%02X" (aget (memory state) (PC state))))111 state)112 ([] (print-op @current-state)))114 (defn d-tick115 ([state]116 (-> state print-pc print-op tick)))118 (defn print-interrupt119 [^SaveState state]120 (println (format "IE: %d" (IE state)))121 state)123 (defn set-memory124 ([state location value]125 (set-state! state)126 (let [mem (memory state)]127 (aset mem location value)128 (write-memory! mem)129 (update-state)))130 ([location value]131 (set-memory @current-state location value)))133 (defn set-memory-range134 ([state start values]135 (set-state! state)136 (let [mem (memory state)]138 (dorun (map (fn [index val]139 (aset mem index val))140 (range start141 (+ start (count values))) values))142 (write-memory! mem)143 (update-state)))144 ([start values]145 (set-memory-range146 @current-state start values)))148 (defn common-differences [& seqs]149 (let [backbone (range (count (first seqs)))]150 (sort-by151 first152 (filter153 (comp (partial apply distinct?) second)154 (zipmap backbone155 (apply (partial map list) seqs))))))157 (defn memory-compare [& states]158 (apply common-differences159 (map (comp vec memory)160 states)))162 (defn different-every-time [& seqs]163 (let [backbone (range (count (first seqs)))]164 (sort-by165 first166 (filter167 (comp (fn [seq] (not (contains? (set (map - seq (rest seq)))168 0))) second)169 (zipmap backbone170 (apply (partial map list) seqs))))))173 (defn harmonic-compare [& states]174 (apply different-every-time175 (map (comp vec memory)176 states)))178 (defn mid-game []179 (read-state "mid-game"))181 (defn watch-memory182 ([^SaveState state address]183 (set-state! state)184 (loop [] (step) (view-memory address) (recur)))185 ([address] (watch-memory @current-state address)))187 (defn watch-fn188 ([^SaveState state state-fn]189 (set-state! state)190 (loop [] (step) (state-fn @current-state) (recur)))191 ([state-fn] (watch-fn @current-state state-fn)))193 (defn disect-bytes-2194 "return a vector consiting of the last 16 bytes of the195 integer expressed as two 8 bit numbers (inside an integer)196 in the form [high-bits low-bits]."197 [num]198 [(bit-shift-right199 (bit-and num 0xFF00) 8)200 (bit-and num 0xFF)])202 (defn disect-bytes-3203 "same as disect-bytes-2 except that it assumes the input is a204 24 bit number and returns [high-bits medium-bits low-bits]"205 [num]206 (vec207 (concat208 [(bit-shift-right (bit-and num 0xFF0000) 16)]209 (disect-bytes-2 num))))211 (defn glue-bytes212 "Given two or three 8-bit numbers inside 32-bit integers,213 combine them into the integer number that they together214 represent."215 ([h l]216 (+ l (bit-shift-left h 8)))218 ([h m l]219 (+ (glue-bytes m l)220 (bit-shift-left h 16))))222 (def cartography223 (File. user-home224 "proj/vba-clojure/clojure/com/aurellem/exp/cartography"))226 (defn print-D-memory227 ([^SaveState state]228 (let [descriptions229 (clojure.string/split-lines230 (slurp cartography))]231 (dorun232 (map233 (fn [line data desc]234 (printf "%04X %02X%s\n"235 line data (apply str236 (drop 20 desc))))237 (range pokemon-record-begin238 (inc D-memory-end))240 (subvec (vec (memory state))241 pokemon-record-begin242 (inc D-memory-end))243 descriptions))))244 ([] (print-D-memory @current-state)))247 (defn signed-8-bits248 "the lower 8 bits of an integer interpreted as a signed 8249 bit number"250 [n]251 (let [lower-seven (bit-and n 127)]252 (if (bit-test n 7)253 (- lower-seven 128)254 lower-seven)))