Mercurial > vba-clojure

     1 (ns com.aurellem.vbm

     2   (:import java.io.File)

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

     4 

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

     6   (let [bytes (FileUtils/readFileToByteArray vbm)

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

     8     (areduce bytes idx _ nil

     9              (aset ints idx

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

    11     ints))

    12 

    13 (def button-mask

    14   {;; main buttons

    15    :a         0x0001

    16    :b         0x0002

    17 

    18    ;; directional pad

    19    :r         0x0010

    20    :l         0x0020

    21    :u         0x0040

    22    :d         0x0080

    23 

    24    ;; meta buttons

    25    :select    0x0004

    26    :start     0x0008

    27 

    28    ;; hard reset -- not really a button

    29    :reset   0x0800})

    30 

    31 (defn button-code [buttons]

    32   (reduce bit-or 0x0000 (map button-mask buttons)))

    33 

    34 (defn buttons [mask]

    35   (loop [buttons []

    36          masks (seq button-mask)]

    37     (if (empty? masks) buttons

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

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

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

    41             (recur buttons (rest masks)))))))

    42 

    43 (def vbm-header-length 255)

    44 

    45 (defn repair-vbm

    46   "Two 0's must be inserted after every reset, and the first

    47    button must be dropped"

    48   [vbm-seq]

    49   (loop [fixed []

    50          pending (next vbm-seq)]

    51     (if (empty? pending) fixed

    52         (let [mask (first pending)]

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

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

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

    56 

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

    58   (repair-vbm

    59    (map (fn [[a b]]

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

    61         (partition

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

    63 

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

    65   (map buttons (vbm-masks vbm)))

    66   

    67 

    68 

    69          

    70     

    71
author	Robert McIntyre <rlm@mit.edu>
date	Thu, 08 Mar 2012 02:10:03 -0600
parents
children	ff6f1acae59e