1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/clojure/com/aurellem/vbm.clj	Thu Mar 08 02:10:03 2012 -0600
     1.3 @@ -0,0 +1,71 @@
     1.4 +(ns com.aurellem.vbm
     1.5 +  (:import java.io.File)
     1.6 +  (:import org.apache.commons.io.FileUtils))
     1.7 +
     1.8 +(defn vbm-bytes [#^File vbm]
     1.9 +  (let [bytes (FileUtils/readFileToByteArray vbm)
    1.10 +        ints (int-array (count bytes))]
    1.11 +    (areduce bytes idx _ nil
    1.12 +             (aset ints idx
    1.13 +                   (bit-and 0xFF (aget bytes idx))))
    1.14 +    ints))
    1.15 +
    1.16 +(def button-mask
    1.17 +  {;; main buttons
    1.18 +   :a         0x0001
    1.19 +   :b         0x0002
    1.20 +
    1.21 +   ;; directional pad
    1.22 +   :r         0x0010
    1.23 +   :l         0x0020
    1.24 +   :u         0x0040
    1.25 +   :d         0x0080
    1.26 +
    1.27 +   ;; meta buttons
    1.28 +   :select    0x0004
    1.29 +   :start     0x0008
    1.30 +
    1.31 +   ;; hard reset -- not really a button
    1.32 +   :reset   0x0800})
    1.33 +
    1.34 +(defn button-code [buttons]
    1.35 +  (reduce bit-or 0x0000 (map button-mask buttons)))
    1.36 +
    1.37 +(defn buttons [mask]
    1.38 +  (loop [buttons []
    1.39 +         masks (seq button-mask)]
    1.40 +    (if (empty? masks) buttons
    1.41 +        (let [[button value] (first masks)]
    1.42 +          (if (not= 0x0000 (bit-and value mask))
    1.43 +            (recur (conj buttons button) (rest masks))
    1.44 +            (recur buttons (rest masks)))))))
    1.45 +
    1.46 +(def vbm-header-length 255)
    1.47 +
    1.48 +(defn repair-vbm
    1.49 +  "Two 0's must be inserted after every reset, and the first
    1.50 +   button must be dropped"
    1.51 +  [vbm-seq]
    1.52 +  (loop [fixed []
    1.53 +         pending (next vbm-seq)]
    1.54 +    (if (empty? pending) fixed
    1.55 +        (let [mask (first pending)]
    1.56 +          (if (not= 0x0000 (bit-and mask (button-mask :reset)))
    1.57 +            (recur (conj fixed mask 0x0000 0x0000) (next pending))
    1.58 +            (recur (conj fixed mask) (next pending)))))))
    1.59 +
    1.60 +(defn vbm-masks [#^File vbm]
    1.61 +  (repair-vbm
    1.62 +   (map (fn [[a b]]
    1.63 +          (+ (bit-shift-left a 8) b))
    1.64 +        (partition
    1.65 +         2 (drop vbm-header-length (vbm-bytes vbm))))))
    1.66 +
    1.67 +(defn vbm-buttons [#^File vbm]
    1.68 +  (map buttons (vbm-masks vbm)))
    1.69 +  
    1.70 +
    1.71 +
    1.72 +         
    1.73 +    
    1.74 +  
    1.75 \ No newline at end of file