Mercurial > vba-clojure

comparison clojure/com/aurellem/gb_driver.clj @ 77:9ba461a5c60f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
disk backup complete
author Robert McIntyre <rlm@mit.edu>
date Thu, 08 Mar 2012 21:16:53 -0600
parents d7c38ce83421
children 7ab48d728ee4
comparison
equal deleted inserted replaced
76:d7c38ce83421 77:9ba461a5c60f
1 (ns com.aurellem.gb-driver 1 (ns com.aurellem.gb-driver
2 (:import com.aurellem.gb.Gb) 2 (:import com.aurellem.gb.Gb)
3 (:import java.io.File) 3 (:import java.io.File)
4 (:import org.apache.commons.io.FileUtils)
4 (:import (java.nio IntBuffer ByteOrder))) 5 (:import (java.nio IntBuffer ByteOrder)))
5 6
6 (Gb/loadVBA) 7 (Gb/loadVBA)
7 8
8 (def ^:dynamic *max-history* 1e4) 9 (def ^:dynamic *max-history* 10)
9 10
10 (def ^:dynamic *backup-saves-to-disk* true) 11 (def ^:dynamic *backup-saves-to-disk* true)
11 12
12 (def ^:dynamic *save-history* true) 13 (def ^:dynamic *save-history* true)
13 14
83 (defrecord SaveState [frame save-data]) 84 (defrecord SaveState [frame save-data])
84 85
85 (defn frame [] @current-frame) 86 (defn frame [] @current-frame)
86 87
87 (defn save-state [] 88 (defn save-state []
88 (SaveState. 89 (SaveState. (frame) (Gb/saveState)))
89 (frame)
90 (Gb/saveState)))
91 90
92 (defn load-state [#^SaveState save] 91 (defn load-state [#^SaveState save]
93 (reset! current-frame (:frame save)) 92 (reset! current-frame (:frame save))
94 (Gb/loadState (:save-data save))) 93 (Gb/loadState (:save-data save)))
95 94
103 102
104 (defn get-save-from-disk [frame] 103 (defn get-save-from-disk [frame]
105 (let [save (frame->disk-save frame)] 104 (let [save (frame->disk-save frame)]
106 (if (.exists save) 105 (if (.exists save)
107 (let [buf (Gb/saveBuffer) 106 (let [buf (Gb/saveBuffer)
108 bytes (org.apache.commons.io.FileUtils/readFileToByteArray 107 bytes (FileUtils/readFileToByteArray save)]
109 save)]
110 (.put buf bytes) 108 (.put buf bytes)
111 (.flip buf) 109 (.flip buf)
112 (SaveState. frame buf))))) 110 (SaveState. frame buf)))))
113 111
114 (defn store-save-to-disk [^SaveState save] 112 (defn store-save-to-disk [^SaveState save]
115 (let [buf (:save-data save) 113 (let [buf (:save-data save)
116 bytes (byte-array (.limit buf)) 114 bytes (byte-array (.limit buf))
117 dest (frame->disk-save (:frame save))] 115 dest (frame->disk-save (:frame save))]
118 (.get buf bytes) 116 (.get buf bytes)
119 (org.apache.commons.io.FileUtils/writeByteArrayToFile 117 (FileUtils/writeByteArrayToFile dest bytes)
120 dest bytes) 118 (.rewind buf) dest))
121 (.rewind buf)))
122 119
123 (defn find-save-state [frame] 120 (defn find-save-state [frame]
124 (let [save (@history frame)] 121 (let [save (@history frame)]
125 (if (not (nil? save)) save 122 (if (not (nil? save)) save
126 (get-save-from-disk frame)))) 123 (get-save-from-disk frame))))
138 (defn rewind 135 (defn rewind
139 ([] (rewind 1)) 136 ([] (rewind 1))
140 ([n] (goto (- @current-frame n)))) 137 ([n] (goto (- @current-frame n))))
141 138
142 (defn backup-state [frame] 139 (defn backup-state [frame]
143 (swap! history #(assoc % frame (save-state))) 140 (let [save (save-state)]
144 (if (> (count @history) *max-history*) 141 (swap! history #(assoc % frame save))
145 (swap! history #(dissoc % (first (first %)))))) 142 (store-save-to-disk save)
143 (if (> (count @history) *max-history*)
144 (swap! history #(dissoc % (first (first %)))))))
146 145
147 (defn advance [] 146 (defn advance []
148 (if *save-history* 147 (if *save-history*
149 (backup-state @current-frame)) 148 (backup-state @current-frame))
150 (swap! current-frame inc)) 149 (swap! current-frame inc))
155 (advance) 154 (advance)
156 (if (number? mask-or-buttons) 155 (if (number? mask-or-buttons)
157 (Gb/step mask-or-buttons) 156 (Gb/step mask-or-buttons)
158 (Gb/step (button-mask mask-or-buttons))))) 157 (Gb/step (button-mask mask-or-buttons)))))
159 158
160 (defn step! [& args]
161 (binding [*save-history* false]
162 (apply step args)))
163
164 (defn play 159 (defn play
165 ([n] (dorun (dotimes [_ n] (step)))) 160 ([] (play Integer/MAX_VALUE))
166 ([] (play Integer/MAX_VALUE))) 161 ([n] (dorun (dotimes [_ n] (step)))))
167 162
168 (defn buf-seq [buffer] 163
169 (let [bytes (byte-array (.capacity buffer))]
170 (.get buffer bytes)
171 (.rewind buffer)
172 (seq bytes)))