1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/clojure/com/aurellem/cruft/gb_driver.clj	Sat Mar 10 14:48:17 2012 -0600
     1.3 @@ -0,0 +1,206 @@
     1.4 +(ns com.aurellem.gb-driver
     1.5 +  (:import com.aurellem.gb.Gb)
     1.6 +  (:import java.io.File)
     1.7 +  (:import org.apache.commons.io.FileUtils)
     1.8 +  (:import (java.nio IntBuffer ByteOrder)))
     1.9 +
    1.10 +(Gb/loadVBA)
    1.11 +
    1.12 +(def ^:dynamic *max-history* 2e4)
    1.13 +
    1.14 +(def ^:dynamic *backup-saves-to-disk* true)
    1.15 +
    1.16 +(def ^:dynamic *save-history* true)
    1.17 +
    1.18 +(def ^:dynamic *save-state-cache*
    1.19 +  (File. "/home/r/proj/pokemon-escape/save-states/"))
    1.20 +
    1.21 +(def yellow-rom-image
    1.22 +  (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc"))
    1.23 +
    1.24 +(def yellow-save-file
    1.25 +  (File. "/home/r/proj/pokemon-escape/roms/yellow.sav"))
    1.26 +
    1.27 +(def current-frame (atom 0))
    1.28 +
    1.29 +(defn vba-init []
    1.30 +  (reset! current-frame 0)
    1.31 +  (.delete yellow-save-file)
    1.32 +  (Gb/startEmulator (.getCanonicalPath yellow-rom-image)))
    1.33 +
    1.34 +(defn shutdown [] (Gb/shutdown))
    1.35 +
    1.36 +(defn reset [] (shutdown) (vba-init))
    1.37 +
    1.38 +(defn cpu-data [size arr-fn]
    1.39 +  (let [store (int-array size)]
    1.40 +    (fn [] (arr-fn store) store)))
    1.41 +
    1.42 +(def ram
    1.43 +  (cpu-data (Gb/getRAMSize) #(Gb/getRAM %)))
    1.44 +
    1.45 +(def rom 
    1.46 +  (cpu-data (Gb/getROMSize) #(Gb/getROM %)))
    1.47 +
    1.48 +(def working-ram 
    1.49 +  (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %)))
    1.50 +
    1.51 +(def video-ram 
    1.52 +  (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %)))
    1.53 +
    1.54 +(def registers
    1.55 +  (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %)))
    1.56 +
    1.57 +(def button-code
    1.58 +  {;; main buttons
    1.59 +   :a         0x0001
    1.60 +   :b         0x0002
    1.61 +
    1.62 +   ;; directional pad
    1.63 +   :r         0x0010
    1.64 +   :l         0x0020
    1.65 +   :u         0x0040
    1.66 +   :d         0x0080
    1.67 +
    1.68 +   ;; meta buttons
    1.69 +   :select    0x0004
    1.70 +   :start     0x0008
    1.71 +
    1.72 +   ;; hard reset -- not really a button
    1.73 +   :reset   0x0800})
    1.74 +
    1.75 +(defn button-mask [buttons]
    1.76 +  (reduce bit-or 0x0000 (map button-code buttons)))
    1.77 +
    1.78 +(defn buttons [mask]
    1.79 +  (loop [buttons []
    1.80 +         masks (seq button-code)]
    1.81 +    (if (empty? masks) buttons
    1.82 +        (let [[button value] (first masks)]
    1.83 +          (if (not= 0x0000 (bit-and value mask))
    1.84 +            (recur (conj buttons button) (rest masks))
    1.85 +            (recur buttons (rest masks)))))))
    1.86 +
    1.87 +(defrecord SaveState [frame save-data])
    1.88 +
    1.89 +(defn frame [] @current-frame)
    1.90 +
    1.91 +(defn save-state []
    1.92 +  (SaveState. (frame) (Gb/saveState)))
    1.93 +
    1.94 +(defn load-state [#^SaveState save]
    1.95 +  (reset! current-frame (:frame save))
    1.96 +  (Gb/loadState (:save-data save)))
    1.97 +
    1.98 +(def empty-history (sorted-map))
    1.99 +
   1.100 +(def history (atom empty-history))
   1.101 +
   1.102 +(defn frame->disk-save [frame]
   1.103 +  (File. *save-state-cache*
   1.104 +         (format "%07d.sav" frame)))
   1.105 +
   1.106 +(defn get-save-from-disk [frame]
   1.107 +  (let [save (frame->disk-save frame)]
   1.108 +    (if (.exists save)
   1.109 +      (let [buf (Gb/saveBuffer)
   1.110 +            bytes (FileUtils/readFileToByteArray save)]
   1.111 +        (.put buf bytes)
   1.112 +        (.flip buf)
   1.113 +        (SaveState. frame buf)))))
   1.114 +
   1.115 +(defn store-save-to-disk [^SaveState save]
   1.116 +  (let [buf (:save-data save)
   1.117 +        bytes (byte-array (.limit buf))
   1.118 +        dest (frame->disk-save (:frame save))]
   1.119 +    (.get buf bytes)
   1.120 +    (FileUtils/writeByteArrayToFile dest bytes)
   1.121 +    (.rewind buf) dest))
   1.122 +
   1.123 +(defn find-save-state [frame]
   1.124 +  (let [save (@history frame)]
   1.125 +    (if (not (nil? save)) save
   1.126 +        (get-save-from-disk frame))))
   1.127 +
   1.128 +(defn goto [frame]
   1.129 +  (let [save (find-save-state frame)]
   1.130 +    (if (nil? save)
   1.131 +      (println frame "is not in history")
   1.132 +      (do
   1.133 +        (reset! current-frame frame)
   1.134 +        (load-state save)))))
   1.135 +
   1.136 +(defn clear-history [] (reset! history empty-history))
   1.137 +
   1.138 +(defn rewind
   1.139 +  ([] (rewind 1))
   1.140 +  ([n] (goto (- @current-frame n))))
   1.141 +
   1.142 +(defn backup-state
   1.143 +  ([] (backup-state (frame)))
   1.144 +  ([frame]
   1.145 +  (let [save (save-state)]
   1.146 +    (swap! history #(assoc % frame save))
   1.147 +    ;;(store-save-to-disk save)
   1.148 +    (if (> (count @history) *max-history*)
   1.149 +      (swap! history #(dissoc % (first (first %))))))))
   1.150 +
   1.151 +(defn advance []
   1.152 +  (if *save-history*
   1.153 +    (backup-state @current-frame))
   1.154 +  (swap! current-frame inc))
   1.155 +
   1.156 +(defn step
   1.157 +  ([] (advance) (Gb/step))
   1.158 +  ([mask-or-buttons]
   1.159 +     (advance)
   1.160 +     (if (number? mask-or-buttons)
   1.161 +       (Gb/step mask-or-buttons)
   1.162 +       (Gb/step (button-mask mask-or-buttons)))))
   1.163 +
   1.164 +(defn play-moves
   1.165 +  ([start moves]
   1.166 +     (goto start)
   1.167 +     (dorun (map step moves))
   1.168 +     (backup-state)
   1.169 +     (frame))
   1.170 +  ([moves]
   1.171 +     (dorun (map step moves))
   1.172 +     (backup-state)
   1.173 +     (frame)))
   1.174 +
   1.175 +(defn play
   1.176 +  ([] (play Integer/MAX_VALUE))
   1.177 +  ([n] (dorun (dotimes [_ n] (step)))))
   1.178 +
   1.179 +(defmacro without-saves [& forms]
   1.180 +  `(binding [*save-history* false]
   1.181 +     ~@forms))
   1.182 +
   1.183 +
   1.184 +(require '(clojure [zip :as zip]))
   1.185 +
   1.186 +
   1.187 +
   1.188 +
   1.189 +(defn tree->str [original]
   1.190 +  (loop [s ".\n" loc (zip/down (zip/seq-zip (seq original)))]
   1.191 +    (if (zip/end? loc) s
   1.192 +        (let [d (count (zip/path loc))
   1.193 +	      rep
   1.194 +              (str
   1.195 +               s
   1.196 +               (if (and (zip/up loc)
   1.197 +                        (> (count (-> loc zip/up zip/rights)) 0))
   1.198 +                 "|" "")
   1.199 +               (apply str (repeat (dec d) "   "))
   1.200 +               (if (= (count (zip/rights loc)) 0)
   1.201 +                 "`-- "
   1.202 +                 "|-- ")
   1.203 +               (zip/node loc)
   1.204 +               "\n")]
   1.205 +          (recur rep (zip/next loc))))))
   1.206 +
   1.207 +
   1.208 +
   1.209 +