1.1 --- a/clojure/com/aurellem/gb_driver.clj	Thu Mar 08 06:01:09 2012 -0600
     1.2 +++ b/clojure/com/aurellem/gb_driver.clj	Thu Mar 08 19:48:54 2012 -0600
     1.3 @@ -5,6 +5,15 @@
     1.4  
     1.5  (Gb/loadVBA)
     1.6  
     1.7 +(def ^:dynamic *max-history* 1e4)
     1.8 +
     1.9 +(def ^:dynamic *backup-saves-to-disk* true)
    1.10 +
    1.11 +(def ^:dynamic *save-history* true)
    1.12 +
    1.13 +(def ^:dynamic *save-state-cache*
    1.14 +  (File. "/home/r/proj/pokemon-escape/save-states/"))
    1.15 +
    1.16  (def yellow-rom-image
    1.17    (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc"))
    1.18  
    1.19 @@ -24,9 +33,7 @@
    1.20  
    1.21  (defn cpu-data [size arr-fn]
    1.22    (let [store (int-array size)]
    1.23 -    (fn [] 
    1.24 -      (arr-fn store)
    1.25 -      store)))
    1.26 +    (fn [] (arr-fn store) store)))
    1.27  
    1.28  (def ram
    1.29    (cpu-data (Gb/getRAMSize) #(Gb/getRAM %)))
    1.30 @@ -73,35 +80,74 @@
    1.31              (recur (conj buttons button) (rest masks))
    1.32              (recur buttons (rest masks)))))))
    1.33  
    1.34 +(defrecord SaveState [frame save-data])
    1.35  
    1.36 -(defn save-state [] (Gb/saveState))
    1.37 +(defn frame [] @current-frame)
    1.38  
    1.39 -(def history (atom {}))
    1.40 +(defn save-state []
    1.41 +  (SaveState.
    1.42 +   (frame)
    1.43 +   (Gb/saveState)))
    1.44 +
    1.45 +(defn load-state [#^SaveState save]
    1.46 +  (reset! current-frame (:frame save))
    1.47 +  (Gb/loadState (:save-data save)))
    1.48 +
    1.49 +(def empty-history (sorted-map))
    1.50 +
    1.51 +(def history (atom empty-history))
    1.52 +
    1.53 +(defn frame->disk-save [frame]
    1.54 +  (File. *save-state-cache*
    1.55 +         (format "%07d.sav" frame)))
    1.56 +
    1.57 +(defn get-save-from-disk [frame]
    1.58 +  (let [save (frame->disk-save frame)]
    1.59 +    (if (.exists save)
    1.60 +      (let [buf (Gb/saveBuffer)
    1.61 +            bytes (org.apache.commons.io.FileUtils/readFileToByteArray
    1.62 +                   save)]
    1.63 +        (.put buf bytes)
    1.64 +        (.flip buf)
    1.65 +        (SaveState. frame buf)))))
    1.66 +
    1.67 +(defn store-save-to-disk [^SaveState save]
    1.68 +  (let [buf (:save-data save)
    1.69 +        bytes (byte-array (.limit buf))
    1.70 +        dest (frame->disk-save (:frame save))]
    1.71 +    (.get buf bytes)
    1.72 +    (org.apache.commons.io.FileUtils/writeByteArrayToFile
    1.73 +     dest bytes)
    1.74 +    (.rewind buf)))
    1.75 +
    1.76 +(defn find-save-state [frame]
    1.77 +  (let [save (@history frame)]
    1.78 +    (if (not (nil? save)) save
    1.79 +        (get-save-from-disk frame))))
    1.80  
    1.81  (defn goto [frame]
    1.82 -  (let [save (@history frame)]
    1.83 -    (if (not (nil? save))
    1.84 +  (let [save (find-save-state frame)]
    1.85 +    (if (nil? save)
    1.86 +      (println frame "is not in history")
    1.87        (do
    1.88          (reset! current-frame frame)
    1.89 -        (Gb/loadState save))
    1.90 -      (println "no backup state"))))
    1.91 +        (load-state save)))))
    1.92  
    1.93 -(defn clear-history [] (reset! history {}))
    1.94 +(defn clear-history [] (reset! history empty-history))
    1.95  
    1.96  (defn rewind
    1.97 -  ([n] (goto (- @current-frame n)))
    1.98 -  ([] (rewind 1)))
    1.99 -  
   1.100 +  ([] (rewind 1))
   1.101 +  ([n] (goto (- @current-frame n))))
   1.102 +
   1.103  (defn backup-state [frame]
   1.104 -  (swap! history #(assoc % frame (save-state))))
   1.105 -
   1.106 -(def ^:dynamic *save-history* true)
   1.107 +  (swap! history #(assoc % frame (save-state)))
   1.108 +  (if (> (count @history) *max-history*)
   1.109 +    (swap! history #(dissoc % (first (first %))))))
   1.110  
   1.111  (defn advance []
   1.112 -  (swap! current-frame inc)
   1.113    (if *save-history*
   1.114 -    (let [save (save-state)]
   1.115 -      (backup-state @current-frame))))
   1.116 +    (backup-state @current-frame))
   1.117 +  (swap! current-frame inc))
   1.118  
   1.119  (defn step
   1.120    ([] (advance) (Gb/step))
   1.121 @@ -114,7 +160,13 @@
   1.122  (defn step! [& args]
   1.123    (binding [*save-history* false]
   1.124      (apply step args)))
   1.125 +  
   1.126 +(defn play
   1.127 +  ([n] (dorun (dotimes [_ n] (step)))) 
   1.128 +  ([] (play Integer/MAX_VALUE)))
   1.129  
   1.130 -(defn frame [] @current-frame)
   1.131 -  
   1.132 -
   1.133 +(defn buf-seq [buffer]
   1.134 +  (let [bytes (byte-array (.capacity buffer))]
   1.135 +    (.get buffer bytes)
   1.136 +    (.rewind buffer)
   1.137 +    (seq bytes)))
   1.138 \ No newline at end of file