|
rlm@145
|
1 (ns com.aurellem.gb.vbm
|
|
rlm@145
|
2 (:import java.io.File)
|
|
rlm@145
|
3 (:import org.apache.commons.io.FileUtils)
|
|
rlm@145
|
4 (:use com.aurellem.gb.gb-driver))
|
|
rlm@145
|
5
|
|
rlm@145
|
6 ;;;;;;;;;;;;; read vbm file
|
|
rlm@145
|
7
|
|
rlm@145
|
8 (def ^:dynamic *moves-cache*
|
|
rlm@250
|
9 (File. user-home "proj/vba-clojure/moves/"))
|
|
rlm@145
|
10
|
|
rlm@145
|
11 (defn buttons [mask]
|
|
rlm@145
|
12 (loop [buttons []
|
|
rlm@145
|
13 masks (seq (dissoc button-code :listen))]
|
|
rlm@145
|
14 (if (empty? masks) buttons
|
|
rlm@145
|
15 (let [[button value] (first masks)]
|
|
rlm@145
|
16 (if (not= 0x0000 (bit-and value mask))
|
|
rlm@145
|
17 (recur (conj buttons button) (rest masks))
|
|
rlm@145
|
18 (recur buttons (rest masks)))))))
|
|
rlm@145
|
19
|
|
rlm@145
|
20 (defn vbm-bytes [#^File vbm]
|
|
rlm@145
|
21 (let [bytes (FileUtils/readFileToByteArray vbm)
|
|
rlm@145
|
22 ints (int-array (count bytes))]
|
|
rlm@145
|
23 (areduce bytes idx _ nil
|
|
rlm@145
|
24 (aset ints idx
|
|
rlm@145
|
25 (bit-and 0xFF (aget bytes idx))))
|
|
rlm@145
|
26 ints))
|
|
rlm@145
|
27
|
|
rlm@145
|
28 (def vbm-header-length 255)
|
|
rlm@145
|
29
|
|
rlm@145
|
30 (defn repair-vbm
|
|
rlm@145
|
31 "Two 0's must be inserted after every reset."
|
|
rlm@145
|
32 [vbm-masks]
|
|
rlm@145
|
33 (loop [fixed []
|
|
rlm@145
|
34 pending vbm-masks]
|
|
rlm@145
|
35 (if (empty? pending) fixed
|
|
rlm@145
|
36 (let [mask (first pending)]
|
|
rlm@145
|
37 (if (not= 0x0000 (bit-and mask (button-code :restart)))
|
|
rlm@145
|
38 (recur (conj fixed mask 0x0000 0x0000) (next pending))
|
|
rlm@145
|
39 (recur (conj fixed mask) (next pending)))))))
|
|
rlm@145
|
40
|
|
rlm@145
|
41 (defn vbm-masks [#^File vbm]
|
|
rlm@145
|
42 (repair-vbm
|
|
rlm@145
|
43 (map (fn [[a b]]
|
|
rlm@145
|
44 (+ (bit-shift-left a 8) b))
|
|
rlm@145
|
45 (partition
|
|
rlm@145
|
46 2 (drop vbm-header-length (vbm-bytes vbm))))))
|
|
rlm@145
|
47
|
|
rlm@145
|
48 (defn vbm-buttons [#^File vbm]
|
|
rlm@145
|
49 (map buttons (vbm-masks vbm)))
|
|
rlm@145
|
50
|
|
rlm@145
|
51 (defn convert-buttons
|
|
rlm@145
|
52 "To write a vbm file, we must remove the last two buttons after any
|
|
rlm@145
|
53 reset event."
|
|
rlm@145
|
54 [buttons]
|
|
rlm@145
|
55 (loop [fixed []
|
|
rlm@145
|
56 pending buttons]
|
|
rlm@145
|
57 (if (empty? pending) fixed
|
|
rlm@145
|
58 (let [mask (first pending)]
|
|
rlm@336
|
59 (if (contains? (set (first pending)) :restart)
|
|
rlm@145
|
60 (recur (conj fixed mask) (drop 3 pending))
|
|
rlm@145
|
61 (recur (conj fixed mask) (next pending)))))))
|
|
rlm@145
|
62
|
|
rlm@250
|
63 (defn moves-filename [name]
|
|
rlm@250
|
64 (File. *moves-cache* (format "%s.vbm" name)))
|
|
rlm@145
|
65
|
|
rlm@250
|
66 (defn read-moves [name]
|
|
rlm@250
|
67 (let [target (moves-filename name)]
|
|
rlm@145
|
68 (if (.exists target)
|
|
rlm@145
|
69 (vbm-buttons target))))
|
|
rlm@145
|
70 ;;;;;;;;;;;;;; write moves to vbm file
|
|
rlm@145
|
71
|
|
rlm@145
|
72
|
|
rlm@145
|
73 (def vbm-header
|
|
rlm@145
|
74 (byte-array
|
|
rlm@145
|
75 (map
|
|
rlm@145
|
76 byte
|
|
rlm@145
|
77 [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@145
|
78 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@145
|
79 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@145
|
80 95 95 82 111 98 101 114 116 32 32 77 99 73 110 116 121 114 101 95
|
|
rlm@145
|
81 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
|
|
rlm@145
|
82 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
|
|
rlm@145
|
83 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
|
|
rlm@145
|
84 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
|
|
rlm@145
|
85 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
|
|
rlm@145
|
86 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
|
|
rlm@145
|
87 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
|
|
rlm@145
|
88 95 95 95 95])))
|
|
rlm@145
|
89
|
|
rlm@145
|
90 (def vbm-trailer
|
|
rlm@145
|
91 (byte-array
|
|
rlm@145
|
92 (map byte [0])))
|
|
rlm@145
|
93
|
|
rlm@145
|
94 (defn buttons->vbm-bytes [buttons]
|
|
rlm@145
|
95 (let [bytes-in-ints
|
|
rlm@145
|
96 (map button-mask (convert-buttons buttons))
|
|
rlm@145
|
97 high-bits (map #(bit-shift-right (bit-and 0xFF00 %) 8)
|
|
rlm@145
|
98 bytes-in-ints)
|
|
rlm@145
|
99 low-bits (map #(bit-and 0xFF %) bytes-in-ints)
|
|
rlm@145
|
100 convert-byte (fn [i] (byte (if (>= i 128) (- i 256) i)))
|
|
rlm@145
|
101 contents
|
|
rlm@145
|
102 (byte-array
|
|
rlm@145
|
103 (concat
|
|
rlm@145
|
104 vbm-header
|
|
rlm@145
|
105 (map convert-byte (interleave high-bits low-bits))
|
|
rlm@145
|
106 vbm-trailer))]
|
|
rlm@145
|
107 contents))
|
|
rlm@145
|
108
|
|
rlm@250
|
109 (defn write-moves! [moves name]
|
|
rlm@250
|
110 (let [target (moves-filename name)]
|
|
rlm@145
|
111 (clojure.java.io/copy (buttons->vbm-bytes moves) target)
|
|
rlm@145
|
112 target))
|
|
rlm@145
|
113
|
|
rlm@145
|
114 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
rlm@145
|
115
|
|
rlm@145
|
116 (use 'clojure.java.shell)
|
|
rlm@145
|
117
|
|
rlm@145
|
118 (def vba-linux (File. user-home "bin/vba-linux"))
|
|
rlm@145
|
119
|
|
rlm@145
|
120 (defn play-vbm [#^File vbm]
|
|
rlm@145
|
121 (.delete yellow-save-file)
|
|
rlm@145
|
122 (if (.exists vbm)
|
|
rlm@145
|
123 (sh (.getCanonicalPath vba-linux)
|
|
rlm@145
|
124 (str "--playmovie=" (.getCanonicalPath vbm))
|
|
rlm@145
|
125 (.getCanonicalPath yellow-rom-image)))
|
|
rlm@145
|
126 nil)
|
|
rlm@145
|
127
|
|
rlm@335
|
128 (defn test-moves [moves]
|
|
rlm@335
|
129 (write-moves! moves "temp")
|
|
rlm@335
|
130 (play-vbm (moves-filename "temp")))
|
|
rlm@335
|
131
|
