Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/util.clj @ 245:a50faba43967

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
forgot to include Bird type with the list of available type names for type advantage data. now hxc-advantage is correct.
author Dylan Holmes <ocsenave@gmail.com>
date Sun, 25 Mar 2012 23:04:01 -0500
parents fe26776e1a58
children 22f58fa47c3c
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
rlm@145 32 (defn view-register [state name reg-fn]
rlm@145 33 (println (format "%s: %s" name
rlm@145 34 (binary-str (reg-fn state))))
rlm@145 35 state)
rlm@145 36
rlm@174 37 (defn view-memory
rlm@174 38 ([^SaveState state mem]
rlm@230 39 (let [val (aget (memory state) mem)]
rlm@230 40 (println (format "0x%04X = %s 0x%02X %d" mem
rlm@230 41 (binary-str val) val val)))
rlm@174 42 state)
rlm@174 43 ([mem]
rlm@174 44 (view-memory @current-state mem)))
rlm@145 45
rlm@176 46 (defn print-listing
rlm@176 47 ([^SaveState state begin end]
rlm@176 48 (dorun (map
rlm@176 49 (fn [opcode line]
rlm@176 50 (println (format "0x%04X: 0x%02X" line opcode)))
rlm@176 51 (subvec (vec (memory state)) begin end)
rlm@176 52 (range begin end)))
rlm@176 53 state)
rlm@176 54 ([begin end]
rlm@176 55 (print-listing @current-state begin end)))
rlm@145 56
rlm@174 57 (defn print-pc
rlm@174 58 ([^SaveState state]
rlm@174 59 (println (format "PC: 0x%04X" (PC state)))
rlm@174 60 state)
rlm@174 61 ([] (print-pc @current-state)))
rlm@145 62
rlm@174 63 (defn print-op
rlm@174 64 ([^SaveState state]
rlm@174 65 (println (format "OP: 0x%02X" (aget (memory state) (PC state))))
rlm@174 66 state)
rlm@174 67 ([] (print-op @current-state)))
rlm@145 68
rlm@145 69 (defn d-tick
rlm@145 70 ([state]
rlm@145 71 (-> state print-pc print-op tick)))
rlm@145 72
rlm@145 73 (defn print-interrupt
rlm@145 74 [^SaveState state]
rlm@145 75 (println (format "IE: %d" (IE state)))
rlm@145 76 state)
rlm@145 77
rlm@145 78 (defn set-memory
rlm@145 79 ([state location value]
rlm@145 80 (set-state! state)
rlm@145 81 (let [mem (memory state)]
rlm@145 82 (aset mem location value)
rlm@145 83 (write-memory! mem)
rlm@145 84 (update-state)))
rlm@145 85 ([location value]
rlm@145 86 (set-memory @current-state location value)))
rlm@145 87
rlm@145 88 (defn set-memory-range
rlm@145 89 ([state start values]
rlm@145 90 (set-state! state)
rlm@145 91 (let [mem (memory state)]
rlm@145 92
rlm@145 93 (dorun (map (fn [index val]
rlm@145 94 (aset mem index val))
rlm@145 95 (range start
rlm@145 96 (+ start (count values))) values))
rlm@145 97 (write-memory! mem)
rlm@145 98 (update-state)))
rlm@145 99 ([start values]
rlm@145 100 (set-memory-range
rlm@145 101 @current-state start values)))
rlm@145 102
rlm@145 103 (defn common-differences [& seqs]
rlm@145 104 (let [backbone (range (count (first seqs)))]
rlm@145 105 (filter
rlm@145 106 (comp (partial apply distinct?) second)
rlm@145 107 (zipmap backbone
rlm@145 108 (apply (partial map list) seqs)))))
rlm@145 109
rlm@212 110 (defn temporal-compare [& states]
rlm@212 111 (apply common-differences
rlm@212 112 (map (comp vec memory)
rlm@212 113 states)))
rlm@212 114
rlm@145 115 (defn mid-game []
rlm@145 116 (read-state "mid-game"))
rlm@154 117
rlm@154 118
rlm@192 119
rlm@192 120 (defn disect-bytes-2
rlm@192 121 "return a vector consiting of the last 16 bytes of the
rlm@192 122 integer expressed as two 8 bit nimbers (inside an integer)
rlm@192 123 in the form [high-bits low-bits."
rlm@192 124 [num]
rlm@192 125 [(bit-shift-right
rlm@192 126 (bit-and num 0xFF00) 8)
rlm@192 127 (bit-and num 0xFF)])
rlm@192 128
rlm@192 129 (defn disect-bytes-3
rlm@192 130 "same as disect-bytes-2 except that it assumes the input is a
rlm@192 131 24 bit number and returns [high-bits medium-bits low-bits]"
rlm@192 132 [num]
rlm@192 133 (vec
rlm@192 134 (concat
rlm@192 135 [(bit-shift-right (bit-and num 0xFF0000) 16)]
rlm@192 136 (disect-bytes-2 num))))
rlm@192 137
rlm@192 138 (defn glue-bytes
rlm@192 139 "Given two or three 8-bit numbers inside 32-bit integers,
rlm@192 140 combine them into the integer number that they together
rlm@192 141 represent."
rlm@192 142 ([h l]
rlm@192 143 (+ l (bit-shift-left h 8)))
rlm@192 144
rlm@192 145 ([h m l]
rlm@192 146 (+ (glue-bytes m l)
rlm@192 147 (bit-shift-left h 16))))
rlm@192 148
rlm@222 149 (def cartography
rlm@222 150 (File. user-home
rlm@222 151 "proj/vba-clojure/clojure/com/aurellem/exp/cartography"))
rlm@192 152
rlm@222 153
rlm@222 154
rlm@222 155 (defn print-D-memory
rlm@222 156 ([^SaveState state]
rlm@222 157
rlm@222 158 (let [descriptions
rlm@222 159 (clojure.string/split-lines
rlm@222 160 (slurp cartography))]
rlm@222 161 (dorun
rlm@222 162 (map
rlm@222 163 (fn [line data desc]
rlm@222 164 (printf "%04X %02X%s\n"
rlm@222 165 line data (apply str
rlm@222 166 (drop 20 desc))))
rlm@222 167 (range pokemon-record-begin
rlm@222 168 (inc D-memory-end))
rlm@222 169
rlm@222 170 (subvec (vec (memory state))
rlm@222 171 pokemon-record-begin
rlm@222 172 (inc D-memory-end))
rlm@222 173 descriptions))))
rlm@222 174 ([] (print-D-memory @current-state)))
rlm@222 175