Mercurial > vba-clojure

     1 (ns com.aurellem.vbm

     2   (:import java.io.File)

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

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

     5 

     6 (defn buttons [mask]

     7   (loop [buttons []

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

     9     (if (empty? masks) buttons

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

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

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

    13             (recur buttons (rest masks)))))))

    14 

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

    16   (let [bytes (FileUtils/readFileToByteArray vbm)

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

    18     (areduce bytes idx _ nil

    19              (aset ints idx

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

    21     ints))

    22 

    23 (def vbm-header-length 255)

    24 

    25 (defn repair-vbm

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

    27   [vbm-masks]

    28   (loop [fixed []

    29          pending vbm-masks]

    30     (if (empty? pending) fixed

    31         (let [mask (first pending)]

    32           (if (not= 0x0000 (bit-and mask (button-code :reset)))

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

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

    35 

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

    37   (repair-vbm

    38    (map (fn [[a b]]

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

    40         (partition

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

    42 

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

    44   (map buttons (vbm-masks vbm)))

    45   

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

    47   (restart!)

    48   (dorun (map step (vbm-masks vbm))))

    49 

    50 (defn convert-buttons

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

    52    reset event."

    53   [buttons]

    54   (loop [fixed []

    55          pending buttons]

    56     (if (empty? pending) fixed

    57         (let [mask (first pending)]

    58           (if (contains? (set (first pending)) :reset)

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

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

    61 

    62 (def vbm-header

    63   (byte-array

    64    (map

    65     byte

    66     [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

    67      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

    68      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

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

    70      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    71      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    72      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    73      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    74      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    75      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    76      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    77      95 95 95 95])))

    78 

    79 (def vbm-trailer

    80   (byte-array

    81    (map byte [0])))

    82 

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

    84   (let [bytes-in-ints

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

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

    87                        bytes-in-ints)

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

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

    90         contents

    91         (byte-array

    92          (concat

    93           vbm-header

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

    95           vbm-trailer))]

    96     contents))

    97         

    98 (defn write-vbm [buttons #^File out]

    99   (clojure.java.io/copy (buttons->vbm-bytes buttons) out))
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 10 Mar 2012 14:48:17 -0600
parents	8a895ed4c0f9
children	65c2854c5875