view clojure/com/aurellem/gb_driver.clj @ 103:3305490a8f62

working on understanding basic opcodes
author Robert McIntyre <rlm@mit.edu>
date Mon, 12 Mar 2012 22:51:56 -0500
parents 37711ff4a7bc
children d2e00ea31508
line wrap: on
line source
1 (ns com.aurellem.gb-driver
2 (:import com.aurellem.gb.Gb)
3 (:import java.io.File)
4 (:import org.apache.commons.io.FileUtils)
5 (:import (java.nio IntBuffer ByteOrder)))
7 ;; Savestates
8 (defrecord SaveState [frame data])
10 (def ^:dynamic *save-state-cache*
11 (File. "/home/r/proj/pokemon-escape/save-states/"))
13 (defn frame->filename [frame]
14 (File. *save-state-cache* (format "%07d.sav" frame)))
16 (defn write-state! [^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 dest))
25 (defn read-state [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 ;;;;;;;;;;;;;;;;
35 ;; Gameboy management
36 (Gb/loadVBA)
38 (def yellow-rom-image
39 (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc"))
41 (def yellow-save-file
42 (File. "/home/r/proj/pokemon-escape/roms/yellow.sav"))
44 (def on? (atom nil))
46 (defn shutdown! [] (Gb/shutdown) (reset! on? false))
48 (defn restart! []
49 (shutdown!)
50 (.delete yellow-save-file)
51 (Gb/startEmulator (.getCanonicalPath yellow-rom-image))
52 (reset! on? true))
54 ;;; The first state!
55 (defn gen-root! []
56 (restart!)
57 (let [state (SaveState. 0 (Gb/saveState))]
58 (write-state! state)
59 state))
61 (defn root []
62 (if (.exists (frame->filename 0))
63 (read-state 0)
64 (gen-root!)))
66 ;;;; Press Buttons
68 (def button-code
69 {;; main buttons
70 :a 0x0001
71 :b 0x0002
73 ;; directional pad
74 :r 0x0010
75 :l 0x0020
76 :u 0x0040
77 :d 0x0080
79 ;; meta buttons
80 :select 0x0004
81 :start 0x0008
83 ;; pseudo-buttons
84 :restart 0x0800 ; hard reset
85 :listen -1 ; listen for user input
86 })
88 (defn button-mask [buttons]
89 (reduce bit-or 0x0000 (map button-code buttons)))
91 (def current-state (atom nil))
93 (defn set-state! [^SaveState state]
94 (assert (:data state) "Not a valid state!")
95 (if (not @on?) (restart!))
96 (if (not= @current-state state)
97 (Gb/loadState (:data state)))
98 (reset! current-state state))
100 (defrecord Move [keys state])
102 (defn update-state []
103 (reset! current-state
104 (SaveState. (:frame @current-state)
105 (Gb/saveState))))
107 (defn step
108 ([^SaveState state buttons]
109 (set-state! state)
110 (Gb/step (button-mask buttons))
111 (reset! current-state
112 (SaveState. (inc (:frame state))(Gb/saveState))))
113 ([^SaveState state]
114 (step state [:listen]))
115 ([] (step (if @current-state @current-state (root)))))
117 (defn tick
118 ([] (tick @current-state))
119 ([state]
120 (set-state! state)
121 (Gb/tick)
122 (update-state)))
124 (defn move
125 [^Move move buttons]
126 (Move. (step (:state move) buttons) buttons))
128 (defn play
129 ([^SaveState state n]
130 (reduce (fn [s _] (step s)) state (range n)))
131 ([n]
132 (play @current-state n)))
134 (defn play-moves
135 ([moves [prev state]]
136 (set-state! state)
137 (dorun (map (fn [move] (step @current-state move)) moves))
138 [(concat prev moves) @current-state]))
140 ;;;;;;;;;;;
143 ;;;;;;;;;;;;;;; CPU data
145 (defn cpu-data [size arr-fn]
146 (let [store (int-array size)]
147 (fn get-data
148 ([] (get-data @current-state))
149 ([state]
150 (set-state! state) (arr-fn store) store))))
152 (defn write-cpu-data [size store-fn]
153 (fn [new-data]
154 (let [store (int-array new-data)]
155 (assert (= size (count new-data)))
156 (store-fn store))))
158 (def memory
159 (cpu-data Gb/GB_MEMORY #(Gb/getMemory %)))
161 (def ram
162 (cpu-data Gb/RAM_SIZE #(Gb/getRAM %)))
164 (def rom
165 (cpu-data Gb/ROM_SIZE #(Gb/getROM %)))
167 (def working-ram
168 (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %)))
170 (def video-ram
171 (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %)))
173 (def registers
174 (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %)))
176 (def write-memory!
177 (write-cpu-data Gb/GB_MEMORY #(Gb/writeMemory %)))
179 (def write-registers!
180 (write-cpu-data Gb/NUM_REGISTERS #(Gb/writeRegisters %)))
182 ;;;;; Registers ;;;;;;;;;;;;;;;;;;;;;;;;;;;
184 (defmacro gen-get-set-register [name index]
185 (let [name-bang (symbol (str name "!"))]
186 `(do
187 (defn ~name
188 ~(str "Retrieve the " name " register from state, or "
189 "from @current-state if state is absent.")
190 ([state#]
191 (nth (registers state#) ~index))
192 ([]
193 (~name @current-state)))
194 (defn ~name-bang
195 ~(str "Set the " name " register for state, or "
196 "for @current-state if state is absent.")
197 ([state# new-register#]
198 (set-state! state#)
199 (let [registers# (registers state#)]
200 (aset registers# ~index new-register#)
201 (Gb/writeRegisters registers#)
202 (update-state)))
203 ([new-register#]
204 (~name-bang @current-state new-register#))))))
206 ;; 16 bit registers
207 (gen-get-set-register PC 0)
208 (gen-get-set-register SP 1)
209 (gen-get-set-register AF 2)
210 (gen-get-set-register BC 3)
211 (gen-get-set-register DE 4)
212 (gen-get-set-register HL 5)
213 (gen-get-set-register IFF 6)
215 ;; 8 bit registers
216 (gen-get-set-register DIV 7)
217 (gen-get-set-register TIMA 8)
218 (gen-get-set-register TMA 9)
219 (gen-get-set-register IF 11)
220 (gen-get-set-register LCDC 12)
221 (gen-get-set-register STAT 13)
222 (gen-get-set-register SCY 14)
223 (gen-get-set-register SCX 15)
224 (gen-get-set-register LY 16)
225 (gen-get-set-register DMA 18)
226 (gen-get-set-register WY 19)
227 (gen-get-set-register WX 20)
228 (gen-get-set-register VBK 21)
229 (gen-get-set-register HDMA1 22)
230 (gen-get-set-register HDMA2 23)
231 (gen-get-set-register HDMA3 24)
232 (gen-get-set-register HDMA4 25)
233 (gen-get-set-register HDMA5 26)
234 (gen-get-set-register SVBK 27)
235 (gen-get-set-register IE 28)
237 ;;;;;;;;;;;;;;;
239 (defmacro defn-memo
240 [& forms]
241 (let [fun-name (first forms)]
242 `(do
243 (defn ~@forms)
244 (alter-var-root (var ~fun-name) memoize))))