(ns com.aurellem.gb.mem-util

   (:use (com.aurellem.gb assembly characters gb-driver))

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

 

 

 

 

   

 (def hex-pc (comp hex PC))

 

 (defn nstep [state n]

   (if (zero? n) state

       (recur (step state) (dec n))))

 

 

 (defn view-memory*

   "View a region of indexable memory in the given state."

   [state start length]

   ((comp vec map)

    #((comp  aget) (memory state) %)

    (range start (+ start length))))

 

 

 (defn pc-trail

   "Track the PC for a number of ticks."

   [state ticks]

   (tick state)

   (set-state! state)

   (loop [pcs [(PC)] ]

     (if (> (count pcs) ticks) pcs

         (do

           (com.aurellem.gb.Gb/tick)

           (recur (conj pcs (PC)))))))

 

 

 (defn get-memory [state n]

   (aget (memory state) n))

 

 (defn first-change

   "Watch the current memory location as it ticks,

 return the first state that differs at location mem." 

   [state n]

   (tick state)

   (set-state! state)

   (let [init (aget (memory state) n)]

     (loop []

       (if (= (aget (memory) n) init)

         (do

           (com.aurellem.gb.Gb/tick)

           (recur))))

     (update-state)))

 

 

 

 

 

 

 

 (defn differences 

   "Return the differences between the two lists as triples [index

 (list-1 index) (list-2 index)]."

 [list-1 list-2]

   (remove

    (fn [[a b c]] (= b c))

    (map vector

         (range)

         list-1

         list-2)))

 

 (defn pc-diff

   "Return the differences between the program counter evolution

 between the two states (measured for 10000 ticks)."

   [state-1 state-2]

   (differences (map hex (pc-trail state-1 10000))

                (map hex (pc-trail state-2 10000))))

 

 

 (defn memory-diff [state-1 state-2]

   (remove

   (fn[[a b c]] (= b c))

   (map (comp vec (partial map hex) list)

        (range)

        (vec (memory state-1))

        (vec (memory state-2)))

   ))

 

 

 (defn spell-array

   "Interpret the array as a string of printable Pokemon-text characters."

   [array start n]

   (character-codes->str

           (take n (drop start

                         (vec array)))))

 

 (defn spell-memory

   "Interpret the indexable memory of the state as a string of printable

 Pokemon-text characters. If no state is given, uses current-state."

   ([state mem n]

      (spell-array (memory state) mem n))

   ([mem n] (spell-array @current-state mem n)))

 

 

 (defn sublist

   "Unshifts the list until the sublist is at the start."

   [list sub]

   (cond

     (empty? sub) list

     (empty? list) nil

     (= (take (count sub) list) sub) list

     :else (recur (rest list) sub)))

 

 (defn find-sublist

   "Returns the position of the first occurence of sublist."

   [list sub]

   (loop [n 0 a list]

     (cond

       (empty? a) nil

       (= (take (count sub) a) sub) n

       :else (recur (inc n) (rest a)))))

 

 (defn find-sublists

   "Returns a vector of the occurences of sublists."

   [list sub]

   (let [m (find-sublist list sub)]

     (if (nil? m) '()

         (cons m

               (map (partial + (inc m))

                    (find-sublists

                     (drop (inc m) list)

                     sub))))))

 

 

 

 (defn search-memory

   "Search for the given codes in memory, returning short snippets of

 text around the results."

   ([codes k]

      (search-memory com.aurellem.gb.gb-driver/original-rom codes k))

   ([array codes k]

      (map

       (fn [n]

         [(hex n)

          (take k (drop n array))])

       

       (find-sublists

        array

        codes))))

 

 (defn spelling-bee

   "Search for the given string in ROM, returning short snippets of

   text around the results."

   ([str k]

      (spelling-bee com.aurellem.gb.gb-driver/original-rom str k))

   ([rom str k]

      (map

       (fn [[address snip]]

         [address (character-codes->str snip)])

         (search-memory rom (str->character-codes str) k))))

      

 

 

 

 

 

 (defn rewrite-memory

   "Alter the vector of memory. Treats strings as lists of character

 ops."

   ([mem start strs-or-ops]

      (let [x (first strs-or-ops)]

        (cond (empty? strs-or-ops) mem

              (string? x)

              

              (recur mem start

                     (concat

                      (str->character-codes x)

                      (rest strs-or-ops)))

         :else

         (recur

          (assoc mem start x)

          (inc start)

          (rest strs-or-ops))))))

 

 

 (defn rewrite-rom

   "Alter the rom at the given location. Takes a list of

 various strings/bytes as data."

   [start strs-or-bytes]

   ((partial rewrite-memory (vec (rom(root))))

    start strs-or-bytes))

 

 (defn restore-rom! [] (write-rom! original-rom))

 

 

 (defn endian-flip

   "Flip the bytes of the two-byte number."

   [n]

   (assert (< n 0xFFFF))

   (+ (* 0x100 (rem n 0x100))

         (int (/ n 0x100))))

 

 

 (defn offset->ptr

   "Convert an offset into a little-endian pointer."

   [n]

   (->

    n

    (rem 0x10000) ;; take last four bytes

    (rem 0x4000)   ;; get relative offset from the start of the bank

    (+ 0x4000)

    endian-flip))

 

 (defn offset->bank

   "Get the bank of the offset."

   [n]

   (int (/ n 0x4000)))

 

 (defn ptr->offset

   "Convert a two-byte little-endian pointer into an offset."

   [bank ptr]

   (->

    ptr

    endian-flip

    (- 0x4000)

    (+ (* 0x4000 bank))

    ))

 

 (defn same-bank-offset

   "Convert a ptr into an absolute offset by using the bank of the reference."

   [reference ptr]

   (ptr->offset

    (offset->bank reference)

    ptr))