Mercurial > vba-clojure

annotate clojure/com/aurellem/gb_driver.clj @ 88:65c2854c5875

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
can now save moves and states and am ready to continue past the title
author Robert McIntyre <rlm@mit.edu>
date Sat, 10 Mar 2012 15:36:26 -0600
parents e8855121f413
children 4c60ebca1a9d
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@87 133
rlm@71 134
rlm@64 135 (defn cpu-data [size arr-fn]
rlm@64 136 (let [store (int-array size)]
rlm@87 137 (fn [state] (set-state! state) (arr-fn store) store)))
rlm@60 138
rlm@64 139 (def ram
rlm@64 140 (cpu-data (Gb/getRAMSize) #(Gb/getRAM %)))
rlm@61 141
rlm@64 142 (def rom
rlm@64 143 (cpu-data (Gb/getROMSize) #(Gb/getROM %)))
rlm@61 144
rlm@64 145 (def working-ram
rlm@64 146 (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %)))
rlm@62 147
rlm@64 148 (def video-ram
rlm@64 149 (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %)))
rlm@64 150
rlm@64 151 (def registers
rlm@64 152 (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %)))
rlm@64 153
rlm@87 154 ;; TODO add register names
rlm@71 155
rlm@87 156 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
rlm@71 157
rlm@87 158 (defn AF [state]
rlm@87 159 (nth (registers state) 2))
rlm@71 160
rlm@87 161 (defn BC [state]
rlm@87 162 (nth (registers state) 3))
rlm@71 163
rlm@87 164 (defn DE [state]
rlm@87 165 (nth (registers state) 4))
rlm@87 166
rlm@87 167 ;;;;;;;;;;;;;;;
rlm@71 168
rlm@87 169 (defmacro defn-memo
rlm@87 170 [& forms]
rlm@87 171 (let [fun-name (first forms)]
rlm@87 172 `(do
rlm@87 173 (defn ~@forms)
rlm@87 174 (alter-var-root (var ~fun-name) memoize))))
rlm@87 175