ocsenave@308
|
1 (ns com.aurellem.gb.mem-util
|
ocsenave@308
|
2 (:use (com.aurellem.gb assembly characters gb-driver))
|
ocsenave@308
|
3 (:import [com.aurellem.gb.gb_driver SaveState]))
|
ocsenave@308
|
4
|
ocsenave@308
|
5
|
ocsenave@308
|
6
|
ocsenave@308
|
7
|
ocsenave@308
|
8
|
ocsenave@308
|
9 (def hex-pc (comp hex PC))
|
ocsenave@308
|
10
|
ocsenave@308
|
11 (defn nstep [state n]
|
ocsenave@308
|
12 (if (zero? n) state
|
ocsenave@308
|
13 (recur (step state) (dec n))))
|
ocsenave@308
|
14
|
ocsenave@308
|
15
|
ocsenave@308
|
16 (defn view-memory*
|
ocsenave@308
|
17 "View a region of indexable memory in the given state."
|
ocsenave@308
|
18 [state start length]
|
ocsenave@308
|
19 ((comp vec map)
|
ocsenave@308
|
20 #((comp aget) (memory state) %)
|
ocsenave@308
|
21 (range start (+ start length))))
|
ocsenave@308
|
22
|
ocsenave@308
|
23
|
ocsenave@308
|
24 (defn pc-trail
|
ocsenave@308
|
25 "Track the PC for a number of ticks."
|
ocsenave@308
|
26 [state ticks]
|
ocsenave@308
|
27 (tick state)
|
ocsenave@308
|
28 (set-state! state)
|
ocsenave@308
|
29 (loop [pcs [(PC)] ]
|
ocsenave@308
|
30 (if (> (count pcs) ticks) pcs
|
ocsenave@308
|
31 (do
|
ocsenave@308
|
32 (com.aurellem.gb.Gb/tick)
|
ocsenave@308
|
33 (recur (conj pcs (PC)))))))
|
ocsenave@308
|
34
|
ocsenave@308
|
35
|
ocsenave@308
|
36 (defn get-memory [state n]
|
ocsenave@308
|
37 (aget (memory state) n))
|
ocsenave@308
|
38
|
ocsenave@308
|
39 (defn first-change
|
ocsenave@308
|
40 "Watch the current memory location as it ticks,
|
ocsenave@308
|
41 return the first state that differs at location mem."
|
ocsenave@308
|
42 [state n]
|
ocsenave@308
|
43 (tick state)
|
ocsenave@308
|
44 (set-state! state)
|
ocsenave@308
|
45 (let [init (aget (memory state) n)]
|
ocsenave@308
|
46 (loop []
|
ocsenave@308
|
47 (if (= (aget (memory) n) init)
|
ocsenave@308
|
48 (do
|
ocsenave@308
|
49 (com.aurellem.gb.Gb/tick)
|
ocsenave@308
|
50 (recur))))
|
ocsenave@308
|
51 (update-state)))
|
ocsenave@308
|
52
|
ocsenave@308
|
53
|
ocsenave@308
|
54
|
ocsenave@308
|
55
|
ocsenave@308
|
56
|
ocsenave@308
|
57
|
ocsenave@308
|
58
|
ocsenave@308
|
59 (defn differences
|
ocsenave@308
|
60 "Return the differences between the two lists as triples [index
|
ocsenave@308
|
61 (list-1 index) (list-2 index)]."
|
ocsenave@308
|
62 [list-1 list-2]
|
ocsenave@308
|
63 (remove
|
ocsenave@308
|
64 (fn [[a b c]] (= b c))
|
ocsenave@308
|
65 (map vector
|
ocsenave@308
|
66 (range)
|
ocsenave@308
|
67 list-1
|
ocsenave@308
|
68 list-2)))
|
ocsenave@308
|
69
|
ocsenave@308
|
70 (defn pc-diff
|
ocsenave@308
|
71 "Return the differences between the program counter evolution
|
ocsenave@308
|
72 between the two states (measured for 10000 ticks)."
|
ocsenave@308
|
73 [state-1 state-2]
|
ocsenave@308
|
74 (differences (map hex (pc-trail state-1 10000))
|
ocsenave@308
|
75 (map hex (pc-trail state-2 10000))))
|
ocsenave@308
|
76
|
ocsenave@308
|
77
|
ocsenave@308
|
78 (defn memory-diff [state-1 state-2]
|
ocsenave@308
|
79 (remove
|
ocsenave@308
|
80 (fn[[a b c]] (= b c))
|
ocsenave@308
|
81 (map (comp vec (partial map hex) list)
|
ocsenave@308
|
82 (range)
|
ocsenave@308
|
83 (vec (memory state-1))
|
ocsenave@308
|
84 (vec (memory state-2)))
|
ocsenave@308
|
85 ))
|
ocsenave@308
|
86
|
ocsenave@308
|
87
|
ocsenave@308
|
88 (defn spell-array
|
ocsenave@308
|
89 "Interpret the array as a string of printable Pokemon-text characters."
|
ocsenave@308
|
90 [array start n]
|
ocsenave@308
|
91 (character-codes->str
|
ocsenave@308
|
92 (take n (drop start
|
ocsenave@308
|
93 (vec array)))))
|
ocsenave@308
|
94
|
ocsenave@308
|
95 (defn spell-memory
|
ocsenave@308
|
96 "Interpret the indexable memory of the state as a string of printable
|
ocsenave@308
|
97 Pokemon-text characters. If no state is given, uses current-state."
|
ocsenave@308
|
98 ([state mem n]
|
ocsenave@308
|
99 (spell-array (memory state) mem n))
|
ocsenave@308
|
100 ([mem n] (spell-array @current-state mem n)))
|
ocsenave@308
|
101
|
ocsenave@308
|
102
|
ocsenave@308
|
103 (defn sublist
|
ocsenave@308
|
104 "Unshifts the list until the sublist is at the start."
|
ocsenave@308
|
105 [list sub]
|
ocsenave@308
|
106 (cond
|
ocsenave@308
|
107 (empty? sub) list
|
ocsenave@308
|
108 (empty? list) nil
|
ocsenave@308
|
109 (= (take (count sub) list) sub) list
|
ocsenave@308
|
110 :else (recur (rest list) sub)))
|
ocsenave@308
|
111
|
ocsenave@308
|
112 (defn find-sublist
|
ocsenave@308
|
113 "Returns the position of the first occurence of sublist."
|
ocsenave@308
|
114 [list sub]
|
ocsenave@308
|
115 (loop [n 0 a list]
|
ocsenave@308
|
116 (cond
|
ocsenave@308
|
117 (empty? a) nil
|
ocsenave@308
|
118 (= (take (count sub) a) sub) n
|
ocsenave@308
|
119 :else (recur (inc n) (rest a)))))
|
ocsenave@308
|
120
|
ocsenave@308
|
121 (defn find-sublists
|
ocsenave@308
|
122 "Returns a vector of the occurences of sublists."
|
ocsenave@308
|
123 [list sub]
|
ocsenave@308
|
124 (let [m (find-sublist list sub)]
|
ocsenave@308
|
125 (if (nil? m) '()
|
ocsenave@308
|
126 (cons m
|
ocsenave@308
|
127 (map (partial + (inc m))
|
ocsenave@308
|
128 (find-sublists
|
ocsenave@308
|
129 (drop (inc m) list)
|
ocsenave@308
|
130 sub))))))
|
ocsenave@308
|
131
|
ocsenave@308
|
132
|
ocsenave@308
|
133
|
ocsenave@308
|
134 (defn search-memory
|
ocsenave@308
|
135 "Search for the given codes in memory, returning short snippets of
|
ocsenave@308
|
136 text around the results."
|
ocsenave@308
|
137 ([codes k]
|
ocsenave@308
|
138 (search-memory com.aurellem.gb.gb-driver/original-rom codes k))
|
ocsenave@308
|
139 ([array codes k]
|
ocsenave@308
|
140 (map
|
ocsenave@308
|
141 (fn [n]
|
ocsenave@308
|
142 [(hex n)
|
ocsenave@308
|
143 (take k (drop n rom))])
|
ocsenave@308
|
144
|
ocsenave@308
|
145 (find-sublists
|
ocsenave@308
|
146 rom
|
ocsenave@308
|
147 codes))))
|
ocsenave@308
|
148
|
ocsenave@308
|
149 (defn spelling-bee
|
ocsenave@308
|
150 "Search for the given string in ROM, returning short snippets of
|
ocsenave@308
|
151 text around the results."
|
ocsenave@308
|
152 ([str k]
|
ocsenave@308
|
153 (spelling-bee com.aurellem.gb.gb-driver/original-rom str k))
|
ocsenave@308
|
154 ([rom str k]
|
ocsenave@308
|
155 (map
|
ocsenave@308
|
156 (fn [[address snip]]
|
ocsenave@308
|
157 [address (character-codes->str snip)])
|
ocsenave@308
|
158 (search-memory rom (str->character-codes str) k))))
|
ocsenave@308
|
159
|
ocsenave@308
|
160
|
ocsenave@308
|
161
|
ocsenave@308
|
162
|
ocsenave@308
|
163
|
ocsenave@308
|
164
|
ocsenave@308
|
165 (defn rewrite-memory
|
ocsenave@308
|
166 "Alter the vector of memory. Treats strings as lists of character
|
ocsenave@308
|
167 ops."
|
ocsenave@308
|
168 ([mem start strs-or-ops]
|
ocsenave@308
|
169 (let [x (first strs-or-ops)]
|
ocsenave@308
|
170 (cond (empty? strs-or-ops) mem
|
ocsenave@308
|
171 (string? x)
|
ocsenave@308
|
172
|
ocsenave@308
|
173 (recur mem start
|
ocsenave@308
|
174 (concat
|
ocsenave@308
|
175 (str->character-codes x)
|
ocsenave@308
|
176 (rest strs-or-ops)))
|
ocsenave@308
|
177 :else
|
ocsenave@308
|
178 (recur
|
ocsenave@308
|
179 (assoc mem start x)
|
ocsenave@308
|
180 (inc start)
|
ocsenave@308
|
181 (rest strs-or-ops))))))
|
ocsenave@308
|
182
|
ocsenave@308
|
183
|
ocsenave@308
|
184 (defn rewrite-rom
|
ocsenave@308
|
185 "Alter the rom at the given location. Takes a list of
|
ocsenave@308
|
186 various strings/bytes as data."
|
ocsenave@308
|
187 [start strs-or-bytes]
|
ocsenave@308
|
188 ((partial rewrite-memory (vec (rom(root))))
|
ocsenave@308
|
189 start strs-or-bytes))
|
ocsenave@308
|
190
|
ocsenave@308
|
191 (defn restore-rom! [] (write-rom! original-rom))
|
ocsenave@308
|
192
|