Mercurial > vba-clojure

comparison clojure/com/aurellem/vbm.clj @ 71:39928bf4622d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
refactored
author Robert McIntyre <rlm@mit.edu>
date Thu, 08 Mar 2012 02:47:09 -0600
parents ff6f1acae59e
children c88ad4f6d9b4
comparison
equal deleted inserted replaced
70:ff6f1acae59e 71:39928bf4622d
1 (ns com.aurellem.vbm 1 (ns com.aurellem.vbm
2 (:import java.io.File) 2 (:import java.io.File)
3 (:import org.apache.commons.io.FileUtils)) 3 (:import org.apache.commons.io.FileUtils)
4 (:use com.aurellem.gb-driver))
4 5
5 (defn vbm-bytes [#^File vbm] 6 (defn vbm-bytes [#^File vbm]
6 (let [bytes (FileUtils/readFileToByteArray vbm) 7 (let [bytes (FileUtils/readFileToByteArray vbm)
7 ints (int-array (count bytes))] 8 ints (int-array (count bytes))]
8 (areduce bytes idx _ nil 9 (areduce bytes idx _ nil
9 (aset ints idx 10 (aset ints idx
10 (bit-and 0xFF (aget bytes idx)))) 11 (bit-and 0xFF (aget bytes idx))))
11 ints)) 12 ints))
12
13 (def button-mask
14 {;; main buttons
15 :a 0x0001
16 :b 0x0002
17
18 ;; directional pad
19 :r 0x0010
20 :l 0x0020
21 :u 0x0040
22 :d 0x0080
23
24 ;; meta buttons
25 :select 0x0004
26 :start 0x0008
27
28 ;; hard reset -- not really a button
29 :reset 0x0800})
30
31 (defn button-code [buttons]
32 (reduce bit-or 0x0000 (map button-mask buttons)))
33
34 (defn buttons [mask]
35 (loop [buttons []
36 masks (seq button-mask)]
37 (if (empty? masks) buttons
38 (let [[button value] (first masks)]
39 (if (not= 0x0000 (bit-and value mask))
40 (recur (conj buttons button) (rest masks))
41 (recur buttons (rest masks)))))))
42 13
43 (def vbm-header-length 255) 14 (def vbm-header-length 255)
44 15
45 (defn repair-vbm 16 (defn repair-vbm
46 "Two 0's must be inserted after every reset." 17 "Two 0's must be inserted after every reset."
47 [vbm-seq] 18 [vbm-seq]
48 (loop [fixed [] 19 (loop [fixed []
49 pending vbm-seq] 20 pending vbm-seq]
50 (if (empty? pending) fixed 21 (if (empty? pending) fixed
51 (let [mask (first pending)] 22 (let [mask (first pending)]
52 (if (not= 0x0000 (bit-and mask (button-mask :reset))) 23 (if (not= 0x0000 (bit-and mask (button-code :reset)))
53 (recur (conj fixed mask 0x0000 0x0000) (next pending)) 24 (recur (conj fixed mask 0x0000 0x0000) (next pending))
54 (recur (conj fixed mask) (next pending))))))) 25 (recur (conj fixed mask) (next pending)))))))
55 26
56 (defn vbm-masks [#^File vbm] 27 (defn vbm-masks [#^File vbm]
57 (repair-vbm 28 (repair-vbm
61 2 (drop vbm-header-length (vbm-bytes vbm)))))) 32 2 (drop vbm-header-length (vbm-bytes vbm))))))
62 33
63 (defn vbm-buttons [#^File vbm] 34 (defn vbm-buttons [#^File vbm]
64 (map buttons (vbm-masks vbm))) 35 (map buttons (vbm-masks vbm)))
65 36
37 (defn play-vbm [#^File vbm]
38 (reset)
39 (dorun (map step (vbm-masks vbm))))
66 40
67 41
68 42
69 43
70 44