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 vbm-bytes [#^File vbm]

     7   (let [bytes (FileUtils/readFileToByteArray vbm)

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

     9     (areduce bytes idx _ nil

    10              (aset ints idx

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

    12     ints))

    13 

    14 (def vbm-header-length 255)

    15 

    16 (defn repair-vbm

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

    18   [vbm-masks]

    19   (loop [fixed []

    20          pending vbm-masks]

    21     (if (empty? pending) fixed

    22         (let [mask (first pending)]

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

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

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

    26 

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

    28   (repair-vbm

    29    (map (fn [[a b]]

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

    31         (partition

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

    33 

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

    35   (map buttons (vbm-masks vbm)))

    36   

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

    38   (reset)

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

    40 

    41 (defn convert-buttons

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

    43    reset event."

    44   [buttons]

    45   (loop [fixed []

    46          pending buttons]

    47     (if (empty? pending) fixed

    48         (let [mask (first pending)]

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

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

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

    52 

    53 (def vbm-header

    54   (byte-array

    55    (map

    56     byte

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

    58      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

    59      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

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

    61      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    62      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    63      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    64      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    65      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    66      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    67      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95

    68      95 95 95 95])))

    69 

    70 (def vbm-trailer

    71   (byte-array

    72    (map byte [0])))

    73 

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

    75   (let [bytes-in-ints

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

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

    78                        bytes-in-ints)

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

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

    81         contents

    82         (byte-array

    83          (concat

    84           vbm-header

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

    86           vbm-trailer))]

    87     contents))

    88         

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

    90   (clojure.java.io/copy (buttons->vbm-bytes buttons) out))
author	Robert McIntyre <rlm@mit.edu>
date	Thu, 08 Mar 2012 19:48:54 -0600
parents	8a895ed4c0f9
children	e8855121f413