Mercurial > vba-clojure

annotate clojure/com/aurellem/vbm.clj @ 87:e8855121f413

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
collect cruft, rename other files
author Robert McIntyre <rlm@mit.edu>
date Sat, 10 Mar 2012 14:48:17 -0600
parents 8a895ed4c0f9
children 65c2854c5875
rev   line source
rlm@68 1 (ns com.aurellem.vbm
rlm@68 2 (:import java.io.File)
rlm@71 3 (:import org.apache.commons.io.FileUtils)
rlm@71 4 (:use com.aurellem.gb-driver))
rlm@68 5
rlm@87 6 (defn buttons [mask]
rlm@87 7 (loop [buttons []
rlm@87 8 masks (seq (dissoc button-code :listen))]
rlm@87 9 (if (empty? masks) buttons
rlm@87 10 (let [[button value] (first masks)]
rlm@87 11 (if (not= 0x0000 (bit-and value mask))
rlm@87 12 (recur (conj buttons button) (rest masks))
rlm@87 13 (recur buttons (rest masks)))))))
rlm@87 14
rlm@68 15 (defn vbm-bytes [#^File vbm]
rlm@68 16 (let [bytes (FileUtils/readFileToByteArray vbm)
rlm@68 17 ints (int-array (count bytes))]
rlm@68 18 (areduce bytes idx _ nil
rlm@68 19 (aset ints idx
rlm@68 20 (bit-and 0xFF (aget bytes idx))))
rlm@68 21 ints))
rlm@68 22
rlm@68 23 (def vbm-header-length 255)
rlm@68 24
rlm@68 25 (defn repair-vbm
rlm@70 26 "Two 0's must be inserted after every reset."
rlm@72 27 [vbm-masks]
rlm@68 28 (loop [fixed []
rlm@72 29 pending vbm-masks]
rlm@68 30 (if (empty? pending) fixed
rlm@68 31 (let [mask (first pending)]
rlm@71 32 (if (not= 0x0000 (bit-and mask (button-code :reset)))
rlm@68 33 (recur (conj fixed mask 0x0000 0x0000) (next pending))
rlm@68 34 (recur (conj fixed mask) (next pending)))))))
rlm@68 35
rlm@68 36 (defn vbm-masks [#^File vbm]
rlm@68 37 (repair-vbm
rlm@68 38 (map (fn [[a b]]
rlm@68 39 (+ (bit-shift-left a 8) b))
rlm@68 40 (partition
rlm@68 41 2 (drop vbm-header-length (vbm-bytes vbm))))))
rlm@68 42
rlm@68 43 (defn vbm-buttons [#^File vbm]
rlm@68 44 (map buttons (vbm-masks vbm)))
rlm@68 45
rlm@71 46 (defn play-vbm [#^File vbm]
rlm@87 47 (restart!)
rlm@71 48 (dorun (map step (vbm-masks vbm))))
rlm@68 49
rlm@72 50 (defn convert-buttons
rlm@72 51 "To write a vbm file, we must remove the last two buttons after any
rlm@72 52 reset event."
rlm@72 53 [buttons]
rlm@72 54 (loop [fixed []
rlm@72 55 pending buttons]
rlm@72 56 (if (empty? pending) fixed
rlm@72 57 (let [mask (first pending)]
rlm@73 58 (if (contains? (set (first pending)) :reset)
rlm@72 59 (recur (conj fixed mask) (drop 3 pending))
rlm@72 60 (recur (conj fixed mask) (next pending)))))))
rlm@68 61
rlm@72 62 (def vbm-header
rlm@72 63 (byte-array
rlm@72 64 (map
rlm@72 65 byte
rlm@72 66 [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
rlm@72 67 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
rlm@72 68 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
rlm@72 69 95 95 82 111 98 101 114 116 32 32 77 99 73 110 116 121 114 101 95
rlm@72 70 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72 71 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72 72 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72 73 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72 74 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72 75 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72 76 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72 77 95 95 95 95])))
rlm@72 78
rlm@72 79 (def vbm-trailer
rlm@72 80 (byte-array
rlm@72 81 (map byte [0])))
rlm@72 82
rlm@72 83 (defn buttons->vbm-bytes [buttons]
rlm@72 84 (let [bytes-in-ints
rlm@72 85 (map button-mask (convert-buttons buttons))
rlm@72 86 high-bits (map #(bit-shift-right (bit-and 0xFF00 %) 8)
rlm@72 87 bytes-in-ints)
rlm@72 88 low-bits (map #(bit-and 0xFF %) bytes-in-ints)
rlm@72 89 convert-byte (fn [i] (byte (if (>= i 128) (- i 256) i)))
rlm@72 90 contents
rlm@72 91 (byte-array
rlm@72 92 (concat
rlm@72 93 vbm-header
rlm@72 94 (map convert-byte (interleave high-bits low-bits))
rlm@72 95 vbm-trailer))]
rlm@72 96 contents))
rlm@72 97
rlm@72 98 (defn write-vbm [buttons #^File out]
rlm@72 99 (clojure.java.io/copy (buttons->vbm-bytes buttons) out))