Mercurial > vba-clojure

comparison clojure/com/aurellem/gb/vbm.clj @ 145:412ca096a9ba

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
major refactoring complete.
author Robert McIntyre <rlm@mit.edu>
date Mon, 19 Mar 2012 21:23:46 -0500
parents
children b7f682bb3090
comparison
equal deleted inserted replaced
144:ec477931f077 145:412ca096a9ba
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))
5
6 ;;;;;;;;;;;;; read vbm file
7
8 (def ^:dynamic *moves-cache*
9 (File. user-home "proj/pokemon-escape/moves/"))
10
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)))))))
19
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))
27
28 (def vbm-header-length 255)
29
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)))))))
40
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))))))
47
48 (defn vbm-buttons [#^File vbm]
49 (map buttons (vbm-masks vbm)))
50
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)) :reset)
60 (recur (conj fixed mask) (drop 3 pending))
61 (recur (conj fixed mask) (next pending)))))))
62
63 (defn moves->filename [frame]
64 (File. *moves-cache* (format "%07d.vbm" frame)))
65
66 (defn read-moves [frame]
67 (let [target (moves->filename frame)]
68 (if (.exists target)
69 (vbm-buttons target))))
70 ;;;;;;;;;;;;;; write moves to vbm file
71
72
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])))
89
90 (def vbm-trailer
91 (byte-array
92 (map byte [0])))
93
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))
108
109 (defn write-moves! [moves]
110 (let [target (moves->filename (count moves))]
111 (clojure.java.io/copy (buttons->vbm-bytes moves) target)
112 target))
113
114 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
115
116 (use 'clojure.java.shell)
117
118 (def vba-linux (File. user-home "bin/vba-linux"))
119
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)
127