Mercurial > vba-clojure

view clojure/com/aurellem/vbm.clj @ 69:063b78119835

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
remove obsolete testing code
author Robert McIntyre <rlm@mit.edu>
date Thu, 08 Mar 2012 02:12:49 -0600
parents 86093f2ce7d1
children ff6f1acae59e
line wrap: on
line source
     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