view clojure/com/aurellem/gb/util.clj @ 257:8d1a354f7471

continued work on unoptimized script
author Robert McIntyre <rlm@mit.edu>
date Mon, 26 Mar 2012 07:20:30 -0500
parents 22f58fa47c3c
children 69184558fcf3
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)))
32 (defn view-register [state name reg-fn]
33 (println (format "%s: %s" name
34 (binary-str (reg-fn state))))
35 state)
37 (defn view-memory
38 ([^SaveState state mem]
39 (let [val (aget (memory state) mem)]
40 (println (format "0x%04X = %s 0x%02X %d" mem
41 (binary-str val) val val)))
42 state)
43 ([mem]
44 (view-memory @current-state mem)))
46 (defn print-listing
47 ([^SaveState state begin end]
48 (dorun (map
49 (fn [opcode line]
50 (println (format "0x%04X: 0x%02X %s %d"
51 line
52 opcode (binary-str opcode)
53 opcode)))
54 (subvec (vec (memory state)) begin end)
55 (range begin end)))
56 state)
57 ([begin end]
58 (print-listing @current-state begin end)))
60 (defn print-pc
61 ([^SaveState state]
62 (println (format "PC: 0x%04X" (PC state)))
63 state)
64 ([] (print-pc @current-state)))
66 (defn print-op
67 ([^SaveState state]
68 (println (format "OP: 0x%02X" (aget (memory state) (PC state))))
69 state)
70 ([] (print-op @current-state)))
72 (defn d-tick
73 ([state]
74 (-> state print-pc print-op tick)))
76 (defn print-interrupt
77 [^SaveState state]
78 (println (format "IE: %d" (IE state)))
79 state)
81 (defn set-memory
82 ([state location value]
83 (set-state! state)
84 (let [mem (memory state)]
85 (aset mem location value)
86 (write-memory! mem)
87 (update-state)))
88 ([location value]
89 (set-memory @current-state location value)))
91 (defn set-memory-range
92 ([state start values]
93 (set-state! state)
94 (let [mem (memory state)]
96 (dorun (map (fn [index val]
97 (aset mem index val))
98 (range start
99 (+ start (count values))) values))
100 (write-memory! mem)
101 (update-state)))
102 ([start values]
103 (set-memory-range
104 @current-state start values)))
106 (defn common-differences [& seqs]
107 (let [backbone (range (count (first seqs)))]
108 (filter
109 (comp (partial apply distinct?) second)
110 (zipmap backbone
111 (apply (partial map list) seqs)))))
113 (defn temporal-compare [& states]
114 (apply common-differences
115 (map (comp vec memory)
116 states)))
118 (defn mid-game []
119 (read-state "mid-game"))
123 (defn disect-bytes-2
124 "return a vector consiting of the last 16 bytes of the
125 integer expressed as two 8 bit nimbers (inside an integer)
126 in the form [high-bits low-bits."
127 [num]
128 [(bit-shift-right
129 (bit-and num 0xFF00) 8)
130 (bit-and num 0xFF)])
132 (defn disect-bytes-3
133 "same as disect-bytes-2 except that it assumes the input is a
134 24 bit number and returns [high-bits medium-bits low-bits]"
135 [num]
136 (vec
137 (concat
138 [(bit-shift-right (bit-and num 0xFF0000) 16)]
139 (disect-bytes-2 num))))
141 (defn glue-bytes
142 "Given two or three 8-bit numbers inside 32-bit integers,
143 combine them into the integer number that they together
144 represent."
145 ([h l]
146 (+ l (bit-shift-left h 8)))
148 ([h m l]
149 (+ (glue-bytes m l)
150 (bit-shift-left h 16))))
152 (def cartography
153 (File. user-home
154 "proj/vba-clojure/clojure/com/aurellem/exp/cartography"))
158 (defn print-D-memory
159 ([^SaveState state]
161 (let [descriptions
162 (clojure.string/split-lines
163 (slurp cartography))]
164 (dorun
165 (map
166 (fn [line data desc]
167 (printf "%04X %02X%s\n"
168 line data (apply str
169 (drop 20 desc))))
170 (range pokemon-record-begin
171 (inc D-memory-end))
173 (subvec (vec (memory state))
174 pokemon-record-begin
175 (inc D-memory-end))
176 descriptions))))
177 ([] (print-D-memory @current-state)))