(ns com.aurellem.gb.util

   (:use (com.aurellem.gb gb-driver vbm constants))

   (:import java.io.File)

   (:import [com.aurellem.gb.gb_driver SaveState]))

 

 (defn A

   ([state]

      (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))

   ([] (A @current-state)))

 

 (defn B [state]

   (bit-shift-right (bit-and 0x0000FF00 (BC state)) 8))

 

 (defn D [state]

   (bit-shift-right (bit-and 0x0000FF00 (DE state)) 8))

 

 (defn H [state]

   (bit-shift-right (bit-and 0x0000FF00 (HL state)) 8))

 

 (defn C [state]

   (bit-and 0xFF (BC state)))

 (defn F [state]

   (bit-and 0xFF (AF state)))

 (defn E [state]

   (bit-and 0xFF (DE state)))

 (defn L [state]

   (bit-and 0xFF (HL state)))

 

 (defn binary-str [num]

   (format "%08d"

           (Integer/parseInt

            (Integer/toBinaryString num) 10)))

 

 (defn bit-list

   "List the bits of n in order of decreasing significance."

   [n]

   ((fn this [coll n]

      (if (zero? n) coll

          (recur

           (conj coll (rem n 2))

           (int (/ n 2)))))

    [] n))

 

 

 (defn low-high

   [low high]

   (+ low (* 256 high)))

   

 

 (defn format-name

   "Convert the string of alphabetic/space characters into a keyword by

   replacing spaces with hyphens and converting to lowercase."

   [s]

   (if (nil? s) nil

       (keyword (.toLowerCase

                 (apply str

                        (map #(if (= % \space) "-" %) s))))))

 

 

 ;; used to decode item prices

 

 (defn decode-bcd

   "Take a sequence of binary-coded digits (in written order) and return the number they represent."

   [digits]

   ((fn self [coll]

      (if (empty? coll) 0

          (+ (first coll) (* 100 (self (rest coll))))))

    (map

     #(+ (* 10 (int (/ % 16)))

         (rem % 16))

     (reverse digits))))

 

 

   

 

 (defn view-register [state name reg-fn]

   (println (format "%s: %s" name

                    (binary-str (reg-fn state))))

   state)

 

 (defn view-memory

   ([^SaveState state mem]

      (let [val (aget (memory state) mem)]

        (println (format "0x%04X = %s 0x%02X %d" mem

                         (binary-str val) val val)))

      state)

   ([mem]

      (view-memory @current-state mem)))

 

 (defn print-listing

   ([^SaveState state begin end]

      (dorun (map 

              (fn [opcode line]

                (println (format "0x%04X: 0x%02X %s %d"

                                 line

                                 opcode (binary-str opcode)

                                 opcode)))

              (subvec  (vec (memory state)) begin end)

              (range begin end)))

      state)

   ([begin end]

      (print-listing @current-state begin end)))

 

 (defn print-pc

   ([^SaveState state]

      (println (format "PC: 0x%04X" (PC state)))

      state)

   ([] (print-pc @current-state))) 

 

 (defn print-op

   ([^SaveState state]

      (println (format "OP: 0x%02X" (aget (memory state) (PC state))))

      state)

   ([] (print-op @current-state)))

 

 (defn d-tick

   ([] (d-tick 1))

   ([n] (d-tick n @current-state))

   ([n state]

      (reduce (fn [state _]

                (-> state print-pc print-op tick))

              state (range n))))

 

 (defn print-interrupt

   [^SaveState state]

   (println (format "IE: %d" (IE state)))

   state)

 

 (defn set-memory

   ([state location value]

      (set-state! state)

      (let [mem (memory state)]

        (aset mem location value)

        (write-memory! mem)

        (update-state)))

   ([location value]

      (set-memory @current-state location value)))

 

 (defn set-memory-range

   ([state start values]

      (set-state! state)

      (let [mem (memory state)]

   

        (dorun (map (fn [index val]

                      (aset mem index val))

                    (range start

                           (+ start (count values))) values))

     (write-memory! mem)

     (update-state)))

   ([start values]

      (set-memory-range

       @current-state start values)))

 

 (defn common-differences [& seqs]

   (let [backbone (range (count (first seqs)))]

     (sort-by

      first

      (filter

       (comp (partial apply distinct?) second)

       (zipmap backbone

               (apply (partial map list) seqs))))))

 

 (defn memory-compare [& states]

   (apply common-differences

          (map (comp vec memory)

               states)))

 

 (defn different-every-time [& seqs]

   (let [backbone (range (count (first seqs)))]

     (sort-by

      first

      (filter

       (comp (fn [seq] (not (contains? (set (map - seq (rest seq)))

                                       0))) second)

       (zipmap backbone

               (apply (partial map list) seqs))))))

 

 

 (defn harmonic-compare [& states]

   (apply different-every-time

          (map (comp vec memory)

               states)))

 

 (defn mid-game []

   (read-state "mid-game"))

 

 (defn watch-memory

   ([^SaveState state address]

      (set-state! state)

      (loop [] (step) (view-memory address) (recur)))

   ([address] (watch-memory @current-state address)))

 

 (defn watch-fn

   ([^SaveState state state-fn]

      (set-state! state)

      (loop [] (step) (state-fn @current-state) (recur)))

   ([state-fn] (watch-fn @current-state state-fn)))

 

 (defn disect-bytes-2

   "return a vector consiting of the last 16 bytes of the

    integer expressed as two 8 bit numbers (inside an integer)

    in the form [high-bits low-bits]."

   [num]

   [(bit-shift-right

     (bit-and num 0xFF00) 8)

    (bit-and num 0xFF)])

 

 (defn disect-bytes-3

   "same as disect-bytes-2 except that it assumes the input is a

    24 bit number and returns [high-bits medium-bits low-bits]"

   [num]

   (vec

    (concat 

     [(bit-shift-right (bit-and num 0xFF0000) 16)]

     (disect-bytes-2 num))))

 

 (defn glue-bytes

   "Given two or three 8-bit numbers inside 32-bit integers,

    combine them into the integer number that they together

    represent."

   ([h l]

      (+ l (bit-shift-left h 8)))

 

   ([h m l]

      (+ (glue-bytes m l)

         (bit-shift-left h 16))))

 

 (def cartography

   (File. user-home

          "proj/vba-clojure/clojure/com/aurellem/exp/cartography"))

 

 (defn print-D-memory

   ([^SaveState state]

      (let [descriptions

            (clojure.string/split-lines

             (slurp cartography))]

        (dorun

         (map

          (fn [line data desc]

            (printf "%04X  %02X%s\n"

                    line data (apply str

                                     (drop 20 desc))))

          (range pokemon-record-begin

                 (inc D-memory-end))

          

          (subvec (vec (memory state))

                  pokemon-record-begin

                  (inc D-memory-end))

          descriptions))))

   ([] (print-D-memory @current-state)))

   

 

 (defn signed-8-bits

   "the lower 8 bits of an integer interpreted as a signed 8

    bit number"

   [n]

   (let [lower-seven (bit-and n 127)]

     (if (bit-test n 7)

       (- lower-seven 128)

       lower-seven)))

 

 

 (defn capture-program-counter

   "records the program counter for each tick"

   [^SaveState state ticks]

   (let [i (atom 0)]

     (reduce (fn [[program-counters state] _]

               (swap! i inc)

               (if (= (rem @i 1000) 0) (println @i))

                [(conj program-counters (PC state))

                 (tick state)])

               [[] state]

               (range ticks))))

 

 (defn capture-program-counter

   "Records the program counter for each tick"

   [^SaveState state ticks]

   (tick state)

   

   (loop [i 0

          pcs []]

     (if (= i ticks)

       (filter (partial < 0x2000)(sort (set pcs)))

       (do 

         (com.aurellem.gb.Gb/tick)

         (recur (inc i)

                (conj pcs (first (registers))))))))