view clojure/com/aurellem/gb/util.clj @ 277:710bfbb1e048

fix compiliation errors
author Robert McIntyre <rlm@mit.edu>
date Tue, 27 Mar 2012 12:57:58 -0500
parents 69184558fcf3
children eec3e69500d9
line wrap: on
line source
1 (ns com.aurellem.gb.util
2 (:use (com.aurellem.gb gb-driver vbm constants))
3 (:import java.io.File)
4 (:import [com.aurellem.gb.gb_driver SaveState]))
6 (defn A [state]
7 (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))
9 (defn B [state]
10 (bit-shift-right (bit-and 0x0000FF00 (BC state)) 8))
12 (defn D [state]
13 (bit-shift-right (bit-and 0x0000FF00 (DE state)) 8))
15 (defn H [state]
16 (bit-shift-right (bit-and 0x0000FF00 (HL state)) 8))
18 (defn C [state]
19 (bit-and 0xFF (BC state)))
20 (defn F [state]
21 (bit-and 0xFF (AF state)))
22 (defn E [state]
23 (bit-and 0xFF (DE state)))
24 (defn L [state]
25 (bit-and 0xFF (HL state)))
27 (defn binary-str [num]
28 (format "%08d"
29 (Integer/parseInt
30 (Integer/toBinaryString num) 10)))
33 (defn view-register [state name reg-fn]
34 (println (format "%s: %s" name
35 (binary-str (reg-fn state))))
36 state)
38 (defn view-memory
39 ([^SaveState state mem]
40 (let [val (aget (memory state) mem)]
41 (println (format "0x%04X = %s 0x%02X %d" mem
42 (binary-str val) val val)))
43 state)
44 ([mem]
45 (view-memory @current-state mem)))
47 (defn print-listing
48 ([^SaveState state begin end]
49 (dorun (map
50 (fn [opcode line]
51 (println (format "0x%04X: 0x%02X %s %d"
52 line
53 opcode (binary-str opcode)
54 opcode)))
55 (subvec (vec (memory state)) begin end)
56 (range begin end)))
57 state)
58 ([begin end]
59 (print-listing @current-state begin end)))
61 (defn print-pc
62 ([^SaveState state]
63 (println (format "PC: 0x%04X" (PC state)))
64 state)
65 ([] (print-pc @current-state)))
67 (defn print-op
68 ([^SaveState state]
69 (println (format "OP: 0x%02X" (aget (memory state) (PC state))))
70 state)
71 ([] (print-op @current-state)))
73 (defn d-tick
74 ([state]
75 (-> state print-pc print-op tick)))
77 (defn print-interrupt
78 [^SaveState state]
79 (println (format "IE: %d" (IE state)))
80 state)
82 (defn set-memory
83 ([state location value]
84 (set-state! state)
85 (let [mem (memory state)]
86 (aset mem location value)
87 (write-memory! mem)
88 (update-state)))
89 ([location value]
90 (set-memory @current-state location value)))
92 (defn set-memory-range
93 ([state start values]
94 (set-state! state)
95 (let [mem (memory state)]
97 (dorun (map (fn [index val]
98 (aset mem index val))
99 (range start
100 (+ start (count values))) values))
101 (write-memory! mem)
102 (update-state)))
103 ([start values]
104 (set-memory-range
105 @current-state start values)))
107 (defn common-differences [& seqs]
108 (let [backbone (range (count (first seqs)))]
109 (filter
110 (comp (partial apply distinct?) second)
111 (zipmap backbone
112 (apply (partial map list) seqs)))))
114 (defn temporal-compare [& states]
115 (apply common-differences
116 (map (comp vec memory)
117 states)))
119 (defn mid-game []
120 (read-state "mid-game"))
124 (defn disect-bytes-2
125 "return a vector consiting of the last 16 bytes of the
126 integer expressed as two 8 bit numbers (inside an integer)
127 in the form [high-bits low-bits]."
128 [num]
129 [(bit-shift-right
130 (bit-and num 0xFF00) 8)
131 (bit-and num 0xFF)])
133 (defn disect-bytes-3
134 "same as disect-bytes-2 except that it assumes the input is a
135 24 bit number and returns [high-bits medium-bits low-bits]"
136 [num]
137 (vec
138 (concat
139 [(bit-shift-right (bit-and num 0xFF0000) 16)]
140 (disect-bytes-2 num))))
142 (defn glue-bytes
143 "Given two or three 8-bit numbers inside 32-bit integers,
144 combine them into the integer number that they together
145 represent."
146 ([h l]
147 (+ l (bit-shift-left h 8)))
149 ([h m l]
150 (+ (glue-bytes m l)
151 (bit-shift-left h 16))))
153 (def cartography
154 (File. user-home
155 "proj/vba-clojure/clojure/com/aurellem/exp/cartography"))
159 (defn print-D-memory
160 ([^SaveState state]
162 (let [descriptions
163 (clojure.string/split-lines
164 (slurp cartography))]
165 (dorun
166 (map
167 (fn [line data desc]
168 (printf "%04X %02X%s\n"
169 line data (apply str
170 (drop 20 desc))))
171 (range pokemon-record-begin
172 (inc D-memory-end))
174 (subvec (vec (memory state))
175 pokemon-record-begin
176 (inc D-memory-end))
177 descriptions))))
178 ([] (print-D-memory @current-state)))