Mercurial > vba-clojure

comparison clojure/com/aurellem/gb_driver.clj @ 87:e8855121f413

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
collect cruft, rename other files
author Robert McIntyre <rlm@mit.edu>
date Sat, 10 Mar 2012 14:48:17 -0600
parents 95cb2152d7cd
children 65c2854c5875
comparison
equal deleted inserted replaced
86:9864032ef3c8 87:e8855121f413
1 (ns com.aurellem.gb-driver 1 (ns com.aurellem.gb-driver
2 (:import com.aurellem.gb.Gb) 2 (:import com.aurellem.gb.Gb)
3 (:import java.io.File) 3 (:import java.io.File)
4 (:import org.apache.commons.io.FileUtils) 4 (:import org.apache.commons.io.FileUtils)
5 (:import (java.nio IntBuffer ByteOrder))) 5 (:import (java.nio IntBuffer ByteOrder)))
6 6
7 (Gb/loadVBA) 7 ;; Savestates
8 8 (defrecord SaveState [frame data])
9 (def ^:dynamic *max-history* 2e4)
10
11 (def ^:dynamic *backup-saves-to-disk* true)
12
13 (def ^:dynamic *save-history* true)
14 9
15 (def ^:dynamic *save-state-cache* 10 (def ^:dynamic *save-state-cache*
16 (File. "/home/r/proj/pokemon-escape/save-states/")) 11 (File. "/home/r/proj/pokemon-escape/save-states/"))
12
13 (defn frame->filename [frame]
14 (File. *save-state-cache* (format "%07d.sav" frame)))
15
16 (defn write-save! [^SaveState save]
17 (let [buf (:data save)
18 bytes (byte-array (.limit buf))
19 dest (frame->filename (:frame save))]
20 (.get buf bytes)
21 (FileUtils/writeByteArrayToFile dest bytes)
22 (.rewind buf)
23 save))
24
25 (defn read-save [frame]
26 (let [save (frame->filename frame)]
27 (if (.exists save)
28 (let [buf (Gb/saveBuffer)
29 bytes (FileUtils/readFileToByteArray save)]
30 (.put buf bytes)
31 (.flip buf)
32 (SaveState. frame buf)))))
33 ;;;;;;;;;;;;;;;;
34
35 ;; Gameboy management
36 (Gb/loadVBA)
17 37
18 (def yellow-rom-image 38 (def yellow-rom-image
19 (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc")) 39 (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc"))
20 40
21 (def yellow-save-file 41 (def yellow-save-file
22 (File. "/home/r/proj/pokemon-escape/roms/yellow.sav")) 42 (File. "/home/r/proj/pokemon-escape/roms/yellow.sav"))
23 43
24 (def current-frame (atom 0)) 44 (def on? (atom nil))
25 45
26 (defn vba-init [] 46 (defn shutdown! [] (Gb/shutdown) (reset! on? false))
27 (reset! current-frame 0) 47
48 (defn restart! []
49 (shutdown!)
28 (.delete yellow-save-file) 50 (.delete yellow-save-file)
29 (Gb/startEmulator (.getCanonicalPath yellow-rom-image))) 51 (Gb/startEmulator (.getCanonicalPath yellow-rom-image))
52 (reset! on? true))
30 53
31 (defn shutdown [] (Gb/shutdown)) 54 ;;; The first state!
55 (defn gen-root! []
56 (restart!)
57 (write-save! (SaveState. 0 (Gb/saveState))))
32 58
33 (defn reset [] (shutdown) (vba-init)) 59 (defn root []
60 (if (.exists (frame->filename 0))
61 (read-save 0)
62 (gen-root!)))
63
64 ;;;; Press Buttons
65
66 (def button-code
67 {;; main buttons
68 :a 0x0001
69 :b 0x0002
70
71 ;; directional pad
72 :r 0x0010
73 :l 0x0020
74 :u 0x0040
75 :d 0x0080
76
77 ;; meta buttons
78 :select 0x0004
79 :start 0x0008
80
81 ;; pseudo-buttons
82 :restart 0x0800 ; hard reset
83 :listen -1 ; listen for user input
84 })
85
86 (defn button-mask [buttons]
87 (reduce bit-or 0x0000 (map button-code buttons)))
88
89 (def current-state (atom nil))
90
91
92 (defn set-state! [^SaveState state]
93 (assert (:data state) "Not a valid state!")
94 (if (not @on?) (restart!))
95 (if (not= @current-state state)
96 (Gb/loadState (:data state)))
97 (reset! current-state state))
98
99 (defrecord Move [keys state])
100
101 (defn step
102 ([^SaveState state buttons]
103 (set-state! state)
104 (Gb/step (button-mask buttons))
105 (reset! current-state
106 (SaveState. (inc (:frame state))(Gb/saveState))))
107 ([^SaveState state]
108 (step state [:listen]))
109 ([] (step (if @current-state @current-state (root)))))
110
111 (defn move
112 [^Move move buttons]
113 (Move. (step (:state move) buttons) buttons))
114
115
116 (defn play
117 ([^SaveState state n]
118 (reduce (fn [s _] (step s)) state (range n)))
119 ([n]
120 (play @current-state n)))
121
122 (defn play-moves
123 ([moves [prev state]]
124 (set-state! state)
125 (dorun (map (fn [move] (step @current-state move)) moves))
126 [(concat prev moves) @current-state]))
127
128 ;;;;;;;;;;;
129
130
131 ;;;;;;;;;;;;;;; CPU data
132
133
34 134
35 (defn cpu-data [size arr-fn] 135 (defn cpu-data [size arr-fn]
36 (let [store (int-array size)] 136 (let [store (int-array size)]
37 (fn [] (arr-fn store) store))) 137 (fn [state] (set-state! state) (arr-fn store) store)))
38 138
39 (def ram 139 (def ram
40 (cpu-data (Gb/getRAMSize) #(Gb/getRAM %))) 140 (cpu-data (Gb/getRAMSize) #(Gb/getRAM %)))
41 141
42 (def rom 142 (def rom
49 (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %))) 149 (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %)))
50 150
51 (def registers 151 (def registers
52 (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %))) 152 (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %)))
53 153
54 (def button-code 154 ;; TODO add register names
55 {;; main buttons
56 :a 0x0001
57 :b 0x0002
58 155
59 ;; directional pad 156 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
60 :r 0x0010
61 :l 0x0020
62 :u 0x0040
63 :d 0x0080
64 157
65 ;; meta buttons 158 (defn AF [state]
66 :select 0x0004 159 (nth (registers state) 2))
67 :start 0x0008
68 160
69 ;; hard reset -- not really a button 161 (defn BC [state]
70 :reset 0x0800}) 162 (nth (registers state) 3))
71 163
72 (defn button-mask [buttons] 164 (defn DE [state]
73 (reduce bit-or 0x0000 (map button-code buttons))) 165 (nth (registers state) 4))
166
167 ;;;;;;;;;;;;;;;
74 168
75 (defn buttons [mask] 169 (defmacro defn-memo
76 (loop [buttons [] 170 [& forms]
77 masks (seq button-code)] 171 (let [fun-name (first forms)]
78 (if (empty? masks) buttons 172 `(do
79 (let [[button value] (first masks)] 173 (defn ~@forms)
80 (if (not= 0x0000 (bit-and value mask)) 174 (alter-var-root (var ~fun-name) memoize))))
81 (recur (conj buttons button) (rest masks)) 175
82 (recur buttons (rest masks)))))))
83
84 (defrecord SaveState [frame save-data])
85
86 (defn frame [] @current-frame)
87
88 (defn save-state []
89 (SaveState. (frame) (Gb/saveState)))
90
91 (defn load-state [#^SaveState save]
92 (reset! current-frame (:frame save))
93 (Gb/loadState (:save-data save)))
94
95 (def empty-history (sorted-map))
96
97 (def history (atom empty-history))
98
99 (defn frame->disk-save [frame]
100 (File. *save-state-cache*
101 (format "%07d.sav" frame)))
102
103 (defn get-save-from-disk [frame]
104 (let [save (frame->disk-save frame)]
105 (if (.exists save)
106 (let [buf (Gb/saveBuffer)
107 bytes (FileUtils/readFileToByteArray save)]
108 (.put buf bytes)
109 (.flip buf)
110 (SaveState. frame buf)))))
111
112 (defn store-save-to-disk [^SaveState save]
113 (let [buf (:save-data save)
114 bytes (byte-array (.limit buf))
115 dest (frame->disk-save (:frame save))]
116 (.get buf bytes)
117 (FileUtils/writeByteArrayToFile dest bytes)
118 (.rewind buf) dest))
119
120 (defn find-save-state [frame]
121 (let [save (@history frame)]
122 (if (not (nil? save)) save
123 (get-save-from-disk frame))))
124
125 (defn goto [frame]
126 (let [save (find-save-state frame)]
127 (if (nil? save)
128 (println frame "is not in history")
129 (do
130 (reset! current-frame frame)
131 (load-state save)))))
132
133 (defn clear-history [] (reset! history empty-history))
134
135 (defn rewind
136 ([] (rewind 1))
137 ([n] (goto (- @current-frame n))))
138
139 (defn backup-state
140 ([] (backup-state (frame)))
141 ([frame]
142 (let [save (save-state)]
143 (swap! history #(assoc % frame save))
144 ;;(store-save-to-disk save)
145 (if (> (count @history) *max-history*)
146 (swap! history #(dissoc % (first (first %))))))))
147
148 (defn advance []
149 (if *save-history*
150 (backup-state @current-frame))
151 (swap! current-frame inc))
152
153 (defn step
154 ([] (advance) (Gb/step))
155 ([mask-or-buttons]
156 (advance)
157 (if (number? mask-or-buttons)
158 (Gb/step mask-or-buttons)
159 (Gb/step (button-mask mask-or-buttons)))))
160
161 (defn play-moves
162 ([start moves]
163 (goto start)
164 (dorun (map step moves))
165 (backup-state)
166 (frame))
167 ([moves]
168 (dorun (map step moves))
169 (backup-state)
170 (frame)))
171
172 (defn play
173 ([] (play Integer/MAX_VALUE))
174 ([n] (dorun (dotimes [_ n] (step)))))
175
176 (defmacro without-saves [& forms]
177 `(binding [*save-history* false]
178 ~@forms))
179
180
181 (require '(clojure [zip :as zip]))
182
183
184
185
186 (defn tree->str [original]
187 (loop [s ".\n" loc (zip/down (zip/seq-zip (seq original)))]
188 (if (zip/end? loc) s
189 (let [d (count (zip/path loc))
190 rep
191 (str
192 s
193 (if (and (zip/up loc)
194 (> (count (-> loc zip/up zip/rights)) 0))
195 "|" "")
196 (apply str (repeat (dec d) " "))
197 (if (= (count (zip/rights loc)) 0)
198 "`-- "
199 "|-- ")
200 (zip/node loc)
201 "\n")]
202 (recur rep (zip/next loc))))))
203
204
205
206