rlm@68: (ns com.aurellem.vbm
rlm@68:   (:import java.io.File)
rlm@71:   (:import org.apache.commons.io.FileUtils)
rlm@71:   (:use com.aurellem.gb-driver))
rlm@68: 
rlm@68: (defn vbm-bytes [#^File vbm]
rlm@68:   (let [bytes (FileUtils/readFileToByteArray vbm)
rlm@68:         ints (int-array (count bytes))]
rlm@68:     (areduce bytes idx _ nil
rlm@68:              (aset ints idx
rlm@68:                    (bit-and 0xFF (aget bytes idx))))
rlm@68:     ints))
rlm@68: 
rlm@68: (def vbm-header-length 255)
rlm@68: 
rlm@68: (defn repair-vbm
rlm@70:   "Two 0's must be inserted after every reset."
rlm@72:   [vbm-masks]
rlm@68:   (loop [fixed []
rlm@72:          pending vbm-masks]
rlm@68:     (if (empty? pending) fixed
rlm@68:         (let [mask (first pending)]
rlm@71:           (if (not= 0x0000 (bit-and mask (button-code :reset)))
rlm@68:             (recur (conj fixed mask 0x0000 0x0000) (next pending))
rlm@68:             (recur (conj fixed mask) (next pending)))))))
rlm@68: 
rlm@68: (defn vbm-masks [#^File vbm]
rlm@68:   (repair-vbm
rlm@68:    (map (fn [[a b]]
rlm@68:           (+ (bit-shift-left a 8) b))
rlm@68:         (partition
rlm@68:          2 (drop vbm-header-length (vbm-bytes vbm))))))
rlm@68: 
rlm@68: (defn vbm-buttons [#^File vbm]
rlm@68:   (map buttons (vbm-masks vbm)))
rlm@68:   
rlm@71: (defn play-vbm [#^File vbm]
rlm@71:   (reset)
rlm@71:   (dorun (map step (vbm-masks vbm))))
rlm@68: 
rlm@72: (defn convert-buttons
rlm@72:   "To write a vbm file, we must remove the last two buttons after any
rlm@72:    reset event."
rlm@72:   [buttons]
rlm@72:   (loop [fixed []
rlm@72:          pending buttons]
rlm@72:     (if (empty? pending) fixed
rlm@72:         (let [mask (first pending)]
rlm@72:           (if (contains? (first pending) :reset)
rlm@72:             (recur (conj fixed mask) (drop 3 pending))
rlm@72:             (recur (conj fixed mask) (next pending)))))))
rlm@68: 
rlm@72: (def vbm-header
rlm@72:   (byte-array
rlm@72:    (map
rlm@72:     byte
rlm@72:     [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:      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:      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:      95 95 82 111 98 101 114 116 32 32 77 99 73 110 116 121 114 101 95
rlm@72:      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72:      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72:      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72:      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72:      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72:      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72:      95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95 95
rlm@72:      95 95 95 95])))
rlm@72: 
rlm@72: (def vbm-trailer
rlm@72:   (byte-array
rlm@72:    (map byte [0])))
rlm@72: 
rlm@72: (defn buttons->vbm-bytes [buttons]
rlm@72:   (let [bytes-in-ints
rlm@72:         (map button-mask (convert-buttons buttons))
rlm@72:         high-bits (map #(bit-shift-right (bit-and 0xFF00 %) 8)
rlm@72:                        bytes-in-ints)
rlm@72:         low-bits (map #(bit-and 0xFF %) bytes-in-ints)
rlm@72:         convert-byte (fn [i] (byte (if (>= i 128) (- i 256) i)))
rlm@72:         contents
rlm@72:         (byte-array
rlm@72:          (concat
rlm@72:           vbm-header
rlm@72:           (map convert-byte (interleave high-bits low-bits))
rlm@72:           vbm-trailer))]
rlm@72:     contents))
rlm@72:         
rlm@72: (defn write-vbm [buttons #^File out]
rlm@72:   (clojure.java.io/copy (buttons->vbm-bytes buttons) out))
rlm@72:     
rlm@72:   
rlm@68:          
rlm@68:     
rlm@68: