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))
|