Mercurial > vba-clojure

comparison clojure/com/aurellem/gb_driver.clj @ 76:d7c38ce83421

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
working on disk-backup for save-states
author Robert McIntyre <rlm@mit.edu>
date Thu, 08 Mar 2012 19:48:54 -0600
parents eb7d4efe0f34
children 9ba461a5c60f
comparison
equal deleted inserted replaced
75:eb7d4efe0f34 76:d7c38ce83421
2 (:import com.aurellem.gb.Gb) 2 (:import com.aurellem.gb.Gb)
3 (:import java.io.File) 3 (:import java.io.File)
4 (:import (java.nio IntBuffer ByteOrder))) 4 (:import (java.nio IntBuffer ByteOrder)))
5 5
6 (Gb/loadVBA) 6 (Gb/loadVBA)
7
8 (def ^:dynamic *max-history* 1e4)
9
10 (def ^:dynamic *backup-saves-to-disk* true)
11
12 (def ^:dynamic *save-history* true)
13
14 (def ^:dynamic *save-state-cache*
15 (File. "/home/r/proj/pokemon-escape/save-states/"))
7 16
8 (def yellow-rom-image 17 (def yellow-rom-image
9 (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc")) 18 (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc"))
10 19
11 (def yellow-save-file 20 (def yellow-save-file
22 31
23 (defn reset [] (shutdown) (vba-init)) 32 (defn reset [] (shutdown) (vba-init))
24 33
25 (defn cpu-data [size arr-fn] 34 (defn cpu-data [size arr-fn]
26 (let [store (int-array size)] 35 (let [store (int-array size)]
27 (fn [] 36 (fn [] (arr-fn store) store)))
28 (arr-fn store)
29 store)))
30 37
31 (def ram 38 (def ram
32 (cpu-data (Gb/getRAMSize) #(Gb/getRAM %))) 39 (cpu-data (Gb/getRAMSize) #(Gb/getRAM %)))
33 40
34 (def rom 41 (def rom
71 (let [[button value] (first masks)] 78 (let [[button value] (first masks)]
72 (if (not= 0x0000 (bit-and value mask)) 79 (if (not= 0x0000 (bit-and value mask))
73 (recur (conj buttons button) (rest masks)) 80 (recur (conj buttons button) (rest masks))
74 (recur buttons (rest masks))))))) 81 (recur buttons (rest masks)))))))
75 82
83 (defrecord SaveState [frame save-data])
76 84
77 (defn save-state [] (Gb/saveState)) 85 (defn frame [] @current-frame)
78 86
79 (def history (atom {})) 87 (defn save-state []
88 (SaveState.
89 (frame)
90 (Gb/saveState)))
91
92 (defn load-state [#^SaveState save]
93 (reset! current-frame (:frame save))
94 (Gb/loadState (:save-data save)))
95
96 (def empty-history (sorted-map))
97
98 (def history (atom empty-history))
99
100 (defn frame->disk-save [frame]
101 (File. *save-state-cache*
102 (format "%07d.sav" frame)))
103
104 (defn get-save-from-disk [frame]
105 (let [save (frame->disk-save frame)]
106 (if (.exists save)
107 (let [buf (Gb/saveBuffer)
108 bytes (org.apache.commons.io.FileUtils/readFileToByteArray
109 save)]
110 (.put buf bytes)
111 (.flip buf)
112 (SaveState. frame buf)))))
113
114 (defn store-save-to-disk [^SaveState save]
115 (let [buf (:save-data save)
116 bytes (byte-array (.limit buf))
117 dest (frame->disk-save (:frame save))]
118 (.get buf bytes)
119 (org.apache.commons.io.FileUtils/writeByteArrayToFile
120 dest bytes)
121 (.rewind buf)))
122
123 (defn find-save-state [frame]
124 (let [save (@history frame)]
125 (if (not (nil? save)) save
126 (get-save-from-disk frame))))
80 127
81 (defn goto [frame] 128 (defn goto [frame]
82 (let [save (@history frame)] 129 (let [save (find-save-state frame)]
83 (if (not (nil? save)) 130 (if (nil? save)
131 (println frame "is not in history")
84 (do 132 (do
85 (reset! current-frame frame) 133 (reset! current-frame frame)
86 (Gb/loadState save)) 134 (load-state save)))))
87 (println "no backup state"))))
88 135
89 (defn clear-history [] (reset! history {})) 136 (defn clear-history [] (reset! history empty-history))
90 137
91 (defn rewind 138 (defn rewind
92 ([n] (goto (- @current-frame n))) 139 ([] (rewind 1))
93 ([] (rewind 1))) 140 ([n] (goto (- @current-frame n))))
94 141
95 (defn backup-state [frame] 142 (defn backup-state [frame]
96 (swap! history #(assoc % frame (save-state)))) 143 (swap! history #(assoc % frame (save-state)))
97 144 (if (> (count @history) *max-history*)
98 (def ^:dynamic *save-history* true) 145 (swap! history #(dissoc % (first (first %))))))
99 146
100 (defn advance [] 147 (defn advance []
101 (swap! current-frame inc)
102 (if *save-history* 148 (if *save-history*
103 (let [save (save-state)] 149 (backup-state @current-frame))
104 (backup-state @current-frame)))) 150 (swap! current-frame inc))
105 151
106 (defn step 152 (defn step
107 ([] (advance) (Gb/step)) 153 ([] (advance) (Gb/step))
108 ([mask-or-buttons] 154 ([mask-or-buttons]
109 (advance) 155 (advance)
112 (Gb/step (button-mask mask-or-buttons))))) 158 (Gb/step (button-mask mask-or-buttons)))))
113 159
114 (defn step! [& args] 160 (defn step! [& args]
115 (binding [*save-history* false] 161 (binding [*save-history* false]
116 (apply step args))) 162 (apply step args)))
163
164 (defn play
165 ([n] (dorun (dotimes [_ n] (step))))
166 ([] (play Integer/MAX_VALUE)))
117 167
118 (defn frame [] @current-frame) 168 (defn buf-seq [buffer]
119 169 (let [bytes (byte-array (.capacity buffer))]
120 170 (.get buffer bytes)
171 (.rewind buffer)
172 (seq bytes)))