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."

    47   [vbm-seq]

    48   (loop [fixed []

    49          pending vbm-seq]

    50     (if (empty? pending) fixed

    51         (let [mask (first pending)]

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

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

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

    55 

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

    57   (repair-vbm

    58    (map (fn [[a b]]

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

    60         (partition

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

    62 

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

    64   (map buttons (vbm-masks vbm)))

    65   

    66 

    67 

    68          

    69     

    70
author	Robert McIntyre <rlm@mit.edu>
date	Thu, 08 Mar 2012 02:25:20 -0600
parents	86093f2ce7d1
children	39928bf4622d