ocsenave@308: (ns com.aurellem.gb.mem-util
ocsenave@308:   (:use (com.aurellem.gb assembly characters gb-driver))
ocsenave@308:   (:import [com.aurellem.gb.gb_driver SaveState]))
ocsenave@308: 
ocsenave@308: 
ocsenave@308: 
ocsenave@308: 
ocsenave@308:   
ocsenave@308: (def hex-pc (comp hex PC))
ocsenave@308: 
ocsenave@308: (defn nstep [state n]
ocsenave@308:   (if (zero? n) state
ocsenave@308:       (recur (step state) (dec n))))
ocsenave@308: 
ocsenave@308: 
ocsenave@308: (defn view-memory*
ocsenave@308:   "View a region of indexable memory in the given state."
ocsenave@308:   [state start length]
ocsenave@308:   ((comp vec map)
ocsenave@308:    #((comp  aget) (memory state) %)
ocsenave@308:    (range start (+ start length))))
ocsenave@308: 
ocsenave@308: 
ocsenave@308: (defn pc-trail
ocsenave@308:   "Track the PC for a number of ticks."
ocsenave@308:   [state ticks]
ocsenave@308:   (tick state)
ocsenave@308:   (set-state! state)
ocsenave@308:   (loop [pcs [(PC)] ]
ocsenave@308:     (if (> (count pcs) ticks) pcs
ocsenave@308:         (do
ocsenave@308:           (com.aurellem.gb.Gb/tick)
ocsenave@308:           (recur (conj pcs (PC)))))))
ocsenave@308: 
ocsenave@308: 
ocsenave@308: (defn get-memory [state n]
ocsenave@308:   (aget (memory state) n))
ocsenave@308: 
ocsenave@308: (defn first-change
ocsenave@308:   "Watch the current memory location as it ticks,
ocsenave@308: return the first state that differs at location mem." 
ocsenave@308:   [state n]
ocsenave@308:   (tick state)
ocsenave@308:   (set-state! state)
ocsenave@308:   (let [init (aget (memory state) n)]
ocsenave@308:     (loop []
ocsenave@308:       (if (= (aget (memory) n) init)
ocsenave@308:         (do
ocsenave@308:           (com.aurellem.gb.Gb/tick)
ocsenave@308:           (recur))))
ocsenave@308:     (update-state)))
ocsenave@308: 
ocsenave@308: 
ocsenave@308: 
ocsenave@308: 
ocsenave@308: 
ocsenave@308: 
ocsenave@308: 
ocsenave@308: (defn differences 
ocsenave@308:   "Return the differences between the two lists as triples [index
ocsenave@308: (list-1 index) (list-2 index)]."
ocsenave@308: [list-1 list-2]
ocsenave@308:   (remove
ocsenave@308:    (fn [[a b c]] (= b c))
ocsenave@308:    (map vector
ocsenave@308:         (range)
ocsenave@308:         list-1
ocsenave@308:         list-2)))
ocsenave@308: 
ocsenave@308: (defn pc-diff
ocsenave@308:   "Return the differences between the program counter evolution
ocsenave@308: between the two states (measured for 10000 ticks)."
ocsenave@308:   [state-1 state-2]
ocsenave@308:   (differences (map hex (pc-trail state-1 10000))
ocsenave@308:                (map hex (pc-trail state-2 10000))))
ocsenave@308: 
ocsenave@308: 
ocsenave@308: (defn memory-diff [state-1 state-2]
ocsenave@308:   (remove
ocsenave@308:   (fn[[a b c]] (= b c))
ocsenave@308:   (map (comp vec (partial map hex) list)
ocsenave@308:        (range)
ocsenave@308:        (vec (memory state-1))
ocsenave@308:        (vec (memory state-2)))
ocsenave@308:   ))
ocsenave@308: 
ocsenave@308: 
ocsenave@308: (defn spell-array
ocsenave@308:   "Interpret the array as a string of printable Pokemon-text characters."
ocsenave@308:   [array start n]
ocsenave@308:   (character-codes->str
ocsenave@308:           (take n (drop start
ocsenave@308:                         (vec array)))))
ocsenave@308: 
ocsenave@308: (defn spell-memory
ocsenave@308:   "Interpret the indexable memory of the state as a string of printable
ocsenave@308: Pokemon-text characters. If no state is given, uses current-state."
ocsenave@308:   ([state mem n]
ocsenave@308:      (spell-array (memory state) mem n))
ocsenave@308:   ([mem n] (spell-array @current-state mem n)))
ocsenave@308: 
ocsenave@308: 
ocsenave@308: (defn sublist
ocsenave@308:   "Unshifts the list until the sublist is at the start."
ocsenave@308:   [list sub]
ocsenave@308:   (cond
ocsenave@308:     (empty? sub) list
ocsenave@308:     (empty? list) nil
ocsenave@308:     (= (take (count sub) list) sub) list
ocsenave@308:     :else (recur (rest list) sub)))
ocsenave@308: 
ocsenave@308: (defn find-sublist
ocsenave@308:   "Returns the position of the first occurence of sublist."
ocsenave@308:   [list sub]
ocsenave@308:   (loop [n 0 a list]
ocsenave@308:     (cond
ocsenave@308:       (empty? a) nil
ocsenave@308:       (= (take (count sub) a) sub) n
ocsenave@308:       :else (recur (inc n) (rest a)))))
ocsenave@308: 
ocsenave@308: (defn find-sublists
ocsenave@308:   "Returns a vector of the occurences of sublists."
ocsenave@308:   [list sub]
ocsenave@308:   (let [m (find-sublist list sub)]
ocsenave@308:     (if (nil? m) '()
ocsenave@308:         (cons m
ocsenave@308:               (map (partial + (inc m))
ocsenave@308:                    (find-sublists
ocsenave@308:                     (drop (inc m) list)
ocsenave@308:                     sub))))))
ocsenave@308: 
ocsenave@308: 
ocsenave@308: 
ocsenave@308: (defn search-memory
ocsenave@308:   "Search for the given codes in memory, returning short snippets of
ocsenave@308: text around the results."
ocsenave@308:   ([codes k]
ocsenave@308:      (search-memory com.aurellem.gb.gb-driver/original-rom codes k))
ocsenave@308:   ([array codes k]
ocsenave@308:      (map
ocsenave@308:       (fn [n]
ocsenave@308:         [(hex n)
ocsenave@308:          (take k (drop n rom))])
ocsenave@308:       
ocsenave@308:       (find-sublists
ocsenave@308:        rom
ocsenave@308:        codes))))
ocsenave@308: 
ocsenave@308: (defn spelling-bee
ocsenave@308:   "Search for the given string in ROM, returning short snippets of
ocsenave@308:   text around the results."
ocsenave@308:   ([str k]
ocsenave@308:      (spelling-bee com.aurellem.gb.gb-driver/original-rom str k))
ocsenave@308:   ([rom str k]
ocsenave@308:      (map
ocsenave@308:       (fn [[address snip]]
ocsenave@308:         [address (character-codes->str snip)])
ocsenave@308:         (search-memory rom (str->character-codes str) k))))
ocsenave@308:      
ocsenave@308: 
ocsenave@308: 
ocsenave@308: 
ocsenave@308: 
ocsenave@308: 
ocsenave@308: (defn rewrite-memory
ocsenave@308:   "Alter the vector of memory. Treats strings as lists of character
ocsenave@308: ops."
ocsenave@308:   ([mem start strs-or-ops]
ocsenave@308:      (let [x (first strs-or-ops)]
ocsenave@308:        (cond (empty? strs-or-ops) mem
ocsenave@308:              (string? x)
ocsenave@308:              
ocsenave@308:              (recur mem start
ocsenave@308:                     (concat
ocsenave@308:                      (str->character-codes x)
ocsenave@308:                      (rest strs-or-ops)))
ocsenave@308:         :else
ocsenave@308:         (recur
ocsenave@308:          (assoc mem start x)
ocsenave@308:          (inc start)
ocsenave@308:          (rest strs-or-ops))))))
ocsenave@308: 
ocsenave@308: 
ocsenave@308: (defn rewrite-rom
ocsenave@308:   "Alter the rom at the given location. Takes a list of
ocsenave@308: various strings/bytes as data."
ocsenave@308:   [start strs-or-bytes]
ocsenave@308:   ((partial rewrite-memory (vec (rom(root))))
ocsenave@308:    start strs-or-bytes))
ocsenave@308: 
ocsenave@308: (defn restore-rom! [] (write-rom! original-rom))
ocsenave@308: