Mercurial > vba-clojure

annotate clojure/com/aurellem/gb_driver.clj @ 125:d2e00c923bad

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
need to add another mode to handle 16 bit start point
author Robert McIntyre <rlm@mit.edu>
date Sat, 17 Mar 2012 02:00:02 -0500
parents bcb5c41626b4
children 718abf3bec8a
rev   line source
rlm@60 1 (ns com.aurellem.gb-driver
rlm@87 2 (:import com.aurellem.gb.Gb)
rlm@87 3 (:import java.io.File)
rlm@87 4 (:import org.apache.commons.io.FileUtils)
rlm@87 5 (:import (java.nio IntBuffer ByteOrder)))
rlm@48 6
rlm@87 7 ;; Savestates
rlm@106 8 (defrecord SaveState [data])
rlm@76 9
rlm@76 10 (def ^:dynamic *save-state-cache*
rlm@76 11 (File. "/home/r/proj/pokemon-escape/save-states/"))
rlm@76 12
rlm@106 13 (def current-state (atom nil))
rlm@87 14
rlm@106 15 (defn state-cache-file [name]
rlm@106 16 (File. *save-state-cache* (str name ".sav")))
rlm@106 17
rlm@106 18 (defn write-state!
rlm@106 19 ([^SaveState name]
rlm@106 20 (write-state! @current-state name))
rlm@106 21 ([^SaveState save ^String name]
rlm@106 22 (let [buffer (:data save)
rlm@106 23 bytes (byte-array (.limit buffer))
rlm@106 24 dest (state-cache-file name)]
rlm@106 25 (.get buffer bytes)
rlm@106 26 (FileUtils/writeByteArrayToFile dest bytes)
rlm@106 27 (.rewind buffer)
rlm@106 28 dest)))
rlm@106 29
rlm@106 30 (defn read-state [name]
rlm@106 31 (let [save (state-cache-file name)]
rlm@87 32 (if (.exists save)
rlm@106 33 (let [buffer (Gb/saveBuffer)
rlm@87 34 bytes (FileUtils/readFileToByteArray save)]
rlm@106 35 (.put buffer bytes)
rlm@106 36 (.flip buffer)
rlm@106 37 (SaveState. buffer)))))
rlm@87 38 ;;;;;;;;;;;;;;;;
rlm@87 39
rlm@87 40 ;; Gameboy management
rlm@87 41 (Gb/loadVBA)
rlm@87 42
rlm@65 43 (def yellow-rom-image
rlm@65 44 (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc"))
rlm@65 45
rlm@67 46 (def yellow-save-file
rlm@67 47 (File. "/home/r/proj/pokemon-escape/roms/yellow.sav"))
rlm@67 48
rlm@87 49 (def on? (atom nil))
rlm@73 50
rlm@87 51 (defn shutdown! [] (Gb/shutdown) (reset! on? false))
rlm@87 52
rlm@87 53 (defn restart! []
rlm@87 54 (shutdown!)
rlm@67 55 (.delete yellow-save-file)
rlm@87 56 (Gb/startEmulator (.getCanonicalPath yellow-rom-image))
rlm@87 57 (reset! on? true))
rlm@60 58
rlm@87 59 ;;; The first state!
rlm@87 60 (defn gen-root! []
rlm@87 61 (restart!)
rlm@106 62 (let [state (SaveState. (Gb/saveState))]
rlm@106 63 (write-state! state "root" ) state))
rlm@71 64
rlm@87 65 (defn root []
rlm@106 66 (if (.exists (state-cache-file "root"))
rlm@106 67 (read-state "root")
rlm@87 68 (gen-root!)))
rlm@87 69
rlm@87 70 ;;;; Press Buttons
rlm@87 71
rlm@87 72 (def button-code
rlm@87 73 {;; main buttons
rlm@87 74 :a 0x0001
rlm@87 75 :b 0x0002
rlm@87 76
rlm@87 77 ;; directional pad
rlm@87 78 :r 0x0010
rlm@87 79 :l 0x0020
rlm@87 80 :u 0x0040
rlm@87 81 :d 0x0080
rlm@87 82
rlm@87 83 ;; meta buttons
rlm@87 84 :select 0x0004
rlm@87 85 :start 0x0008
rlm@87 86
rlm@87 87 ;; pseudo-buttons
rlm@87 88 :restart 0x0800 ; hard reset
rlm@87 89 :listen -1 ; listen for user input
rlm@87 90 })
rlm@87 91
rlm@87 92 (defn button-mask [buttons]
rlm@87 93 (reduce bit-or 0x0000 (map button-code buttons)))
rlm@87 94
rlm@87 95 (defn set-state! [^SaveState state]
rlm@87 96 (assert (:data state) "Not a valid state!")
rlm@87 97 (if (not @on?) (restart!))
rlm@106 98 (if (not= state @current-state)
rlm@106 99 (do
rlm@106 100 (Gb/loadState (:data state))
rlm@106 101 (reset! current-state state))))
rlm@87 102
rlm@99 103 (defn update-state []
rlm@99 104 (reset! current-state
rlm@106 105 (SaveState. (Gb/saveState))))
rlm@99 106
rlm@87 107 (defn step
rlm@87 108 ([^SaveState state buttons]
rlm@87 109 (set-state! state)
rlm@87 110 (Gb/step (button-mask buttons))
rlm@87 111 (reset! current-state
rlm@106 112 (SaveState. (Gb/saveState))))
rlm@87 113 ([^SaveState state]
rlm@87 114 (step state [:listen]))
rlm@87 115 ([] (step (if @current-state @current-state (root)))))
rlm@87 116
rlm@100 117 (defn tick
rlm@100 118 ([] (tick @current-state))
rlm@107 119 ([^SaveState state]
rlm@100 120 (set-state! state)
rlm@100 121 (Gb/tick)
rlm@100 122 (update-state)))
rlm@100 123
rlm@87 124 (defn play
rlm@87 125 ([^SaveState state n]
rlm@106 126 (try
rlm@106 127 (set-state! state)
rlm@106 128 (dorun (dotimes [_ n]
rlm@106 129 (Thread/sleep 1)
rlm@106 130 (Gb/step)))
rlm@106 131 (finally
rlm@106 132 (update-state))))
rlm@87 133 ([n]
rlm@87 134 (play @current-state n)))
rlm@87 135
rlm@106 136 (defn continue!
rlm@106 137 ([state]
rlm@106 138 (play state Integer/MAX_VALUE))
rlm@106 139 ([]
rlm@106 140 (continue! @current-state)))
rlm@104 141
rlm@87 142 (defn play-moves
rlm@87 143 ([moves [prev state]]
rlm@87 144 (set-state! state)
rlm@87 145 (dorun (map (fn [move] (step @current-state move)) moves))
rlm@87 146 [(concat prev moves) @current-state]))
rlm@87 147
rlm@87 148 ;;;;;;;;;;;
rlm@87 149
rlm@87 150
rlm@87 151 ;;;;;;;;;;;;;;; CPU data
rlm@87 152
rlm@64 153 (defn cpu-data [size arr-fn]
rlm@64 154 (let [store (int-array size)]
rlm@94 155 (fn get-data
rlm@94 156 ([] (get-data @current-state))
rlm@94 157 ([state]
rlm@94 158 (set-state! state) (arr-fn store) store))))
rlm@60 159
rlm@100 160 (defn write-cpu-data [size store-fn]
rlm@106 161 (fn store-data
rlm@106 162 ([state new-data]
rlm@106 163 (set-state! state)
rlm@106 164 (let [store (int-array new-data)]
rlm@106 165 (assert (= size (count new-data)))
rlm@106 166 (store-fn store)
rlm@106 167 (update-state)))
rlm@106 168 ([new-data]
rlm@106 169 (store-data @current-state new-data))))
rlm@106 170
rlm@100 171
rlm@93 172 (def memory
rlm@94 173 (cpu-data Gb/GB_MEMORY #(Gb/getMemory %)))
rlm@93 174
rlm@64 175 (def ram
rlm@93 176 (cpu-data Gb/RAM_SIZE #(Gb/getRAM %)))
rlm@61 177
rlm@64 178 (def rom
rlm@93 179 (cpu-data Gb/ROM_SIZE #(Gb/getROM %)))
rlm@61 180
rlm@64 181 (def working-ram
rlm@64 182 (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %)))
rlm@62 183
rlm@64 184 (def video-ram
rlm@64 185 (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %)))
rlm@64 186
rlm@64 187 (def registers
rlm@64 188 (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %)))
rlm@64 189
rlm@100 190 (def write-memory!
rlm@100 191 (write-cpu-data Gb/GB_MEMORY #(Gb/writeMemory %)))
rlm@96 192
rlm@100 193 (def write-registers!
rlm@100 194 (write-cpu-data Gb/NUM_REGISTERS #(Gb/writeRegisters %)))
rlm@100 195
rlm@101 196 ;;;;; Registers ;;;;;;;;;;;;;;;;;;;;;;;;;;;
rlm@71 197
rlm@100 198 (defmacro gen-get-set-register [name index]
rlm@100 199 (let [name-bang (symbol (str name "!"))]
rlm@100 200 `(do
rlm@100 201 (defn ~name
rlm@100 202 ~(str "Retrieve the " name " register from state, or "
rlm@100 203 "from @current-state if state is absent.")
rlm@100 204 ([state#]
rlm@100 205 (nth (registers state#) ~index))
rlm@100 206 ([]
rlm@100 207 (~name @current-state)))
rlm@100 208 (defn ~name-bang
rlm@100 209 ~(str "Set the " name " register for state, or "
rlm@100 210 "for @current-state if state is absent.")
rlm@100 211 ([state# new-register#]
rlm@100 212 (set-state! state#)
rlm@100 213 (let [registers# (registers state#)]
rlm@100 214 (aset registers# ~index new-register#)
rlm@100 215 (Gb/writeRegisters registers#)
rlm@100 216 (update-state)))
rlm@100 217 ([new-register#]
rlm@100 218 (~name-bang @current-state new-register#))))))
rlm@71 219
rlm@101 220 ;; 16 bit registers
rlm@100 221 (gen-get-set-register PC 0)
rlm@100 222 (gen-get-set-register SP 1)
rlm@100 223 (gen-get-set-register AF 2)
rlm@100 224 (gen-get-set-register BC 3)
rlm@100 225 (gen-get-set-register DE 4)
rlm@100 226 (gen-get-set-register HL 5)
rlm@100 227 (gen-get-set-register IFF 6)
rlm@100 228
rlm@101 229 ;; 8 bit registers
rlm@101 230 (gen-get-set-register DIV 7)
rlm@101 231 (gen-get-set-register TIMA 8)
rlm@101 232 (gen-get-set-register TMA 9)
rlm@101 233 (gen-get-set-register IF 11)
rlm@101 234 (gen-get-set-register LCDC 12)
rlm@101 235 (gen-get-set-register STAT 13)
rlm@101 236 (gen-get-set-register SCY 14)
rlm@101 237 (gen-get-set-register SCX 15)
rlm@101 238 (gen-get-set-register LY 16)
rlm@101 239 (gen-get-set-register DMA 18)
rlm@101 240 (gen-get-set-register WY 19)
rlm@101 241 (gen-get-set-register WX 20)
rlm@101 242 (gen-get-set-register VBK 21)
rlm@101 243 (gen-get-set-register HDMA1 22)
rlm@101 244 (gen-get-set-register HDMA2 23)
rlm@101 245 (gen-get-set-register HDMA3 24)
rlm@101 246 (gen-get-set-register HDMA4 25)
rlm@101 247 (gen-get-set-register HDMA5 26)
rlm@101 248 (gen-get-set-register SVBK 27)
rlm@101 249 (gen-get-set-register IE 28)
rlm@101 250
rlm@87 251 ;;;;;;;;;;;;;;;
rlm@71 252
rlm@87 253 (defmacro defn-memo
rlm@87 254 [& forms]
rlm@87 255 (let [fun-name (first forms)]
rlm@87 256 `(do
rlm@87 257 (defn ~@forms)
rlm@87 258 (alter-var-root (var ~fun-name) memoize))))
rlm@95 259