rlm@60: (ns com.aurellem.gb-driver rlm@60: (:import com.aurellem.gb.Gb) rlm@65: (:import java.io.File) rlm@77: (:import org.apache.commons.io.FileUtils) rlm@60: (:import (java.nio IntBuffer ByteOrder))) rlm@48: rlm@66: (Gb/loadVBA) rlm@65: rlm@81: (def ^:dynamic *max-history* 2e4) rlm@76: rlm@76: (def ^:dynamic *backup-saves-to-disk* true) rlm@76: rlm@76: (def ^:dynamic *save-history* true) rlm@76: rlm@76: (def ^:dynamic *save-state-cache* rlm@76: (File. "/home/r/proj/pokemon-escape/save-states/")) rlm@76: rlm@65: (def yellow-rom-image rlm@65: (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc")) rlm@65: rlm@67: (def yellow-save-file rlm@67: (File. "/home/r/proj/pokemon-escape/roms/yellow.sav")) rlm@67: rlm@73: (def current-frame (atom 0)) rlm@73: rlm@62: (defn vba-init [] rlm@73: (reset! current-frame 0) rlm@67: (.delete yellow-save-file) rlm@70: (Gb/startEmulator (.getCanonicalPath yellow-rom-image))) rlm@60: rlm@71: (defn shutdown [] (Gb/shutdown)) rlm@71: rlm@71: (defn reset [] (shutdown) (vba-init)) rlm@71: rlm@64: (defn cpu-data [size arr-fn] rlm@64: (let [store (int-array size)] rlm@76: (fn [] (arr-fn store) store))) rlm@60: rlm@64: (def ram rlm@64: (cpu-data (Gb/getRAMSize) #(Gb/getRAM %))) rlm@61: rlm@64: (def rom rlm@64: (cpu-data (Gb/getROMSize) #(Gb/getROM %))) rlm@61: rlm@64: (def working-ram rlm@64: (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %))) rlm@62: rlm@64: (def video-ram rlm@64: (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %))) rlm@64: rlm@64: (def registers rlm@64: (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %))) rlm@64: rlm@71: (def button-code rlm@71: {;; main buttons rlm@71: :a 0x0001 rlm@71: :b 0x0002 rlm@71: rlm@71: ;; directional pad rlm@71: :r 0x0010 rlm@71: :l 0x0020 rlm@71: :u 0x0040 rlm@71: :d 0x0080 rlm@71: rlm@71: ;; meta buttons rlm@71: :select 0x0004 rlm@71: :start 0x0008 rlm@71: rlm@71: ;; hard reset -- not really a button rlm@71: :reset 0x0800}) rlm@71: rlm@71: (defn button-mask [buttons] rlm@71: (reduce bit-or 0x0000 (map button-code buttons))) rlm@71: rlm@71: (defn buttons [mask] rlm@71: (loop [buttons [] rlm@71: masks (seq button-code)] rlm@71: (if (empty? masks) buttons rlm@71: (let [[button value] (first masks)] rlm@71: (if (not= 0x0000 (bit-and value mask)) rlm@71: (recur (conj buttons button) (rest masks)) rlm@71: (recur buttons (rest masks))))))) rlm@71: rlm@76: (defrecord SaveState [frame save-data]) rlm@73: rlm@76: (defn frame [] @current-frame) rlm@73: rlm@76: (defn save-state [] rlm@77: (SaveState. (frame) (Gb/saveState))) rlm@76: rlm@76: (defn load-state [#^SaveState save] rlm@76: (reset! current-frame (:frame save)) rlm@76: (Gb/loadState (:save-data save))) rlm@76: rlm@76: (def empty-history (sorted-map)) rlm@76: rlm@76: (def history (atom empty-history)) rlm@76: rlm@76: (defn frame->disk-save [frame] rlm@76: (File. *save-state-cache* rlm@76: (format "%07d.sav" frame))) rlm@76: rlm@76: (defn get-save-from-disk [frame] rlm@76: (let [save (frame->disk-save frame)] rlm@76: (if (.exists save) rlm@76: (let [buf (Gb/saveBuffer) rlm@77: bytes (FileUtils/readFileToByteArray save)] rlm@76: (.put buf bytes) rlm@76: (.flip buf) rlm@76: (SaveState. frame buf))))) rlm@76: rlm@76: (defn store-save-to-disk [^SaveState save] rlm@76: (let [buf (:save-data save) rlm@76: bytes (byte-array (.limit buf)) rlm@76: dest (frame->disk-save (:frame save))] rlm@76: (.get buf bytes) rlm@77: (FileUtils/writeByteArrayToFile dest bytes) rlm@77: (.rewind buf) dest)) rlm@76: rlm@76: (defn find-save-state [frame] rlm@76: (let [save (@history frame)] rlm@76: (if (not (nil? save)) save rlm@76: (get-save-from-disk frame)))) rlm@73: rlm@73: (defn goto [frame] rlm@76: (let [save (find-save-state frame)] rlm@76: (if (nil? save) rlm@76: (println frame "is not in history") rlm@73: (do rlm@73: (reset! current-frame frame) rlm@76: (load-state save))))) rlm@73: rlm@76: (defn clear-history [] (reset! history empty-history)) rlm@73: rlm@74: (defn rewind rlm@76: ([] (rewind 1)) rlm@76: ([n] (goto (- @current-frame n)))) rlm@76: rlm@81: (defn backup-state rlm@82: ([] (backup-state (frame))) rlm@82: ([frame] rlm@77: (let [save (save-state)] rlm@77: (swap! history #(assoc % frame save)) rlm@81: ;;(store-save-to-disk save) rlm@77: (if (> (count @history) *max-history*) rlm@82: (swap! history #(dissoc % (first (first %)))))))) rlm@73: rlm@73: (defn advance [] rlm@75: (if *save-history* rlm@76: (backup-state @current-frame)) rlm@76: (swap! current-frame inc)) rlm@73: rlm@65: (defn step rlm@73: ([] (advance) (Gb/step)) rlm@71: ([mask-or-buttons] rlm@73: (advance) rlm@71: (if (number? mask-or-buttons) rlm@71: (Gb/step mask-or-buttons) rlm@71: (Gb/step (button-mask mask-or-buttons))))) rlm@73: rlm@81: (defn play-moves rlm@81: ([start moves] rlm@81: (goto start) rlm@82: (dorun (map step moves)) rlm@82: (backup-state) rlm@82: (frame)) rlm@81: ([moves] rlm@82: (dorun (map step moves)) rlm@82: (backup-state) rlm@82: (frame))) rlm@81: rlm@76: (defn play rlm@77: ([] (play Integer/MAX_VALUE)) rlm@77: ([n] (dorun (dotimes [_ n] (step))))) rlm@75: rlm@79: (defmacro without-saves [& forms] rlm@79: `(binding [*save-history* false] rlm@79: ~@forms)) rlm@77: rlm@83: rlm@83: (require '(clojure [zip :as zip])) rlm@83: rlm@83: rlm@83: rlm@83: rlm@83: (defn tree->str [original] rlm@83: (loop [s ".\n" loc (zip/down (zip/seq-zip (seq original)))] rlm@83: (if (zip/end? loc) s rlm@83: (let [d (count (zip/path loc)) rlm@83: rep rlm@83: (str rlm@83: s rlm@83: (if (and (zip/up loc) rlm@83: (> (count (-> loc zip/up zip/rights)) 0)) rlm@83: "|" "") rlm@83: (apply str (repeat (dec d) " ")) rlm@83: (if (= (count (zip/rights loc)) 0) rlm@83: "`-- " rlm@83: "|-- ") rlm@83: (zip/node loc) rlm@83: "\n")] rlm@83: (recur rep (zip/next loc)))))) rlm@83: rlm@83: rlm@83: rlm@83: