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@417: (defn A
rlm@417:   ([state]
rlm@417:      (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))
rlm@417:   ([] (A @current-state)))
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: 
ocsenave@288: (defn bit-list
ocsenave@288:   "List the bits of n in order of decreasing significance."
ocsenave@288:   [n]
ocsenave@288:   ((fn this [coll n]
ocsenave@288:      (if (zero? n) coll
ocsenave@288:          (recur
ocsenave@288:           (conj coll (rem n 2))
ocsenave@288:           (int (/ n 2)))))
ocsenave@288:    [] n))
ocsenave@288: 
ocsenave@288: 
ocsenave@288: (defn low-high
ocsenave@288:   [low high]
ocsenave@288:   (+ low (* 256 high)))
ocsenave@288:   
ocsenave@288: 
ocsenave@288: (defn format-name
ocsenave@288:   "Convert the string of alphabetic/space characters into a keyword by
ocsenave@288:   replacing spaces with hyphens and converting to lowercase."
ocsenave@288:   [s]
ocsenave@288:   (if (nil? s) nil
ocsenave@288:       (keyword (.toLowerCase
ocsenave@288:                 (apply str
ocsenave@288:                        (map #(if (= % \space) "-" %) s))))))
ocsenave@288: 
ocsenave@288: 
ocsenave@288: ;; used to decode item prices
ocsenave@288: 
ocsenave@288: (defn decode-bcd
ocsenave@288:   "Take a sequence of binary-coded digits (in written order) and return the number they represent."
ocsenave@288:   [digits]
ocsenave@288:   ((fn self [coll]
ocsenave@288:      (if (empty? coll) 0
ocsenave@288:          (+ (first coll) (* 100 (self (rest coll))))))
ocsenave@288:    (map
ocsenave@288:     #(+ (* 10 (int (/ % 16)))
ocsenave@288:         (rem % 16))
ocsenave@288:     (reverse digits))))
ocsenave@288: 
ocsenave@288: 
ocsenave@288:   
ocsenave@273: 
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@247:                (println (format "0x%04X: 0x%02X %s %d"
rlm@247:                                 line
rlm@247:                                 opcode (binary-str opcode)
rlm@247:                                 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@417:   ([] (d-tick 1))
rlm@417:   ([n] (d-tick n @current-state))
rlm@417:   ([n state]
rlm@417:      (reduce (fn [state _]
rlm@417:                (-> state print-pc print-op tick))
rlm@417:              state (range n))))
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@314:     (sort-by
rlm@314:      first
rlm@314:      (filter
rlm@314:       (comp (partial apply distinct?) second)
rlm@314:       (zipmap backbone
rlm@314:               (apply (partial map list) seqs))))))
rlm@145: 
rlm@316: (defn memory-compare [& states]
rlm@212:   (apply common-differences
rlm@212:          (map (comp vec memory)
rlm@212:               states)))
rlm@212: 
rlm@320: (defn different-every-time [& seqs]
rlm@320:   (let [backbone (range (count (first seqs)))]
rlm@320:     (sort-by
rlm@320:      first
rlm@320:      (filter
rlm@321:       (comp (fn [seq] (not (contains? (set (map - seq (rest seq)))
rlm@321:                                       0))) second)
rlm@320:       (zipmap backbone
rlm@320:               (apply (partial map list) seqs))))))
rlm@320: 
rlm@320: 
rlm@320: (defn harmonic-compare [& states]
rlm@320:   (apply different-every-time
rlm@320:          (map (comp vec memory)
rlm@320:               states)))
rlm@320: 
rlm@145: (defn mid-game []
rlm@145:   (read-state "mid-game"))
rlm@154: 
rlm@321: (defn watch-memory
rlm@321:   ([^SaveState state address]
rlm@321:      (set-state! state)
rlm@321:      (loop [] (step) (view-memory address) (recur)))
rlm@321:   ([address] (watch-memory @current-state address)))
rlm@321: 
rlm@321: (defn watch-fn
rlm@321:   ([^SaveState state state-fn]
rlm@321:      (set-state! state)
rlm@321:      (loop [] (step) (state-fn @current-state) (recur)))
rlm@321:   ([state-fn] (watch-fn @current-state state-fn)))
rlm@192: 
rlm@192: (defn disect-bytes-2
rlm@192:   "return a vector consiting of the last 16 bytes of the
ocsenave@273:    integer expressed as two 8 bit numbers (inside an integer)
ocsenave@273:    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: (defn print-D-memory
rlm@222:   ([^SaveState state]
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:   
rlm@301: 
rlm@301: (defn signed-8-bits
rlm@301:   "the lower 8 bits of an integer interpreted as a signed 8
rlm@301:    bit number"
rlm@301:   [n]
rlm@301:   (let [lower-seven (bit-and n 127)]
rlm@301:     (if (bit-test n 7)
rlm@303:       (- lower-seven 128)
rlm@301:       lower-seven)))
rlm@377: 
rlm@377: 
rlm@377: (defn capture-program-counter
rlm@377:   "records the program counter for each tick"
rlm@377:   [^SaveState state ticks]
rlm@377:   (let [i (atom 0)]
rlm@377:     (reduce (fn [[program-counters state] _]
rlm@377:               (swap! i inc)
rlm@377:               (if (= (rem @i 1000) 0) (println @i))
rlm@377:                [(conj program-counters (PC state))
rlm@377:                 (tick state)])
rlm@377:               [[] state]
rlm@377:               (range ticks))))
rlm@377: 
rlm@377: (defn capture-program-counter
rlm@377:   "Records the program counter for each tick"
rlm@377:   [^SaveState state ticks]
rlm@377:   (tick state)
rlm@377:   
rlm@377:   (loop [i 0
rlm@377:          pcs []]
rlm@377:     (if (= i ticks)
rlm@377:       (filter (partial < 0x2000)(sort (set pcs)))
rlm@377:       (do 
rlm@377:         (com.aurellem.gb.Gb/tick)
rlm@377:         (recur (inc i)
rlm@377:                (conj pcs (first (registers))))))))
rlm@377: