1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/clojure/com/aurellem/gb/util.clj	Mon Mar 19 21:23:46 2012 -0500
     1.3 @@ -0,0 +1,100 @@
     1.4 +(ns com.aurellem.gb.util
     1.5 +  (:use (com.aurellem.gb gb-driver vbm))
     1.6 +  (:import [com.aurellem.gb.gb_driver SaveState]))
     1.7 +
     1.8 +
     1.9 +(defn A [state]
    1.10 +  (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))
    1.11 +
    1.12 +(defn B [state]
    1.13 +  (bit-shift-right (bit-and 0x0000FF00 (BC state)) 8))
    1.14 +
    1.15 +(defn D [state]
    1.16 +  (bit-shift-right (bit-and 0x0000FF00 (DE state)) 8))
    1.17 +
    1.18 +(defn H [state]
    1.19 +  (bit-shift-right (bit-and 0x0000FF00 (HL state)) 8))
    1.20 +
    1.21 +(defn C [state]
    1.22 +  (bit-and 0xFF (BC state)))
    1.23 +(defn F [state]
    1.24 +  (bit-and 0xFF (AF state)))
    1.25 +(defn E [state]
    1.26 +  (bit-and 0xFF (DE state)))
    1.27 +(defn L [state]
    1.28 +  (bit-and 0xFF (HL state)))
    1.29 +
    1.30 +(defn binary-str [num]
    1.31 +  (format "%08d"
    1.32 +          (Integer/parseInt
    1.33 +           (Integer/toBinaryString num) 10)))
    1.34 +
    1.35 +(defn view-register [state name reg-fn]
    1.36 +  (println (format "%s: %s" name
    1.37 +                   (binary-str (reg-fn state))))
    1.38 +  state)
    1.39 +
    1.40 +(defn view-memory [state mem]
    1.41 +  (println (format "mem 0x%04X = %s" mem
    1.42 +                   (binary-str (aget (memory state) mem))))
    1.43 +  state)
    1.44 +
    1.45 +(defn print-listing [state begin end]
    1.46 +  (dorun (map 
    1.47 +          (fn [opcode line]
    1.48 +            (println (format "0x%04X:  0x%02X" line opcode)))
    1.49 +          (subvec  (vec (memory state)) begin end)
    1.50 +          (range begin end)))
    1.51 +  state)
    1.52 +
    1.53 +(defn print-pc [state]
    1.54 +  (println (format "PC: 0x%04X" (PC state)))
    1.55 +  state)
    1.56 +
    1.57 +(defn print-op [state]
    1.58 +  (println (format "OP: 0x%02X" (aget (memory state) (PC state))))
    1.59 +  state)
    1.60 +
    1.61 +(defn d-tick
    1.62 +  ([state]
    1.63 +  (-> state print-pc print-op tick)))
    1.64 +
    1.65 +(defn print-interrupt
    1.66 +  [^SaveState state]
    1.67 +  (println (format "IE: %d" (IE state)))
    1.68 +  state)
    1.69 +
    1.70 +(defn set-memory
    1.71 +  ([state location value]
    1.72 +     (set-state! state)
    1.73 +     (let [mem (memory state)]
    1.74 +       (aset mem location value)
    1.75 +       (write-memory! mem)
    1.76 +       (update-state)))
    1.77 +  ([location value]
    1.78 +     (set-memory @current-state location value)))
    1.79 +
    1.80 +(defn set-memory-range
    1.81 +  ([state start values]
    1.82 +     (set-state! state)
    1.83 +     (let [mem (memory state)]
    1.84 +  
    1.85 +       (dorun (map (fn [index val]
    1.86 +                     (aset mem index val))
    1.87 +                   (range start
    1.88 +                          (+ start (count values))) values))
    1.89 +    (write-memory! mem)
    1.90 +    (update-state)))
    1.91 +  ([start values]
    1.92 +     (set-memory-range
    1.93 +      @current-state start values)))
    1.94 +
    1.95 +(defn common-differences [& seqs]
    1.96 +  (let [backbone (range (count (first seqs)))]
    1.97 +    (filter
    1.98 +     (comp (partial apply distinct?) second)
    1.99 +     (zipmap backbone
   1.100 +             (apply (partial map list) seqs)))))
   1.101 +
   1.102 +(defn mid-game []
   1.103 +  (read-state "mid-game"))