Mercurial > vba-clojure

comparison clojure/com/aurellem/cruft/gb_driver.clj @ 87:e8855121f413

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
collect cruft, rename other files
author Robert McIntyre <rlm@mit.edu>
date Sat, 10 Mar 2012 14:48:17 -0600
parents
children
comparison
equal deleted inserted replaced
86:9864032ef3c8 87:e8855121f413
1 (ns com.aurellem.gb-driver
2 (:import com.aurellem.gb.Gb)
3 (:import java.io.File)
4 (:import org.apache.commons.io.FileUtils)
5 (:import (java.nio IntBuffer ByteOrder)))
6
7 (Gb/loadVBA)
8
9 (def ^:dynamic *max-history* 2e4)
10
11 (def ^:dynamic *backup-saves-to-disk* true)
12
13 (def ^:dynamic *save-history* true)
14
15 (def ^:dynamic *save-state-cache*
16 (File. "/home/r/proj/pokemon-escape/save-states/"))
17
18 (def yellow-rom-image
19 (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc"))
20
21 (def yellow-save-file
22 (File. "/home/r/proj/pokemon-escape/roms/yellow.sav"))
23
24 (def current-frame (atom 0))
25
26 (defn vba-init []
27 (reset! current-frame 0)
28 (.delete yellow-save-file)
29 (Gb/startEmulator (.getCanonicalPath yellow-rom-image)))
30
31 (defn shutdown [] (Gb/shutdown))
32
33 (defn reset [] (shutdown) (vba-init))
34
35 (defn cpu-data [size arr-fn]
36 (let [store (int-array size)]
37 (fn [] (arr-fn store) store)))
38
39 (def ram
40 (cpu-data (Gb/getRAMSize) #(Gb/getRAM %)))
41
42 (def rom
43 (cpu-data (Gb/getROMSize) #(Gb/getROM %)))
44
45 (def working-ram
46 (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %)))
47
48 (def video-ram
49 (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %)))
50
51 (def registers
52 (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %)))
53
54 (def button-code
55 {;; main buttons
56 :a 0x0001
57 :b 0x0002
58
59 ;; directional pad
60 :r 0x0010
61 :l 0x0020
62 :u 0x0040
63 :d 0x0080
64
65 ;; meta buttons
66 :select 0x0004
67 :start 0x0008
68
69 ;; hard reset -- not really a button
70 :reset 0x0800})
71
72 (defn button-mask [buttons]
73 (reduce bit-or 0x0000 (map button-code buttons)))
74
75 (defn buttons [mask]
76 (loop [buttons []
77 masks (seq button-code)]
78 (if (empty? masks) buttons
79 (let [[button value] (first masks)]
80 (if (not= 0x0000 (bit-and value mask))
81 (recur (conj buttons button) (rest masks))
82 (recur buttons (rest masks)))))))
83
84 (defrecord SaveState [frame save-data])
85
86 (defn frame [] @current-frame)
87
88 (defn save-state []
89 (SaveState. (frame) (Gb/saveState)))
90
91 (defn load-state [#^SaveState save]
92 (reset! current-frame (:frame save))
93 (Gb/loadState (:save-data save)))
94
95 (def empty-history (sorted-map))
96
97 (def history (atom empty-history))
98
99 (defn frame->disk-save [frame]
100 (File. *save-state-cache*
101 (format "%07d.sav" frame)))
102
103 (defn get-save-from-disk [frame]
104 (let [save (frame->disk-save frame)]
105 (if (.exists save)
106 (let [buf (Gb/saveBuffer)
107 bytes (FileUtils/readFileToByteArray save)]
108 (.put buf bytes)
109 (.flip buf)
110 (SaveState. frame buf)))))
111
112 (defn store-save-to-disk [^SaveState save]
113 (let [buf (:save-data save)
114 bytes (byte-array (.limit buf))
115 dest (frame->disk-save (:frame save))]
116 (.get buf bytes)
117 (FileUtils/writeByteArrayToFile dest bytes)
118 (.rewind buf) dest))
119
120 (defn find-save-state [frame]
121 (let [save (@history frame)]
122 (if (not (nil? save)) save
123 (get-save-from-disk frame))))
124
125 (defn goto [frame]
126 (let [save (find-save-state frame)]
127 (if (nil? save)
128 (println frame "is not in history")
129 (do
130 (reset! current-frame frame)
131 (load-state save)))))
132
133 (defn clear-history [] (reset! history empty-history))
134
135 (defn rewind
136 ([] (rewind 1))
137 ([n] (goto (- @current-frame n))))
138
139 (defn backup-state
140 ([] (backup-state (frame)))
141 ([frame]
142 (let [save (save-state)]
143 (swap! history #(assoc % frame save))
144 ;;(store-save-to-disk save)
145 (if (> (count @history) *max-history*)
146 (swap! history #(dissoc % (first (first %))))))))
147
148 (defn advance []
149 (if *save-history*
150 (backup-state @current-frame))
151 (swap! current-frame inc))
152
153 (defn step
154 ([] (advance) (Gb/step))
155 ([mask-or-buttons]
156 (advance)
157 (if (number? mask-or-buttons)
158 (Gb/step mask-or-buttons)
159 (Gb/step (button-mask mask-or-buttons)))))
160
161 (defn play-moves
162 ([start moves]
163 (goto start)
164 (dorun (map step moves))
165 (backup-state)
166 (frame))
167 ([moves]
168 (dorun (map step moves))
169 (backup-state)
170 (frame)))
171
172 (defn play
173 ([] (play Integer/MAX_VALUE))
174 ([n] (dorun (dotimes [_ n] (step)))))
175
176 (defmacro without-saves [& forms]
177 `(binding [*save-history* false]
178 ~@forms))
179
180
181 (require '(clojure [zip :as zip]))
182
183
184
185
186 (defn tree->str [original]
187 (loop [s ".\n" loc (zip/down (zip/seq-zip (seq original)))]
188 (if (zip/end? loc) s
189 (let [d (count (zip/path loc))
190 rep
191 (str
192 s
193 (if (and (zip/up loc)
194 (> (count (-> loc zip/up zip/rights)) 0))
195 "|" "")
196 (apply str (repeat (dec d) " "))
197 (if (= (count (zip/rights loc)) 0)
198 "`-- "
199 "|-- ")
200 (zip/node loc)
201 "\n")]
202 (recur rep (zip/next loc))))))
203
204
205
206