view clojure/com/aurellem/gb/vbm.clj @ 500:0273c08cd2ff

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