Mercurial > vba-clojure

annotate clojure/com/aurellem/vbm.clj @ 92:1ff2c546f5ad

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
added tick(), which allows one to step through each opcode of gameboy
author Robert McIntyre <rlm@mit.edu>
date Sun, 11 Mar 2012 19:07:31 -0500
parents 65c2854c5875
children 718abf3bec8a
rev   line source
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@88 6 ;;;;;;;;;;;;; read vbm file
rlm@88 7
rlm@88 8 (def ^:dynamic *moves-cache*
rlm@88 9 (File. "/home/r/proj/pokemon-escape/moves/"))
rlm@88 10
rlm@87 11 (defn buttons [mask]
rlm@87 12 (loop [buttons []
rlm@87 13 masks (seq (dissoc button-code :listen))]
rlm@87 14 (if (empty? masks) buttons
rlm@87 15 (let [[button value] (first masks)]
rlm@87 16 (if (not= 0x0000 (bit-and value mask))
rlm@87 17 (recur (conj buttons button) (rest masks))
rlm@87 18 (recur buttons (rest masks)))))))
rlm@87 19
rlm@68 20 (defn vbm-bytes [#^File vbm]
rlm@68 21 (let [bytes (FileUtils/readFileToByteArray vbm)
rlm@68 22 ints (int-array (count bytes))]
rlm@68 23 (areduce bytes idx _ nil
rlm@68 24 (aset ints idx
rlm@68 25 (bit-and 0xFF (aget bytes idx))))
rlm@68 26 ints))
rlm@68 27
rlm@68 28 (def vbm-header-length 255)
rlm@68 29
rlm@68 30 (defn repair-vbm
rlm@70 31 "Two 0's must be inserted after every reset."
rlm@72 32 [vbm-masks]
rlm@68 33 (loop [fixed []
rlm@72 34 pending vbm-masks]
rlm@68 35 (if (empty? pending) fixed
rlm@68 36 (let [mask (first pending)]
rlm@88 37 (if (not= 0x0000 (bit-and mask (button-code :restart)))
rlm@68 38 (recur (conj fixed mask 0x0000 0x0000) (next pending))
rlm@68 39 (recur (conj fixed mask) (next pending)))))))
rlm@68 40
rlm@68 41 (defn vbm-masks [#^File vbm]
rlm@68 42 (repair-vbm
rlm@68 43 (map (fn [[a b]]
rlm@68 44 (+ (bit-shift-left a 8) b))
rlm@68 45 (partition
rlm@68 46 2 (drop vbm-header-length (vbm-bytes vbm))))))
rlm@68 47
rlm@68 48 (defn vbm-buttons [#^File vbm]
rlm@68 49 (map buttons (vbm-masks vbm)))
rlm@68 50
rlm@72 51 (defn convert-buttons
rlm@72 52 "To write a vbm file, we must remove the last two buttons after any
rlm@72 53 reset event."
rlm@72 54 [buttons]
rlm@72 55 (loop [fixed []
rlm@72 56 pending buttons]
rlm@72 57 (if (empty? pending) fixed
rlm@72 58 (let [mask (first pending)]
rlm@73 59 (if (contains? (set (first pending)) :reset)
rlm@72 60 (recur (conj fixed mask) (drop 3 pending))
rlm@72 61 (recur (conj fixed mask) (next pending)))))))
rlm@68 62
rlm@88 63 (defn moves->filename [frame]
rlm@88 64 (File. *moves-cache* (format "%07d.vbm" frame)))
rlm@88 65
rlm@88 66 (defn read-moves [frame]
rlm@88 67 (let [target (moves->filename frame)]
rlm@88 68 (if (.exists target)
rlm@88 69 (vbm-buttons target))))
rlm@88 70 ;;;;;;;;;;;;;; write moves to vbm file
rlm@88 71
rlm@88 72
rlm@72 73 (def vbm-header
rlm@72 74 (byte-array
rlm@72 75 (map
rlm@72 76 byte
rlm@72 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@72 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@72 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@72 80 95 95 82 111 98 101 114 116 32 32 77 99 73 110 116 121 114 101 95
rlm@72 81 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72 82 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72 83 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72 84 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72 85 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72 86 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72 87 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72 88 95 95 95 95])))
rlm@72 89
rlm@72 90 (def vbm-trailer
rlm@72 91 (byte-array
rlm@72 92 (map byte [0])))
rlm@72 93
rlm@72 94 (defn buttons->vbm-bytes [buttons]
rlm@72 95 (let [bytes-in-ints
rlm@72 96 (map button-mask (convert-buttons buttons))
rlm@72 97 high-bits (map #(bit-shift-right (bit-and 0xFF00 %) 8)
rlm@72 98 bytes-in-ints)
rlm@72 99 low-bits (map #(bit-and 0xFF %) bytes-in-ints)
rlm@72 100 convert-byte (fn [i] (byte (if (>= i 128) (- i 256) i)))
rlm@72 101 contents
rlm@72 102 (byte-array
rlm@72 103 (concat
rlm@72 104 vbm-header
rlm@72 105 (map convert-byte (interleave high-bits low-bits))
rlm@72 106 vbm-trailer))]
rlm@72 107 contents))
rlm@72 108
rlm@88 109 (defn write-moves! [moves]
rlm@88 110 (let [target (moves->filename (count moves))]
rlm@88 111 (clojure.java.io/copy (buttons->vbm-bytes moves) target)
rlm@88 112 target))
rlm@88 113
rlm@88 114 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
rlm@88 115
rlm@88 116 (use 'clojure.java.shell)
rlm@88 117
rlm@88 118
rlm@88 119 (defn play-vbm [#^File vbm]
rlm@88 120 (.delete yellow-save-file)
rlm@88 121 (if (.exists vbm)
rlm@88 122 (sh "/home/r/bin/vba-linux"
rlm@88 123 (str "--playmovie=" (.getCanonicalPath vbm))
rlm@88 124 (.getCanonicalPath yellow-rom-image)))
rlm@88 125 nil)
rlm@88 126