Mercurial > vba-clojure

comparison clojure/com/aurellem/gb/mem_util.clj @ 308:de172acc5a03

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