1.1 --- a/clojure/com/aurellem/gb/hxc.clj	Sat Mar 31 03:54:21 2012 -0500
     1.2 +++ b/clojure/com/aurellem/gb/hxc.clj	Sat Mar 31 04:25:49 2012 -0500
     1.3 @@ -1,7 +1,6 @@
     1.4  (ns com.aurellem.gb.hxc
     1.5 -  (:use (com.aurellem.gb assembly characters gb-driver util
     1.6 +  (:use (com.aurellem.gb assembly characters gb-driver util mem-util
     1.7                           constants species))
     1.8 -  (:use (com.aurellem.world practice))
     1.9    (:import [com.aurellem.gb.gb_driver SaveState]))
    1.10  
    1.11  
    1.12 @@ -211,7 +210,7 @@
    1.13  ;; http://hax.iimarck.us/topic/581/
    1.14  (defn hxc-cry
    1.15    "The pokemon cry data in internal order. List begins at ROM@39462"
    1.16 -  ([](hxc-cry com.aurellem.gb.gb-driver/original-rom)
    1.17 +  ([](hxc-cry com.aurellem.gb.gb-driver/original-rom))
    1.18    ([rom]
    1.19       (zipmap
    1.20        (hxc-pokenames rom)
    1.21 @@ -222,16 +221,16 @@
    1.22            :length length}
    1.23           )
    1.24         (partition 3
    1.25 -                  (drop 0x39462 rom)))))))
    1.26 +                  (drop 0x39462 rom))))))
    1.27  
    1.28  (defn hxc-cry-groups
    1.29 -  ([] (hxc-cry-ids com.aurellem.gb.gb-driver/original-rom))
    1.30 +  ([] (hxc-cry-groups com.aurellem.gb.gb-driver/original-rom))
    1.31    ([rom]
    1.32       (map #(mapv first
    1.33                  (filter
    1.34                   (fn [[k v]]
    1.35                     (= % (:cry-id v)))
    1.36 -                 (hxc-cry rom)))
    1.37 +                 (hxc-cry)))
    1.38            ((comp
    1.39              range
    1.40              count

     2.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2 +++ b/clojure/com/aurellem/gb/mem_util.clj	Sat Mar 31 04:25:49 2012 -0500
     2.3 @@ -0,0 +1,192 @@
     2.4 +(ns com.aurellem.gb.mem-util
     2.5 +  (:use (com.aurellem.gb assembly characters gb-driver))
     2.6 +  (:import [com.aurellem.gb.gb_driver SaveState]))
     2.7 +
     2.8 +
     2.9 +
    2.10 +
    2.11 +  
    2.12 +(def hex-pc (comp hex PC))
    2.13 +
    2.14 +(defn nstep [state n]
    2.15 +  (if (zero? n) state
    2.16 +      (recur (step state) (dec n))))
    2.17 +
    2.18 +
    2.19 +(defn view-memory*
    2.20 +  "View a region of indexable memory in the given state."
    2.21 +  [state start length]
    2.22 +  ((comp vec map)
    2.23 +   #((comp  aget) (memory state) %)
    2.24 +   (range start (+ start length))))
    2.25 +
    2.26 +
    2.27 +(defn pc-trail
    2.28 +  "Track the PC for a number of ticks."
    2.29 +  [state ticks]
    2.30 +  (tick state)
    2.31 +  (set-state! state)
    2.32 +  (loop [pcs [(PC)] ]
    2.33 +    (if (> (count pcs) ticks) pcs
    2.34 +        (do
    2.35 +          (com.aurellem.gb.Gb/tick)
    2.36 +          (recur (conj pcs (PC)))))))
    2.37 +
    2.38 +
    2.39 +(defn get-memory [state n]
    2.40 +  (aget (memory state) n))
    2.41 +
    2.42 +(defn first-change
    2.43 +  "Watch the current memory location as it ticks,
    2.44 +return the first state that differs at location mem." 
    2.45 +  [state n]
    2.46 +  (tick state)
    2.47 +  (set-state! state)
    2.48 +  (let [init (aget (memory state) n)]
    2.49 +    (loop []
    2.50 +      (if (= (aget (memory) n) init)
    2.51 +        (do
    2.52 +          (com.aurellem.gb.Gb/tick)
    2.53 +          (recur))))
    2.54 +    (update-state)))
    2.55 +
    2.56 +
    2.57 +
    2.58 +
    2.59 +
    2.60 +
    2.61 +
    2.62 +(defn differences 
    2.63 +  "Return the differences between the two lists as triples [index
    2.64 +(list-1 index) (list-2 index)]."
    2.65 +[list-1 list-2]
    2.66 +  (remove
    2.67 +   (fn [[a b c]] (= b c))
    2.68 +   (map vector
    2.69 +        (range)
    2.70 +        list-1
    2.71 +        list-2)))
    2.72 +
    2.73 +(defn pc-diff
    2.74 +  "Return the differences between the program counter evolution
    2.75 +between the two states (measured for 10000 ticks)."
    2.76 +  [state-1 state-2]
    2.77 +  (differences (map hex (pc-trail state-1 10000))
    2.78 +               (map hex (pc-trail state-2 10000))))
    2.79 +
    2.80 +
    2.81 +(defn memory-diff [state-1 state-2]
    2.82 +  (remove
    2.83 +  (fn[[a b c]] (= b c))
    2.84 +  (map (comp vec (partial map hex) list)
    2.85 +       (range)
    2.86 +       (vec (memory state-1))
    2.87 +       (vec (memory state-2)))
    2.88 +  ))
    2.89 +
    2.90 +
    2.91 +(defn spell-array
    2.92 +  "Interpret the array as a string of printable Pokemon-text characters."
    2.93 +  [array start n]
    2.94 +  (character-codes->str
    2.95 +          (take n (drop start
    2.96 +                        (vec array)))))
    2.97 +
    2.98 +(defn spell-memory
    2.99 +  "Interpret the indexable memory of the state as a string of printable
   2.100 +Pokemon-text characters. If no state is given, uses current-state."
   2.101 +  ([state mem n]
   2.102 +     (spell-array (memory state) mem n))
   2.103 +  ([mem n] (spell-array @current-state mem n)))
   2.104 +
   2.105 +
   2.106 +(defn sublist
   2.107 +  "Unshifts the list until the sublist is at the start."
   2.108 +  [list sub]
   2.109 +  (cond
   2.110 +    (empty? sub) list
   2.111 +    (empty? list) nil
   2.112 +    (= (take (count sub) list) sub) list
   2.113 +    :else (recur (rest list) sub)))
   2.114 +
   2.115 +(defn find-sublist
   2.116 +  "Returns the position of the first occurence of sublist."
   2.117 +  [list sub]
   2.118 +  (loop [n 0 a list]
   2.119 +    (cond
   2.120 +      (empty? a) nil
   2.121 +      (= (take (count sub) a) sub) n
   2.122 +      :else (recur (inc n) (rest a)))))
   2.123 +
   2.124 +(defn find-sublists
   2.125 +  "Returns a vector of the occurences of sublists."
   2.126 +  [list sub]
   2.127 +  (let [m (find-sublist list sub)]
   2.128 +    (if (nil? m) '()
   2.129 +        (cons m
   2.130 +              (map (partial + (inc m))
   2.131 +                   (find-sublists
   2.132 +                    (drop (inc m) list)
   2.133 +                    sub))))))
   2.134 +
   2.135 +
   2.136 +
   2.137 +(defn search-memory
   2.138 +  "Search for the given codes in memory, returning short snippets of
   2.139 +text around the results."
   2.140 +  ([codes k]
   2.141 +     (search-memory com.aurellem.gb.gb-driver/original-rom codes k))
   2.142 +  ([array codes k]
   2.143 +     (map
   2.144 +      (fn [n]
   2.145 +        [(hex n)
   2.146 +         (take k (drop n rom))])
   2.147 +      
   2.148 +      (find-sublists
   2.149 +       rom
   2.150 +       codes))))
   2.151 +
   2.152 +(defn spelling-bee
   2.153 +  "Search for the given string in ROM, returning short snippets of
   2.154 +  text around the results."
   2.155 +  ([str k]
   2.156 +     (spelling-bee com.aurellem.gb.gb-driver/original-rom str k))
   2.157 +  ([rom str k]
   2.158 +     (map
   2.159 +      (fn [[address snip]]
   2.160 +        [address (character-codes->str snip)])
   2.161 +        (search-memory rom (str->character-codes str) k))))
   2.162 +     
   2.163 +
   2.164 +
   2.165 +
   2.166 +
   2.167 +
   2.168 +(defn rewrite-memory
   2.169 +  "Alter the vector of memory. Treats strings as lists of character
   2.170 +ops."
   2.171 +  ([mem start strs-or-ops]
   2.172 +     (let [x (first strs-or-ops)]
   2.173 +       (cond (empty? strs-or-ops) mem
   2.174 +             (string? x)
   2.175 +             
   2.176 +             (recur mem start
   2.177 +                    (concat
   2.178 +                     (str->character-codes x)
   2.179 +                     (rest strs-or-ops)))
   2.180 +        :else
   2.181 +        (recur
   2.182 +         (assoc mem start x)
   2.183 +         (inc start)
   2.184 +         (rest strs-or-ops))))))
   2.185 +
   2.186 +
   2.187 +(defn rewrite-rom
   2.188 +  "Alter the rom at the given location. Takes a list of
   2.189 +various strings/bytes as data."
   2.190 +  [start strs-or-bytes]
   2.191 +  ((partial rewrite-memory (vec (rom(root))))
   2.192 +   start strs-or-bytes))
   2.193 +
   2.194 +(defn restore-rom! [] (write-rom! original-rom))
   2.195 +

     3.1 --- a/clojure/com/aurellem/world/practice.clj	Sat Mar 31 03:54:21 2012 -0500
     3.2 +++ b/clojure/com/aurellem/world/practice.clj	Sat Mar 31 04:25:49 2012 -0500
     3.3 @@ -1,5 +1,5 @@
     3.4  (ns com.aurellem.world.practice
     3.5 - (:use (com.aurellem.gb saves util constants gb-driver vbm items assembly characters))
     3.6 + (:use (com.aurellem.gb saves util mem-util constants gb-driver vbm items assembly characters))
     3.7   (:use (com.aurellem.exp pokemon))
     3.8   (:use (com.aurellem.exp item-bridge))
     3.9   (:import [com.aurellem.gb.gb_driver SaveState]))
    3.10 @@ -7,22 +7,6 @@
    3.11  
    3.12  ;;(def original-rom (rom(root)))
    3.13  
    3.14 -
    3.15 -(def hex-pc (comp hex PC))
    3.16 -
    3.17 -(defn nstep [state n]
    3.18 -  (if (zero? n) state
    3.19 -      (recur (step state) (dec n))))
    3.20 -
    3.21 -
    3.22 -(defn view-memory*
    3.23 -  "View a region of indexable memory in the given state."
    3.24 -  [state start length]
    3.25 -  ((comp vec map)
    3.26 -   #((comp  aget) (memory state) %)
    3.27 -   (range start (+ start length))))
    3.28 -
    3.29 -
    3.30  (defn state-surprise
    3.31    "This is one tick before the trainer goes [!]"
    3.32    []
    3.33 @@ -47,40 +31,6 @@
    3.34  
    3.35  
    3.36  
    3.37 -(defn pc-trail
    3.38 -  "Track the PC for a number of ticks."
    3.39 -  [state ticks]
    3.40 -  (tick state)
    3.41 -  (set-state! state)
    3.42 -  (loop [pcs [(PC)] ]
    3.43 -    (if (> (count pcs) ticks) pcs
    3.44 -        (do
    3.45 -          (com.aurellem.gb.Gb/tick)
    3.46 -          (recur (conj pcs (PC)))))))
    3.47 -
    3.48 -
    3.49 -
    3.50 -(defn differences [list-1 list-2]
    3.51 -  (remove
    3.52 -   (fn [[a b c]] (= b c))
    3.53 -   (map vector
    3.54 -        (range)
    3.55 -        list-1
    3.56 -        list-2)))
    3.57 -
    3.58 -(defn pc-diff [state-1 state-2]
    3.59 -  (differences (map hex (pc-trail state-1 10000))
    3.60 -               (map hex (pc-trail state-2 10000))))
    3.61 -
    3.62 -
    3.63 -(defn memory-diff [state-1 state-2]
    3.64 -  (remove
    3.65 -  (fn[[a b c]] (= b c))
    3.66 -  (map (comp vec (partial map hex) list)
    3.67 -       (range)
    3.68 -       (vec (memory state-1))
    3.69 -       (vec (memory state-2)))
    3.70 -   ))
    3.71  
    3.72  
    3.73  
    3.74 @@ -106,36 +56,7 @@
    3.75    
    3.76    
    3.77  
    3.78 -(defn get-memory [state n]
    3.79 -  (aget (memory state) n))
    3.80  
    3.81 -(defn first-change
    3.82 -  "Watch the current memory location as it ticks,
    3.83 -return the first state that differs at location mem." 
    3.84 -  [state n]
    3.85 -  (tick state)
    3.86 -  (set-state! state)
    3.87 -  (let [init (aget (memory state) n)]
    3.88 -    (loop []
    3.89 -      (if (= (aget (memory) n) init)
    3.90 -        (do
    3.91 -          (com.aurellem.gb.Gb/tick)
    3.92 -          (recur))))
    3.93 -    (update-state)))
    3.94 -
    3.95 -
    3.96 -
    3.97 -
    3.98 -(defn spell-array
    3.99 -  [array mem n]
   3.100 -  (character-codes->str
   3.101 -          (take n (drop mem
   3.102 -                        (vec array)))))
   3.103 -
   3.104 -(defn spell
   3.105 -  ([state mem n]
   3.106 -     (spell (memory state) mem n))
   3.107 -  ([mem n] (spell @current-state mem n)))
   3.108  
   3.109  
   3.110  
   3.111 @@ -151,63 +72,6 @@
   3.112  (def surprise-words
   3.113    [0x80 0xAB 0xAB 0x7F 0xB1 0xA8 0xA6 0xA7 0xB3 0xE7 0x7F 0x8B 0xA4 0xB3 0xE0 0xB2 0x7F 0xB1 0xAE 0xAB 0xAB 0x7F 0xB3 0xA7 0xA4 0x7F 0xA3 0xA8 0xA2 0xA4 0xE7])
   3.114  
   3.115 -(defn sublist
   3.116 -  "Unshifts the list until the sublist is at the start."
   3.117 -  [list sub]
   3.118 -  (cond
   3.119 -    (empty? sub) list
   3.120 -    (empty? list) nil
   3.121 -    (= (take (count sub) list) sub) list
   3.122 -    :else (recur (rest list) sub)))
   3.123 -
   3.124 -(defn find-sublist
   3.125 -  "Returns the position of the first occurence of sublist."
   3.126 -  [list sub]
   3.127 -  (loop [n 0 a list]
   3.128 -    (cond
   3.129 -      (empty? a) nil
   3.130 -      (= (take (count sub) a) sub) n
   3.131 -      :else (recur (inc n) (rest a)))))
   3.132 -
   3.133 -(defn find-sublists
   3.134 -  "Returns a vector of the occurences of sublists."
   3.135 -  [list sub]
   3.136 -  (let [m (find-sublist list sub)]
   3.137 -    (if (nil? m) '()
   3.138 -        (cons m
   3.139 -              (map (partial + (inc m))
   3.140 -                   (find-sublists
   3.141 -                    (drop (inc m) list)
   3.142 -                    sub))))))
   3.143 -
   3.144 -
   3.145 -
   3.146 -(defn search-rom
   3.147 -  "Search for the given codes in ROM, returning short snippets of
   3.148 -text around the results."
   3.149 -  ([codes k]
   3.150 -     (search-rom com.aurellem.gb.gb-driver/original-rom codes k))
   3.151 -  ([rom codes k]
   3.152 -     (map
   3.153 -      (fn [n]
   3.154 -        [(hex n)
   3.155 -         (take k (drop n rom))])
   3.156 -      
   3.157 -      (find-sublists
   3.158 -       rom
   3.159 -       codes))))
   3.160 -
   3.161 -(defn spelling-bee
   3.162 -  "Search for the given string in ROM, returning short snippets of
   3.163 -  text around the results."
   3.164 -  ([str k]
   3.165 -     (spelling-bee com.aurellem.gb.gb-driver/original-rom str k))
   3.166 -  ([rom str k]
   3.167 -     (map
   3.168 -      (fn [[address snip]]
   3.169 -        [address (character-codes->str snip)])
   3.170 -        (search-rom rom (str->character-codes str) k))))
   3.171 -     
   3.172  
   3.173  
   3.174  
   3.175 @@ -231,30 +95,9 @@
   3.176  
   3.177  
   3.178  
   3.179 -(defn rewrite-memory
   3.180 -  "Alters the vector of memory. Treats strings as lists of character
   3.181 -ops."
   3.182 -  ([mem start strs-or-ops]
   3.183 -     (let [x (first strs-or-ops)]
   3.184 -       (cond (empty? strs-or-ops) mem
   3.185 -             (string? x)
   3.186 -             
   3.187 -             (recur mem start
   3.188 -                    (concat
   3.189 -                     (str->character-codes x)
   3.190 -                     (rest strs-or-ops)))
   3.191 -        :else
   3.192 -        (recur
   3.193 -         (assoc mem start x)
   3.194 -         (inc start)
   3.195 -         (rest strs-or-ops))))))
   3.196  
   3.197 -(def rewrite-rom
   3.198 -  "Alters the ROM array using write-memory. Takes a list of
   3.199 -various strings/bytes as data."
   3.200 -  (partial rewrite-memory (vec (rom(root)))))
   3.201  
   3.202 -(defn restore-rom! [] (write-rom! original-rom))
   3.203 +
   3.204  
   3.205  
   3.206