Mercurial > vba-clojure
view clojure/com/aurellem/gb_driver.clj @ 104:d2e00ea31508
checking in continue!, which let's the GB run for an unlimited time.
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Tue, 13 Mar 2012 00:03:02 -0500 |
parents | 37711ff4a7bc |
children | 2f8089eacab9 |
line wrap: on
line source
1 (ns com.aurellem.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 ;; Savestates8 (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 management36 (Gb/loadVBA)38 (def yellow-rom-image39 (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc"))41 (def yellow-save-file42 (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 Buttons68 (def button-code69 {;; main buttons70 :a 0x000171 :b 0x000273 ;; directional pad74 :r 0x001075 :l 0x002076 :u 0x004077 :d 0x008079 ;; meta buttons80 :select 0x000481 :start 0x000883 ;; pseudo-buttons84 :restart 0x0800 ; hard reset85 :listen -1 ; listen for user input86 })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-state104 (SaveState. (:frame @current-state)105 (Gb/saveState))))107 (defn step108 ([^SaveState state buttons]109 (set-state! state)110 (Gb/step (button-mask buttons))111 (reset! current-state112 (SaveState. (inc (:frame state))(Gb/saveState))))113 ([^SaveState state]114 (step state [:listen]))115 ([] (step (if @current-state @current-state (root)))))117 (defn tick118 ([] (tick @current-state))119 ([state]120 (set-state! state)121 (Gb/tick)122 (update-state)))124 (defn move125 [^Move move buttons]126 (Move. (step (:state move) buttons) buttons))128 (defn play129 ([^SaveState state n]130 (reduce (fn [s _] (step s)) state (range n)))131 ([n]132 (play @current-state n)))134 (defn continue! []135 (play @current-state Integer/MAX_VALUE))137 (defn play-moves138 ([moves [prev state]]139 (set-state! state)140 (dorun (map (fn [move] (step @current-state move)) moves))141 [(concat prev moves) @current-state]))143 ;;;;;;;;;;;146 ;;;;;;;;;;;;;;; CPU data148 (defn cpu-data [size arr-fn]149 (let [store (int-array size)]150 (fn get-data151 ([] (get-data @current-state))152 ([state]153 (set-state! state) (arr-fn store) store))))155 (defn write-cpu-data [size store-fn]156 (fn [new-data]157 (let [store (int-array new-data)]158 (assert (= size (count new-data)))159 (store-fn store))))161 (def memory162 (cpu-data Gb/GB_MEMORY #(Gb/getMemory %)))164 (def ram165 (cpu-data Gb/RAM_SIZE #(Gb/getRAM %)))167 (def rom168 (cpu-data Gb/ROM_SIZE #(Gb/getROM %)))170 (def working-ram171 (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %)))173 (def video-ram174 (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %)))176 (def registers177 (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %)))179 (def write-memory!180 (write-cpu-data Gb/GB_MEMORY #(Gb/writeMemory %)))182 (def write-registers!183 (write-cpu-data Gb/NUM_REGISTERS #(Gb/writeRegisters %)))185 ;;;;; Registers ;;;;;;;;;;;;;;;;;;;;;;;;;;;187 (defmacro gen-get-set-register [name index]188 (let [name-bang (symbol (str name "!"))]189 `(do190 (defn ~name191 ~(str "Retrieve the " name " register from state, or "192 "from @current-state if state is absent.")193 ([state#]194 (nth (registers state#) ~index))195 ([]196 (~name @current-state)))197 (defn ~name-bang198 ~(str "Set the " name " register for state, or "199 "for @current-state if state is absent.")200 ([state# new-register#]201 (set-state! state#)202 (let [registers# (registers state#)]203 (aset registers# ~index new-register#)204 (Gb/writeRegisters registers#)205 (update-state)))206 ([new-register#]207 (~name-bang @current-state new-register#))))))209 ;; 16 bit registers210 (gen-get-set-register PC 0)211 (gen-get-set-register SP 1)212 (gen-get-set-register AF 2)213 (gen-get-set-register BC 3)214 (gen-get-set-register DE 4)215 (gen-get-set-register HL 5)216 (gen-get-set-register IFF 6)218 ;; 8 bit registers219 (gen-get-set-register DIV 7)220 (gen-get-set-register TIMA 8)221 (gen-get-set-register TMA 9)222 (gen-get-set-register IF 11)223 (gen-get-set-register LCDC 12)224 (gen-get-set-register STAT 13)225 (gen-get-set-register SCY 14)226 (gen-get-set-register SCX 15)227 (gen-get-set-register LY 16)228 (gen-get-set-register DMA 18)229 (gen-get-set-register WY 19)230 (gen-get-set-register WX 20)231 (gen-get-set-register VBK 21)232 (gen-get-set-register HDMA1 22)233 (gen-get-set-register HDMA2 23)234 (gen-get-set-register HDMA3 24)235 (gen-get-set-register HDMA4 25)236 (gen-get-set-register HDMA5 26)237 (gen-get-set-register SVBK 27)238 (gen-get-set-register IE 28)240 ;;;;;;;;;;;;;;;242 (defmacro defn-memo243 [& forms]244 (let [fun-name (first forms)]245 `(do246 (defn ~@forms)247 (alter-var-root (var ~fun-name) memoize))))