Mercurial > vba-clojure

annotate clojure/com/aurellem/vbm.clj @ 76:d7c38ce83421

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