Mercurial > vba-clojure

annotate clojure/com/aurellem/vbm.clj @ 134:718abf3bec8a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
removed hardcoded /home/r/ strings from paths and made them relative to user.home
author Robert McIntyre <rlm@mit.edu>
date Sun, 18 Mar 2012 00:56:29 -0500
parents 65c2854c5875
children eb6ba88088d3
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@134 9 (File. user-home "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@134 118 (def vba-linux (File. user-home "bin/vba-linux"))
rlm@88 119
rlm@88 120 (defn play-vbm [#^File vbm]
rlm@88 121 (.delete yellow-save-file)
rlm@88 122 (if (.exists vbm)
rlm@134 123 (sh (.getCanonicalPath vba-linux)
rlm@88 124 (str "--playmovie=" (.getCanonicalPath vbm))
rlm@88 125 (.getCanonicalPath yellow-rom-image)))
rlm@88 126 nil)
rlm@88 127