Mercurial > vba-clojure
comparison clojure/com/aurellem/vbm.clj @ 88:65c2854c5875
can now save moves and states and am ready to continue past the title
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 10 Mar 2012 15:36:26 -0600 |
parents | e8855121f413 |
children | 718abf3bec8a |
comparison
equal
deleted
inserted
replaced
87:e8855121f413 | 88:65c2854c5875 |
---|---|
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 (:use com.aurellem.gb-driver)) |
5 | |
6 ;;;;;;;;;;;;; read vbm file | |
7 | |
8 (def ^:dynamic *moves-cache* | |
9 (File. "/home/r/proj/pokemon-escape/moves/")) | |
5 | 10 |
6 (defn buttons [mask] | 11 (defn buttons [mask] |
7 (loop [buttons [] | 12 (loop [buttons [] |
8 masks (seq (dissoc button-code :listen))] | 13 masks (seq (dissoc button-code :listen))] |
9 (if (empty? masks) buttons | 14 (if (empty? masks) buttons |
27 [vbm-masks] | 32 [vbm-masks] |
28 (loop [fixed [] | 33 (loop [fixed [] |
29 pending vbm-masks] | 34 pending vbm-masks] |
30 (if (empty? pending) fixed | 35 (if (empty? pending) fixed |
31 (let [mask (first pending)] | 36 (let [mask (first pending)] |
32 (if (not= 0x0000 (bit-and mask (button-code :reset))) | 37 (if (not= 0x0000 (bit-and mask (button-code :restart))) |
33 (recur (conj fixed mask 0x0000 0x0000) (next pending)) | 38 (recur (conj fixed mask 0x0000 0x0000) (next pending)) |
34 (recur (conj fixed mask) (next pending))))))) | 39 (recur (conj fixed mask) (next pending))))))) |
35 | 40 |
36 (defn vbm-masks [#^File vbm] | 41 (defn vbm-masks [#^File vbm] |
37 (repair-vbm | 42 (repair-vbm |
40 (partition | 45 (partition |
41 2 (drop vbm-header-length (vbm-bytes vbm)))))) | 46 2 (drop vbm-header-length (vbm-bytes vbm)))))) |
42 | 47 |
43 (defn vbm-buttons [#^File vbm] | 48 (defn vbm-buttons [#^File vbm] |
44 (map buttons (vbm-masks vbm))) | 49 (map buttons (vbm-masks vbm))) |
45 | |
46 (defn play-vbm [#^File vbm] | |
47 (restart!) | |
48 (dorun (map step (vbm-masks vbm)))) | |
49 | 50 |
50 (defn convert-buttons | 51 (defn convert-buttons |
51 "To write a vbm file, we must remove the last two buttons after any | 52 "To write a vbm file, we must remove the last two buttons after any |
52 reset event." | 53 reset event." |
53 [buttons] | 54 [buttons] |
56 (if (empty? pending) fixed | 57 (if (empty? pending) fixed |
57 (let [mask (first pending)] | 58 (let [mask (first pending)] |
58 (if (contains? (set (first pending)) :reset) | 59 (if (contains? (set (first pending)) :reset) |
59 (recur (conj fixed mask) (drop 3 pending)) | 60 (recur (conj fixed mask) (drop 3 pending)) |
60 (recur (conj fixed mask) (next 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 | |
61 | 72 |
62 (def vbm-header | 73 (def vbm-header |
63 (byte-array | 74 (byte-array |
64 (map | 75 (map |
65 byte | 76 byte |
93 vbm-header | 104 vbm-header |
94 (map convert-byte (interleave high-bits low-bits)) | 105 (map convert-byte (interleave high-bits low-bits)) |
95 vbm-trailer))] | 106 vbm-trailer))] |
96 contents)) | 107 contents)) |
97 | 108 |
98 (defn write-vbm [buttons #^File out] | 109 (defn write-moves! [moves] |
99 (clojure.java.io/copy (buttons->vbm-bytes buttons) out)) | 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 | |
119 (defn play-vbm [#^File vbm] | |
120 (.delete yellow-save-file) | |
121 (if (.exists vbm) | |
122 (sh "/home/r/bin/vba-linux" | |
123 (str "--playmovie=" (.getCanonicalPath vbm)) | |
124 (.getCanonicalPath yellow-rom-image))) | |
125 nil) | |
126 |