Mercurial > vba-clojure
view clojure/com/aurellem/gb/gb_driver.clj @ 303:5bcda2d6d135
item manipulation program works!
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 31 Mar 2012 00:33:35 -0500 |
parents | d5dddf33543c |
children | d263df762c59 |
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 ;;;;;;;;;;;;;;;;43 ;; Gameboy management44 (Gb/loadVBA)46 (def yellow-rom-image47 (File. user-home "proj/pokemon-escape/roms/yellow.gbc"))49 (def yellow-save-file50 (File. user-home "proj/pokemon-escape/roms/yellow.sav"))52 (def on? (atom nil))54 (defn shutdown! [] (Gb/shutdown) (reset! on? false))56 (defn restart! []57 (shutdown!)58 (.delete yellow-save-file)59 (Gb/startEmulator (.getCanonicalPath yellow-rom-image))60 (reset! on? true))62 ;;; The first state!63 (defn gen-root! []64 (restart!)65 (let [state (SaveState. (Gb/saveState))]66 (write-state! state "root" ) state))68 (defn root []69 (if (.exists (state-cache-file "root"))70 (read-state "root")71 (gen-root!)))73 ;;;; Press Buttons75 (def button-code76 {;; main buttons77 :a 0x000178 :b 0x000280 ;; directional pad81 :r 0x001082 :l 0x002083 :u 0x004084 :d 0x008086 ;; meta buttons87 :select 0x000488 :start 0x000890 ;; pseudo-buttons91 :restart 0x0800 ; hard reset92 :listen -1 ; listen for user input93 })95 (defn button-mask [buttons]96 (reduce bit-or 0x0000 (map button-code buttons)))98 (defn set-state! [^SaveState state]99 (assert (:data state) "Not a valid state!")100 (if (not @on?) (restart!))101 (if (not= state @current-state)102 (do103 (Gb/loadState (:data state))104 (reset! current-state state))))106 (defn update-state []107 (reset! current-state108 (SaveState. (Gb/saveState))))110 (defn step111 ([^SaveState state buttons]112 (set-state! state)113 (Gb/step (button-mask buttons))114 (reset! current-state115 (SaveState. (Gb/saveState))))116 ([^SaveState state]117 (step state [:listen]))118 ([] (step (if @current-state @current-state (root)))))120 (defn tick121 ([] (tick @current-state))122 ([^SaveState state]123 (set-state! state)124 (Gb/tick)125 (update-state)))127 (defn play128 ([^SaveState state n]129 (try130 (set-state! state)131 (dorun (dotimes [_ n]132 (Thread/sleep 1)133 (Gb/step)))134 (finally135 (update-state))))136 ([n]137 (play @current-state n)))139 (defn continue!140 ([state]141 (play state Integer/MAX_VALUE))142 ([]143 (continue! @current-state)))145 (defn run-moves [state moves]146 (set-state! state)147 (dorun (map #(Gb/step (button-mask %))148 moves))149 (update-state))151 (defn play-moves152 ([moves [prev state]]153 (set-state! state)154 (dorun (map (fn [move] (step @current-state move)) moves))155 [(concat prev moves) @current-state]))157 ;;;;;;;;;;;160 ;;;;;;;;;;;;;;; CPU data162 (defn cpu-data [size arr-fn]163 (let [store (int-array size)]164 (fn get-data165 ([] (get-data @current-state))166 ([state]167 (set-state! state) (arr-fn store) store))))169 (defn write-cpu-data [size store-fn]170 (fn store-data171 ([state new-data]172 (set-state! state)173 (let [store (int-array new-data)]174 (assert (= size (count new-data)))175 (store-fn store)176 (update-state)))177 ([new-data]178 (store-data @current-state new-data))))181 (def memory182 (cpu-data Gb/GB_MEMORY #(Gb/getMemory %)))184 (def ram185 (cpu-data Gb/RAM_SIZE #(Gb/getRAM %)))187 (def rom188 (cpu-data Gb/ROM_SIZE #(Gb/getROM %)))190 (def working-ram191 (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %)))193 (def video-ram194 (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %)))196 (def registers197 (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %)))199 (def write-memory!200 (write-cpu-data Gb/GB_MEMORY #(Gb/writeMemory %)))202 (def write-registers!203 (write-cpu-data Gb/NUM_REGISTERS #(Gb/writeRegisters %)))205 (def write-rom!206 (write-cpu-data Gb/ROM_SIZE #(Gb/writeROM %)))208 ;;;;; Registers ;;;;;;;;;;;;;;;;;;;;;;;;;;;210 (defmacro gen-get-set-register [name index]211 (let [name-bang (symbol (str name "!"))]212 `(do213 (defn ~name214 ~(str "Retrieve the " name " register from state, or "215 "from @current-state if state is absent.")216 ([state#]217 (nth (registers state#) ~index))218 ([]219 (~name @current-state)))220 (defn ~name-bang221 ~(str "Set the " name " register for state, or "222 "for @current-state if state is absent.")223 ([state# new-register#]224 (set-state! state#)225 (let [registers# (registers state#)]226 (aset registers# ~index new-register#)227 (Gb/writeRegisters registers#)228 (update-state)))229 ([new-register#]230 (~name-bang @current-state new-register#))))))232 ;; 16 bit registers233 (gen-get-set-register PC 0)234 (gen-get-set-register SP 1)235 (gen-get-set-register AF 2)236 (gen-get-set-register BC 3)237 (gen-get-set-register DE 4)238 (gen-get-set-register HL 5)239 (gen-get-set-register IFF 6)241 ;; 8 bit registers242 (gen-get-set-register DIV 7)243 (gen-get-set-register TIMA 8)244 (gen-get-set-register TMA 9)245 (gen-get-set-register IF 11)246 (gen-get-set-register LCDC 12)247 (gen-get-set-register STAT 13)248 (gen-get-set-register SCY 14)249 (gen-get-set-register SCX 15)250 (gen-get-set-register LY 16)251 (gen-get-set-register DMA 18)252 (gen-get-set-register WY 19)253 (gen-get-set-register WX 20)254 (gen-get-set-register VBK 21)255 (gen-get-set-register HDMA1 22)256 (gen-get-set-register HDMA2 23)257 (gen-get-set-register HDMA3 24)258 (gen-get-set-register HDMA4 25)259 (gen-get-set-register HDMA5 26)260 (gen-get-set-register SVBK 27)261 (gen-get-set-register IE 28)263 ;;;;;;;;;;;;;;;265 (defmacro defn-memo266 [& forms]267 (let [fun-name (first forms)]268 `(do269 (defn ~@forms)270 (alter-var-root (var ~fun-name) memoize))))274 (def original-rom (rom (root)))