Mercurial > vba-clojure

comparison clojure/com/aurellem/gb_driver.clj @ 106:3a60bb14a64a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
better functional assembly interface; removed frame numbers from SaveStates
author Robert McIntyre <rlm@mit.edu>
date Wed, 14 Mar 2012 21:37:37 -0500
parents 2f8089eacab9
children ad96e9464d6a
comparison
equal deleted inserted replaced
105:2f8089eacab9 106:3a60bb14a64a
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 ;; Savestates 7 ;; Savestates
8 (defrecord SaveState [frame data]) 8 (defrecord SaveState [data])
9 9
10 (def ^:dynamic *save-state-cache* 10 (def ^:dynamic *save-state-cache*
11 (File. "/home/r/proj/pokemon-escape/save-states/")) 11 (File. "/home/r/proj/pokemon-escape/save-states/"))
12 12
13 (defn frame->filename [frame] 13 (def current-state (atom nil))
14 (File. *save-state-cache* (format "%07d.sav" frame))) 14
15 15 (defn state-cache-file [name]
16 (defn write-state! [^SaveState save] 16 (File. *save-state-cache* (str name ".sav")))
17 (let [buf (:data save) 17
18 bytes (byte-array (.limit buf)) 18 (defn write-state!
19 dest (frame->filename (:frame save))] 19 ([^SaveState name]
20 (.get buf bytes) 20 (write-state! @current-state name))
21 (FileUtils/writeByteArrayToFile dest bytes) 21 ([^SaveState save ^String name]
22 (.rewind buf) 22 (let [buffer (:data save)
23 dest)) 23 bytes (byte-array (.limit buffer))
24 24 dest (state-cache-file name)]
25 (defn read-state [frame] 25 (.get buffer bytes)
26 (let [save (frame->filename frame)] 26 (FileUtils/writeByteArrayToFile dest bytes)
27 (.rewind buffer)
28 dest)))
29
30 (defn read-state [name]
31 (let [save (state-cache-file name)]
27 (if (.exists save) 32 (if (.exists save)
28 (let [buf (Gb/saveBuffer) 33 (let [buffer (Gb/saveBuffer)
29 bytes (FileUtils/readFileToByteArray save)] 34 bytes (FileUtils/readFileToByteArray save)]
30 (.put buf bytes) 35 (.put buffer bytes)
31 (.flip buf) 36 (.flip buffer)
32 (SaveState. frame buf))))) 37 (SaveState. buffer)))))
33 ;;;;;;;;;;;;;;;; 38 ;;;;;;;;;;;;;;;;
34 39
35 ;; Gameboy management 40 ;; Gameboy management
36 (Gb/loadVBA) 41 (Gb/loadVBA)
37 42
52 (reset! on? true)) 57 (reset! on? true))
53 58
54 ;;; The first state! 59 ;;; The first state!
55 (defn gen-root! [] 60 (defn gen-root! []
56 (restart!) 61 (restart!)
57 (let [state (SaveState. 0 (Gb/saveState))] 62 (let [state (SaveState. (Gb/saveState))]
58 (write-state! state) 63 (write-state! state "root" ) state))
59 state))
60 64
61 (defn root [] 65 (defn root []
62 (if (.exists (frame->filename 0)) 66 (if (.exists (state-cache-file "root"))
63 (read-state 0) 67 (read-state "root")
64 (gen-root!))) 68 (gen-root!)))
65 69
66 ;;;; Press Buttons 70 ;;;; Press Buttons
67 71
68 (def button-code 72 (def button-code
86 }) 90 })
87 91
88 (defn button-mask [buttons] 92 (defn button-mask [buttons]
89 (reduce bit-or 0x0000 (map button-code buttons))) 93 (reduce bit-or 0x0000 (map button-code buttons)))
90 94
91 (def current-state (atom nil))
92
93 (defn set-state! [^SaveState state] 95 (defn set-state! [^SaveState state]
94 (assert (:data state) "Not a valid state!") 96 (assert (:data state) "Not a valid state!")
95 (if (not @on?) (restart!)) 97 (if (not @on?) (restart!))
96 (Gb/loadState (:data state)) 98 (if (not= state @current-state)
97 (reset! current-state state)) 99 (do
98 100 (Gb/loadState (:data state))
99 (defrecord Move [keys state]) 101 (reset! current-state state))))
100 102
101 (defn update-state [] 103 (defn update-state []
102 (reset! current-state 104 (reset! current-state
103 (SaveState. (:frame @current-state) 105 (SaveState. (Gb/saveState))))
104 (Gb/saveState))))
105 106
106 (defn step 107 (defn step
107 ([^SaveState state buttons] 108 ([^SaveState state buttons]
108 (set-state! state) 109 (set-state! state)
109 (Gb/step (button-mask buttons)) 110 (Gb/step (button-mask buttons))
110 (reset! current-state 111 (reset! current-state
111 (SaveState. (inc (:frame state))(Gb/saveState)))) 112 (SaveState. (Gb/saveState))))
112 ([^SaveState state] 113 ([^SaveState state]
113 (step state [:listen])) 114 (step state [:listen]))
114 ([] (step (if @current-state @current-state (root))))) 115 ([] (step (if @current-state @current-state (root)))))
115 116
116 (defn tick 117 (defn tick
118 ([state] 119 ([state]
119 (set-state! state) 120 (set-state! state)
120 (Gb/tick) 121 (Gb/tick)
121 (update-state))) 122 (update-state)))
122 123
123 (defn move
124 [^Move move buttons]
125 (Move. (step (:state move) buttons) buttons))
126
127 (defn play 124 (defn play
128 ([^SaveState state n] 125 ([^SaveState state n]
129 (reduce (fn [s _] (step s)) state (range n))) 126 (try
127 (set-state! state)
128 (dorun (dotimes [_ n]
129 (Thread/sleep 1)
130 (Gb/step)))
131
132 (finally
133 (update-state))))
130 ([n] 134 ([n]
131 (play @current-state n))) 135 (play @current-state n)))
132 136
133 (defn continue! [] 137 (defn continue!
134 (play @current-state Integer/MAX_VALUE)) 138 ([state]
139 (play state Integer/MAX_VALUE))
140 ([]
141 (continue! @current-state)))
135 142
136 (defn play-moves 143 (defn play-moves
137 ([moves [prev state]] 144 ([moves [prev state]]
138 (set-state! state) 145 (set-state! state)
139 (dorun (map (fn [move] (step @current-state move)) moves)) 146 (dorun (map (fn [move] (step @current-state move)) moves))
150 ([] (get-data @current-state)) 157 ([] (get-data @current-state))
151 ([state] 158 ([state]
152 (set-state! state) (arr-fn store) store)))) 159 (set-state! state) (arr-fn store) store))))
153 160
154 (defn write-cpu-data [size store-fn] 161 (defn write-cpu-data [size store-fn]
155 (fn [new-data] 162 (fn store-data
156 (let [store (int-array new-data)] 163 ([state new-data]
157 (assert (= size (count new-data))) 164 (set-state! state)
158 (store-fn store)))) 165 (let [store (int-array new-data)]
166 (assert (= size (count new-data)))
167 (store-fn store)
168 (update-state)))
169 ([new-data]
170 (store-data @current-state new-data))))
171
159 172
160 (def memory 173 (def memory
161 (cpu-data Gb/GB_MEMORY #(Gb/getMemory %))) 174 (cpu-data Gb/GB_MEMORY #(Gb/getMemory %)))
162 175
163 (def ram 176 (def ram