Mercurial > vba-clojure
view clojure/com/aurellem/gb/gb_driver.clj @ 525:fa7676dbf6f2
sound recording test now works.
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sun, 24 Jun 2012 13:12:51 -0500 |
parents | 7ef5c73ea8fa |
children | 2620d6318e8d |
line wrap: on
line source
1 (ns com.aurellem.gb.gb-driver2 (:import com.aurellem.gb.Gb)3 (:import java.io.File)4 (:import org.apache.commons.io.FileUtils)5 (:import (java.nio IntBuffer ByteOrder)))7 ;; Savestates9 (defrecord SaveState [data])11 (def user-home (File. (System/getProperty "user.home")))13 (def ^:dynamic *save-state-cache*14 (File. user-home "proj/vba-clojure/save-states/"))16 (def current-state (atom nil))18 (defn state-cache-file [name]19 (File. *save-state-cache* (str name ".sav")))21 (defn write-state!22 ([^SaveState name]23 (write-state! @current-state name))24 ([^SaveState save ^String name]25 (let [buffer (:data save)26 bytes (byte-array (.limit buffer))27 dest (state-cache-file name)]28 (.get buffer bytes)29 (FileUtils/writeByteArrayToFile dest bytes)30 (.rewind buffer)31 dest)))33 (defn read-state [name]34 (let [save (state-cache-file name)]35 (assert (.exists save))36 (let [buffer (Gb/saveBuffer)37 bytes (FileUtils/readFileToByteArray save)]38 (.put buffer bytes)39 (.flip buffer)40 (SaveState. buffer))))41 ;;;;;;;;;;;;;;;;44 ;; Gameboy management45 (Gb/loadVBA)47 (def yellow-rom-image48 (File. user-home "proj/pokemon-escape/roms/yellow.gbc"))50 (def yellow-save-file51 (File. user-home "proj/pokemon-escape/roms/yellow.sav"))53 (def on? (atom nil))55 (defn shutdown! [] (Gb/shutdown) (reset! on? false))57 (defn restart! []58 (shutdown!)59 (.delete yellow-save-file)60 (Gb/startEmulator (.getCanonicalPath yellow-rom-image))61 (reset! on? true))63 ;;; The first state!64 (defn gen-root! []65 (restart!)66 (let [state (SaveState. (Gb/saveState))]67 (write-state! state "root" ) state))69 (defn root []70 (if (.exists (state-cache-file "root"))71 (read-state "root")72 (gen-root!)))74 ;;;; Press Buttons76 (def button-code77 {;; main buttons78 :a 0x000179 :b 0x000281 ;; directional pad82 :r 0x001083 :l 0x002084 :u 0x004085 :d 0x008087 ;; meta buttons88 :select 0x000489 :start 0x000891 ;; pseudo-buttons92 :restart 0x0800 ; hard reset93 :listen -1 ; listen for user input94 })96 (defn button-mask [buttons]97 (reduce bit-or 0x0000 (map button-code buttons)))99 (defn set-state! [^SaveState state]100 (assert (:data state) "Not a valid state!")101 (if (not @on?) (restart!))102 (if (not= state @current-state)103 (do104 (Gb/loadState (:data state))105 (reset! current-state state))))107 (defn update-state []108 (reset! current-state109 (SaveState. (Gb/saveState))))111 (defn step112 ([^SaveState state buttons]113 (set-state! state)114 (Gb/step (button-mask buttons))115 (reset! current-state116 (SaveState. (Gb/saveState))))117 ([^SaveState state]118 (step state [:listen]))119 ([] (step (if @current-state @current-state (root)))))121 (defn tick122 ([] (tick @current-state))123 ([^SaveState state]124 (set-state! state)125 (Gb/tick)126 (update-state)))128 (defn play129 ([^SaveState state n]130 (try131 (set-state! state)132 (dorun (dotimes [_ n]133 (Thread/sleep 1)134 (Gb/step)))135 (finally136 (update-state))))137 ([n]138 (play @current-state n)))140 (defn continue!141 ([state]142 (play state Integer/MAX_VALUE))143 ([]144 (continue! @current-state)))146 (defn run-moves [state moves]147 (set-state! state)148 (dorun (map #(Gb/step (button-mask %))149 moves))150 (update-state))152 (defn play-moves153 ([moves [prev state]]154 (set-state! state)155 (dorun (map (fn [move] (step @current-state move)) moves))156 [(concat prev moves) @current-state]))158 (defn accurate-memory159 ([^SaveState state address]160 (set-state! state)161 (Gb/readMemory address))162 ([address]163 (accurate-memory @current-state address)))165 ;;;;;;;;;;;167 ;; Get Screen Pixels, Save Screenshot169 (defn write-png!170 ([^SaveState state ^File target]171 (set-state! state)172 (Gb/nwritePNG (.getCanonicalPath target)))173 ([^File target]174 (write-png! @current-state target)))176 ;;;;;;;;;;;;;;; CPU data178 (defn cpu-data [size arr-fn]179 (let [store (int-array size)]180 (fn get-data181 ([] (get-data @current-state))182 ([state]183 (set-state! state) (arr-fn store) store))))185 (defn write-cpu-data [size store-fn]186 (fn store-data187 ([state new-data]188 (set-state! state)189 (let [store (int-array new-data)]190 (assert (= size (count new-data)))191 (store-fn store)192 (update-state)))193 ([new-data]194 (store-data @current-state new-data))))196 (let [store (byte-array Gb/SOUND_SIZE)]197 (defn sound-data198 ([](sound-data @current-state))199 ([state]200 (set-state! state)201 (Gb/getFrameSound store)202 store)))204 (let [store (byte-array (* 1470 2))]205 (defn sound-data-2206 ([](sound-data-2 @current-state))207 ([state]208 (set-state! state)209 (Gb/getFrameSound2 store)210 store)))212 (def memory213 (cpu-data Gb/GB_MEMORY #(Gb/getMemory %)))215 (def ram216 (cpu-data Gb/RAM_SIZE #(Gb/getRAM %)))218 (def rom219 (cpu-data Gb/ROM_SIZE #(Gb/getROM %)))221 (def working-ram222 (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %)))224 (def video-ram225 (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %)))227 (def registers228 (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %)))230 (def pixels231 (cpu-data (* Gb/DISPLAY_WIDTH Gb/DISPLAY_HEIGHT)232 #(Gb/getPixels %)))234 (def write-memory!235 (write-cpu-data Gb/GB_MEMORY #(Gb/writeMemory %)))237 (def write-registers!238 (write-cpu-data Gb/NUM_REGISTERS #(Gb/writeRegisters %)))240 (def write-rom!241 (write-cpu-data Gb/ROM_SIZE #(Gb/writeROM %)))243 ;;;;; Registers ;;;;;;;;;;;;;;;;;;;;;;;;;;;245 (defmacro gen-get-set-register [name index]246 (let [name-bang (symbol (str name "!"))]247 `(do248 (defn ~name249 ~(str "Retrieve the " name " register from state, or "250 "from @current-state if state is absent.")251 ([state#]252 (nth (registers state#) ~index))253 ([]254 (~name @current-state)))255 (defn ~name-bang256 ~(str "Set the " name " register for state, or "257 "for @current-state if state is absent.")258 ([state# new-register#]259 (set-state! state#)260 (let [registers# (registers state#)]261 (aset registers# ~index new-register#)262 (Gb/writeRegisters registers#)263 (update-state)))264 ([new-register#]265 (~name-bang @current-state new-register#))))))267 ;; 16 bit registers268 (gen-get-set-register PC 0)269 (gen-get-set-register SP 1)270 (gen-get-set-register AF 2)271 (gen-get-set-register BC 3)272 (gen-get-set-register DE 4)273 (gen-get-set-register HL 5)274 (gen-get-set-register IFF 6)276 ;; 8 bit registers277 (gen-get-set-register DIV 7)278 (gen-get-set-register TIMA 8)279 (gen-get-set-register TMA 9)280 (gen-get-set-register IF 11)281 (gen-get-set-register LCDC 12)282 (gen-get-set-register STAT 13)283 (gen-get-set-register SCY 14)284 (gen-get-set-register SCX 15)285 (gen-get-set-register LY 16)286 (gen-get-set-register DMA 18)287 (gen-get-set-register WY 19)288 (gen-get-set-register WX 20)289 (gen-get-set-register VBK 21)290 (gen-get-set-register HDMA1 22)291 (gen-get-set-register HDMA2 23)292 (gen-get-set-register HDMA3 24)293 (gen-get-set-register HDMA4 25)294 (gen-get-set-register HDMA5 26)295 (gen-get-set-register SVBK 27)296 (gen-get-set-register IE 28)298 ;;;;;;;;;;;;;;;300 (defmacro defn-memo301 [& forms]302 (let [fun-name (first forms)]303 `(do304 (defn ~@forms)305 (alter-var-root (var ~fun-name) memoize))))307 (def original-rom (rom (root)))310 ;; RGB colors in an image are not the same as those in a GameBoy, so I311 ;; need to convert them. Fortunately, this code is already written312 ;; for me in this C-code from the public domain hi-color converter by313 ;; Glen Cook, Jeff Frohwein, and Rob Jones.314 (defn rgb->gb-rb [[r g b :as color]]315 (let [store (int-array 3)]316 (Gb/translateRGB (int-array color) store)317 (vec store)))