rlm@145: (ns com.aurellem.gb.util
rlm@222:   (:use (com.aurellem.gb gb-driver vbm constants))
rlm@222:   (:import java.io.File)
rlm@145:   (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@145: 
rlm@145: (defn A [state]
rlm@145:   (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))
rlm@145: 
rlm@145: (defn B [state]
rlm@145:   (bit-shift-right (bit-and 0x0000FF00 (BC state)) 8))
rlm@145: 
rlm@145: (defn D [state]
rlm@145:   (bit-shift-right (bit-and 0x0000FF00 (DE state)) 8))
rlm@145: 
rlm@145: (defn H [state]
rlm@145:   (bit-shift-right (bit-and 0x0000FF00 (HL state)) 8))
rlm@145: 
rlm@145: (defn C [state]
rlm@145:   (bit-and 0xFF (BC state)))
rlm@145: (defn F [state]
rlm@145:   (bit-and 0xFF (AF state)))
rlm@145: (defn E [state]
rlm@145:   (bit-and 0xFF (DE state)))
rlm@145: (defn L [state]
rlm@145:   (bit-and 0xFF (HL state)))
rlm@145: 
rlm@145: (defn binary-str [num]
rlm@145:   (format "%08d"
rlm@145:           (Integer/parseInt
rlm@145:            (Integer/toBinaryString num) 10)))
rlm@145: 
rlm@145: (defn view-register [state name reg-fn]
rlm@145:   (println (format "%s: %s" name
rlm@145:                    (binary-str (reg-fn state))))
rlm@145:   state)
rlm@145: 
rlm@174: (defn view-memory
rlm@174:   ([^SaveState state mem]
rlm@230:      (let [val (aget (memory state) mem)]
rlm@230:        (println (format "0x%04X = %s 0x%02X %d" mem
rlm@230:                         (binary-str val) val val)))
rlm@174:      state)
rlm@174:   ([mem]
rlm@174:      (view-memory @current-state mem)))
rlm@145: 
rlm@176: (defn print-listing
rlm@176:   ([^SaveState state begin end]
rlm@176:      (dorun (map 
rlm@176:              (fn [opcode line]
rlm@176:                (println (format "0x%04X:  0x%02X" line opcode)))
rlm@176:              (subvec  (vec (memory state)) begin end)
rlm@176:              (range begin end)))
rlm@176:      state)
rlm@176:   ([begin end]
rlm@176:      (print-listing @current-state begin end)))
rlm@145: 
rlm@174: (defn print-pc
rlm@174:   ([^SaveState state]
rlm@174:      (println (format "PC: 0x%04X" (PC state)))
rlm@174:      state)
rlm@174:   ([] (print-pc @current-state))) 
rlm@145: 
rlm@174: (defn print-op
rlm@174:   ([^SaveState state]
rlm@174:      (println (format "OP: 0x%02X" (aget (memory state) (PC state))))
rlm@174:      state)
rlm@174:   ([] (print-op @current-state)))
rlm@145: 
rlm@145: (defn d-tick
rlm@145:   ([state]
rlm@145:   (-> state print-pc print-op tick)))
rlm@145: 
rlm@145: (defn print-interrupt
rlm@145:   [^SaveState state]
rlm@145:   (println (format "IE: %d" (IE state)))
rlm@145:   state)
rlm@145: 
rlm@145: (defn set-memory
rlm@145:   ([state location value]
rlm@145:      (set-state! state)
rlm@145:      (let [mem (memory state)]
rlm@145:        (aset mem location value)
rlm@145:        (write-memory! mem)
rlm@145:        (update-state)))
rlm@145:   ([location value]
rlm@145:      (set-memory @current-state location value)))
rlm@145: 
rlm@145: (defn set-memory-range
rlm@145:   ([state start values]
rlm@145:      (set-state! state)
rlm@145:      (let [mem (memory state)]
rlm@145:   
rlm@145:        (dorun (map (fn [index val]
rlm@145:                      (aset mem index val))
rlm@145:                    (range start
rlm@145:                           (+ start (count values))) values))
rlm@145:     (write-memory! mem)
rlm@145:     (update-state)))
rlm@145:   ([start values]
rlm@145:      (set-memory-range
rlm@145:       @current-state start values)))
rlm@145: 
rlm@145: (defn common-differences [& seqs]
rlm@145:   (let [backbone (range (count (first seqs)))]
rlm@145:     (filter
rlm@145:      (comp (partial apply distinct?) second)
rlm@145:      (zipmap backbone
rlm@145:              (apply (partial map list) seqs)))))
rlm@145: 
rlm@212: (defn temporal-compare [& states]
rlm@212:   (apply common-differences
rlm@212:          (map (comp vec memory)
rlm@212:               states)))
rlm@212: 
rlm@145: (defn mid-game []
rlm@145:   (read-state "mid-game"))
rlm@154: 
rlm@154: 
rlm@192: 
rlm@192: (defn disect-bytes-2
rlm@192:   "return a vector consiting of the last 16 bytes of the
rlm@192:    integer expressed as two 8 bit nimbers (inside an integer)
rlm@192:    in the form [high-bits low-bits."
rlm@192:   [num]
rlm@192:   [(bit-shift-right
rlm@192:     (bit-and num 0xFF00) 8)
rlm@192:    (bit-and num 0xFF)])
rlm@192: 
rlm@192: (defn disect-bytes-3
rlm@192:   "same as disect-bytes-2 except that it assumes the input is a
rlm@192:    24 bit number and returns [high-bits medium-bits low-bits]"
rlm@192:   [num]
rlm@192:   (vec
rlm@192:    (concat 
rlm@192:     [(bit-shift-right (bit-and num 0xFF0000) 16)]
rlm@192:     (disect-bytes-2 num))))
rlm@192: 
rlm@192: (defn glue-bytes
rlm@192:   "Given two or three 8-bit numbers inside 32-bit integers,
rlm@192:    combine them into the integer number that they together
rlm@192:    represent."
rlm@192:   ([h l]
rlm@192:      (+ l (bit-shift-left h 8)))
rlm@192: 
rlm@192:   ([h m l]
rlm@192:      (+ (glue-bytes m l)
rlm@192:         (bit-shift-left h 16))))
rlm@192: 
rlm@222: (def cartography
rlm@222:   (File. user-home
rlm@222:          "proj/vba-clojure/clojure/com/aurellem/exp/cartography"))
rlm@192: 
rlm@222: 
rlm@222: 
rlm@222: (defn print-D-memory
rlm@222:   ([^SaveState state]
rlm@222:      
rlm@222:      (let [descriptions
rlm@222:            (clojure.string/split-lines
rlm@222:             (slurp cartography))]
rlm@222:        (dorun
rlm@222:         (map
rlm@222:          (fn [line data desc]
rlm@222:            (printf "%04X  %02X%s\n"
rlm@222:                    line data (apply str
rlm@222:                                     (drop 20 desc))))
rlm@222:          (range pokemon-record-begin
rlm@222:                 (inc D-memory-end))
rlm@222:          
rlm@222:          (subvec (vec (memory state))
rlm@222:                  pokemon-record-begin
rlm@222:                  (inc D-memory-end))
rlm@222:          descriptions))))
rlm@222:   ([] (print-D-memory @current-state)))
rlm@222: