Mercurial > vba-clojure

annotate clojure/com/aurellem/gb/util.clj @ 263:a44a2c459aeb

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