Mercurial > vba-clojure

     1 (ns com.aurellem.gb.vbm

     2   (:import java.io.File)

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

     4   (:use com.aurellem.gb.gb-driver))

     5 

     6 ;;;;;;;;;;;;; read vbm file 

     7 

     8 (def ^:dynamic *moves-cache*

     9      (File. user-home "proj/vba-clojure/moves/"))

    10 

    11 (defn buttons [mask]

    12   (loop [buttons []

    13          masks (seq (dissoc button-code :listen))]

    14     (if (empty? masks) buttons

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

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

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

    18             (recur buttons (rest masks)))))))

    19 

    20 (defn vbm-bytes [#^File vbm]

    21   (let [bytes (FileUtils/readFileToByteArray vbm)

    22         ints (int-array (count bytes))]

    23     (areduce bytes idx _ nil

    24              (aset ints idx

    25                    (bit-and 0xFF (aget bytes idx))))

    26     ints))

    27 

    28 (def vbm-header-length 255)

    29 

    30 (defn repair-vbm

    31   "Two 0's must be inserted after every reset."

    32   [vbm-masks]

    33   (loop [fixed []

    34          pending vbm-masks]

    35     (if (empty? pending) fixed

    36         (let [mask (first pending)]

    37           (if (not= 0x0000 (bit-and mask (button-code :restart)))

    38             (recur (conj fixed mask 0x0000 0x0000) (next pending))

    39             (recur (conj fixed mask) (next pending)))))))

    40 

    41 (defn vbm-masks [#^File vbm]

    42   (repair-vbm

    43    (map (fn [[a b]]

    44           (+ (bit-shift-left a 8) b))

    45         (partition

    46          2 (drop vbm-header-length (vbm-bytes vbm))))))

    47 

    48 (defn vbm-buttons [#^File vbm]

    49   (map buttons (vbm-masks vbm)))

    50 

    51 (defn convert-buttons

    52   "To write a vbm file, we must remove the last two buttons after any

    53    reset event."

    54   [buttons]

    55   (loop [fixed []

    56          pending buttons]

    57     (if (empty? pending) fixed

    58         (let [mask (first pending)]

    59           (if (contains? (set (first pending)) :restart)

    60             (recur (conj fixed mask) (drop 3 pending))

    61             (recur (conj fixed mask) (next pending)))))))

    62 

    63 (defn moves-filename [name]

    64   (File. *moves-cache* (format "%s.vbm" name)))

    65 

    66 (defn read-moves [name]

    67   (let [target (moves-filename name)]

    68     (if (.exists target)

    69       (vbm-buttons target))))

    70 ;;;;;;;;;;;;;; write moves to vbm file

    71 

    72 

    73 (def vbm-header

    74   (byte-array

    75    (map

    76     byte

    77     [86 66 77 26 1 0 0 0 105 74 88 79 89 1 0 0 0 0 0 0 0 1 2 112 0 0 0

    78      0 0 0 0 0 1 0 0 0 80 79 75 69 77 79 78 32 89 69 76 76 1 -105 124 4

    79      3 0 0 0 0 0 0 0 0 1 0 0 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    80      95 95 82 111 98 101 114 116 32 32 77 99 73 110 116 121 114 101 95

    81      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    82      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    83      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    84      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    85      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    86      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    87      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    88      95 95 95 95])))

    89 

    90 (def vbm-trailer

    91   (byte-array

    92    (map byte [0])))

    93 

    94 (defn buttons->vbm-bytes [buttons]

    95   (let [bytes-in-ints

    96         (map button-mask (convert-buttons buttons))

    97         high-bits (map #(bit-shift-right (bit-and 0xFF00 %) 8)

    98                        bytes-in-ints)

    99         low-bits (map #(bit-and 0xFF %) bytes-in-ints)

   100         convert-byte (fn [i] (byte (if (>= i 128) (- i 256) i)))

   101         contents

   102         (byte-array

   103          (concat

   104           vbm-header

   105           (map convert-byte (interleave high-bits low-bits))

   106           vbm-trailer))]

   107     contents))

   108         

   109 (defn write-moves! [moves name]

   110   (let [target (moves-filename name)]

   111     (clojure.java.io/copy (buttons->vbm-bytes moves) target)

   112     target))

   113 

   114 (defn write-moves-to-file! [moves file]

   115   (clojure.java.io/copy (buttons->vbm-bytes moves) file))

   116 

   117 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;

   118 

   119 (use 'clojure.java.shell)

   120 

   121 (def vba-linux (File. user-home "bin/vba-linux"))

   122 

   123 (defn play-vbm [#^File vbm]

   124   (.delete yellow-save-file)

   125   (if (.exists vbm)

   126     (sh (.getCanonicalPath vba-linux)

   127         (str "--playmovie=" (.getCanonicalPath vbm))

   128         (.getCanonicalPath yellow-rom-image)))

   129   nil)

   130 

   131 (defn test-moves [moves]

   132   (write-moves! moves "temp")

   133   (play-vbm (moves-filename "temp")))

   134
author	Robert McIntyre <rlm@mit.edu>
date	Sun, 02 Sep 2012 10:34:14 -0500
parents	25b7bb7da3b1
children