Mercurial > vba-clojure

annotate clojure/com/aurellem/gb_driver.clj @ 94:612393a0d3a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fixed memory retrieval function to use the simulated gameboy's mapped memory
author Robert McIntyre <rlm@mit.edu>
date Sun, 11 Mar 2012 20:55:21 -0500
parents 4c60ebca1a9d
children b74a578d0c88
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@87 8 (defrecord SaveState [frame 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@87 13 (defn frame->filename [frame]
rlm@87 14 (File. *save-state-cache* (format "%07d.sav" frame)))
rlm@87 15
rlm@88 16 (defn write-state! [^SaveState save]
rlm@87 17 (let [buf (:data save)
rlm@87 18 bytes (byte-array (.limit buf))
rlm@87 19 dest (frame->filename (:frame save))]
rlm@87 20 (.get buf bytes)
rlm@87 21 (FileUtils/writeByteArrayToFile dest bytes)
rlm@87 22 (.rewind buf)
rlm@88 23 dest))
rlm@87 24
rlm@88 25 (defn read-state [frame]
rlm@87 26 (let [save (frame->filename frame)]
rlm@87 27 (if (.exists save)
rlm@87 28 (let [buf (Gb/saveBuffer)
rlm@87 29 bytes (FileUtils/readFileToByteArray save)]
rlm@87 30 (.put buf bytes)
rlm@87 31 (.flip buf)
rlm@87 32 (SaveState. frame buf)))))
rlm@87 33 ;;;;;;;;;;;;;;;;
rlm@87 34
rlm@87 35 ;; Gameboy management
rlm@87 36 (Gb/loadVBA)
rlm@87 37
rlm@65 38 (def yellow-rom-image
rlm@65 39 (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc"))
rlm@65 40
rlm@67 41 (def yellow-save-file
rlm@67 42 (File. "/home/r/proj/pokemon-escape/roms/yellow.sav"))
rlm@67 43
rlm@87 44 (def on? (atom nil))
rlm@73 45
rlm@87 46 (defn shutdown! [] (Gb/shutdown) (reset! on? false))
rlm@87 47
rlm@87 48 (defn restart! []
rlm@87 49 (shutdown!)
rlm@67 50 (.delete yellow-save-file)
rlm@87 51 (Gb/startEmulator (.getCanonicalPath yellow-rom-image))
rlm@87 52 (reset! on? true))
rlm@60 53
rlm@87 54 ;;; The first state!
rlm@87 55 (defn gen-root! []
rlm@87 56 (restart!)
rlm@88 57 (let [state (SaveState. 0 (Gb/saveState))]
rlm@88 58 (write-state! state)
rlm@88 59 state))
rlm@71 60
rlm@87 61 (defn root []
rlm@87 62 (if (.exists (frame->filename 0))
rlm@88 63 (read-state 0)
rlm@87 64 (gen-root!)))
rlm@87 65
rlm@87 66 ;;;; Press Buttons
rlm@87 67
rlm@87 68 (def button-code
rlm@87 69 {;; main buttons
rlm@87 70 :a 0x0001
rlm@87 71 :b 0x0002
rlm@87 72
rlm@87 73 ;; directional pad
rlm@87 74 :r 0x0010
rlm@87 75 :l 0x0020
rlm@87 76 :u 0x0040
rlm@87 77 :d 0x0080
rlm@87 78
rlm@87 79 ;; meta buttons
rlm@87 80 :select 0x0004
rlm@87 81 :start 0x0008
rlm@87 82
rlm@87 83 ;; pseudo-buttons
rlm@87 84 :restart 0x0800 ; hard reset
rlm@87 85 :listen -1 ; listen for user input
rlm@87 86 })
rlm@87 87
rlm@87 88 (defn button-mask [buttons]
rlm@87 89 (reduce bit-or 0x0000 (map button-code buttons)))
rlm@87 90
rlm@87 91 (def current-state (atom nil))
rlm@87 92
rlm@87 93 (defn set-state! [^SaveState state]
rlm@87 94 (assert (:data state) "Not a valid state!")
rlm@87 95 (if (not @on?) (restart!))
rlm@87 96 (if (not= @current-state state)
rlm@87 97 (Gb/loadState (:data state)))
rlm@87 98 (reset! current-state state))
rlm@87 99
rlm@87 100 (defrecord Move [keys state])
rlm@87 101
rlm@87 102 (defn step
rlm@87 103 ([^SaveState state buttons]
rlm@87 104 (set-state! state)
rlm@87 105 (Gb/step (button-mask buttons))
rlm@87 106 (reset! current-state
rlm@87 107 (SaveState. (inc (:frame state))(Gb/saveState))))
rlm@87 108 ([^SaveState state]
rlm@87 109 (step state [:listen]))
rlm@87 110 ([] (step (if @current-state @current-state (root)))))
rlm@87 111
rlm@87 112 (defn move
rlm@87 113 [^Move move buttons]
rlm@87 114 (Move. (step (:state move) buttons) buttons))
rlm@87 115
rlm@87 116 (defn play
rlm@87 117 ([^SaveState state n]
rlm@87 118 (reduce (fn [s _] (step s)) state (range n)))
rlm@87 119 ([n]
rlm@87 120 (play @current-state n)))
rlm@87 121
rlm@87 122 (defn play-moves
rlm@87 123 ([moves [prev state]]
rlm@87 124 (set-state! state)
rlm@87 125 (dorun (map (fn [move] (step @current-state move)) moves))
rlm@87 126 [(concat prev moves) @current-state]))
rlm@87 127
rlm@87 128 ;;;;;;;;;;;
rlm@87 129
rlm@87 130
rlm@87 131 ;;;;;;;;;;;;;;; CPU data
rlm@87 132
rlm@64 133 (defn cpu-data [size arr-fn]
rlm@64 134 (let [store (int-array size)]
rlm@94 135 (fn get-data
rlm@94 136 ([] (get-data @current-state))
rlm@94 137 ([state]
rlm@94 138 (set-state! state) (arr-fn store) store))))
rlm@60 139
rlm@93 140 (def memory
rlm@94 141 (cpu-data Gb/GB_MEMORY #(Gb/getMemory %)))
rlm@93 142
rlm@64 143 (def ram
rlm@93 144 (cpu-data Gb/RAM_SIZE #(Gb/getRAM %)))
rlm@61 145
rlm@64 146 (def rom
rlm@93 147 (cpu-data Gb/ROM_SIZE #(Gb/getROM %)))
rlm@61 148
rlm@64 149 (def working-ram
rlm@64 150 (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %)))
rlm@62 151
rlm@64 152 (def video-ram
rlm@64 153 (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %)))
rlm@64 154
rlm@64 155 (def registers
rlm@64 156 (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %)))
rlm@64 157
rlm@87 158 ;; TODO add register names
rlm@71 159
rlm@87 160 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
rlm@71 161
rlm@87 162 (defn AF [state]
rlm@87 163 (nth (registers state) 2))
rlm@71 164
rlm@87 165 (defn BC [state]
rlm@87 166 (nth (registers state) 3))
rlm@71 167
rlm@87 168 (defn DE [state]
rlm@87 169 (nth (registers state) 4))
rlm@87 170
rlm@87 171 ;;;;;;;;;;;;;;;
rlm@71 172
rlm@87 173 (defmacro defn-memo
rlm@87 174 [& forms]
rlm@87 175 (let [fun-name (first forms)]
rlm@87 176 `(do
rlm@87 177 (defn ~@forms)
rlm@87 178 (alter-var-root (var ~fun-name) memoize))))
rlm@87 179