Mercurial > vba-clojure

     1 (ns com.aurellem.gb-driver

     2   (:import com.aurellem.gb.Gb)

     3   (:import java.io.File)

     4   (:import org.apache.commons.io.FileUtils)

     5   (:import (java.nio IntBuffer ByteOrder)))

     6 

     7 (Gb/loadVBA)

     8 

     9 (def ^:dynamic *max-history* 2e4)

    10 

    11 (def ^:dynamic *backup-saves-to-disk* true)

    12 

    13 (def ^:dynamic *save-history* true)

    14 

    15 (def ^:dynamic *save-state-cache*

    16   (File. "/home/r/proj/pokemon-escape/save-states/"))

    17 

    18 (def yellow-rom-image

    19   (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc"))

    20 

    21 (def yellow-save-file

    22   (File. "/home/r/proj/pokemon-escape/roms/yellow.sav"))

    23 

    24 (def current-frame (atom 0))

    25 

    26 (defn vba-init []

    27   (reset! current-frame 0)

    28   (.delete yellow-save-file)

    29   (Gb/startEmulator (.getCanonicalPath yellow-rom-image)))

    30 

    31 (defn shutdown [] (Gb/shutdown))

    32 

    33 (defn reset [] (shutdown) (vba-init))

    34 

    35 (defn cpu-data [size arr-fn]

    36   (let [store (int-array size)]

    37     (fn [] (arr-fn store) store)))

    38 

    39 (def ram

    40   (cpu-data (Gb/getRAMSize) #(Gb/getRAM %)))

    41 

    42 (def rom 

    43   (cpu-data (Gb/getROMSize) #(Gb/getROM %)))

    44 

    45 (def working-ram 

    46   (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %)))

    47 

    48 (def video-ram 

    49   (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %)))

    50 

    51 (def registers

    52   (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %)))

    53 

    54 (def button-code

    55   {;; main buttons

    56    :a         0x0001

    57    :b         0x0002

    58 

    59    ;; directional pad

    60    :r         0x0010

    61    :l         0x0020

    62    :u         0x0040

    63    :d         0x0080

    64 

    65    ;; meta buttons

    66    :select    0x0004

    67    :start     0x0008

    68 

    69    ;; hard reset -- not really a button

    70    :reset   0x0800})

    71 

    72 (defn button-mask [buttons]

    73   (reduce bit-or 0x0000 (map button-code buttons)))

    74 

    75 (defn buttons [mask]

    76   (loop [buttons []

    77          masks (seq button-code)]

    78     (if (empty? masks) buttons

    79         (let [[button value] (first masks)]

    80           (if (not= 0x0000 (bit-and value mask))

    81             (recur (conj buttons button) (rest masks))

    82             (recur buttons (rest masks)))))))

    83 

    84 (defrecord SaveState [frame save-data])

    85 

    86 (defn frame [] @current-frame)

    87 

    88 (defn save-state []

    89   (SaveState. (frame) (Gb/saveState)))

    90 

    91 (defn load-state [#^SaveState save]

    92   (reset! current-frame (:frame save))

    93   (Gb/loadState (:save-data save)))

    94 

    95 (def empty-history (sorted-map))

    96 

    97 (def history (atom empty-history))

    98 

    99 (defn frame->disk-save [frame]

   100   (File. *save-state-cache*

   101          (format "%07d.sav" frame)))

   102 

   103 (defn get-save-from-disk [frame]

   104   (let [save (frame->disk-save frame)]

   105     (if (.exists save)

   106       (let [buf (Gb/saveBuffer)

   107             bytes (FileUtils/readFileToByteArray save)]

   108         (.put buf bytes)

   109         (.flip buf)

   110         (SaveState. frame buf)))))

   111 

   112 (defn store-save-to-disk [^SaveState save]

   113   (let [buf (:save-data save)

   114         bytes (byte-array (.limit buf))

   115         dest (frame->disk-save (:frame save))]

   116     (.get buf bytes)

   117     (FileUtils/writeByteArrayToFile dest bytes)

   118     (.rewind buf) dest))

   119 

   120 (defn find-save-state [frame]

   121   (let [save (@history frame)]

   122     (if (not (nil? save)) save

   123         (get-save-from-disk frame))))

   124 

   125 (defn goto [frame]

   126   (let [save (find-save-state frame)]

   127     (if (nil? save)

   128       (println frame "is not in history")

   129       (do

   130         (reset! current-frame frame)

   131         (load-state save)))))

   132 

   133 (defn clear-history [] (reset! history empty-history))

   134 

   135 (defn rewind

   136   ([] (rewind 1))

   137   ([n] (goto (- @current-frame n))))

   138 

   139 (defn backup-state

   140   [frame]

   141   (let [save (save-state)]

   142     (swap! history #(assoc % frame save))

   143     ;;(store-save-to-disk save)

   144     (if (> (count @history) *max-history*)

   145       (swap! history #(dissoc % (first (first %)))))))

   146 

   147 (defn advance []

   148   (if *save-history*

   149     (backup-state @current-frame))

   150   (swap! current-frame inc))

   151 

   152 (defn step

   153   ([] (advance) (Gb/step))

   154   ([mask-or-buttons]

   155      (advance)

   156      (if (number? mask-or-buttons)

   157        (Gb/step mask-or-buttons)

   158        (Gb/step (button-mask mask-or-buttons)))))

   159 

   160 (defn play-moves

   161   ([start moves]

   162      (goto start)

   163      (dorun (map step moves)))

   164   ([moves]

   165      (dorun (map step moves))))

   166 

   167 (defn play

   168   ([] (play Integer/MAX_VALUE))

   169   ([n] (dorun (dotimes [_ n] (step)))))

   170 

   171 (defmacro without-saves [& forms]

   172   `(binding [*save-history* false]

   173      ~@forms))

   174
author	Robert McIntyre <rlm@mit.edu>
date	Fri, 09 Mar 2012 01:43:25 -0600
parents	7ab48d728ee4
children	04d539d26bdc