rlm@83: (ns com.aurellem.gb-funs rlm@83: (:import com.aurellem.gb.Gb) rlm@83: (:import java.io.File) rlm@83: (:import org.apache.commons.io.FileUtils) rlm@83: (:import (java.nio IntBuffer ByteOrder))) rlm@83: rlm@83: ;; Savestates rlm@83: (defrecord SaveState [frame data]) rlm@83: rlm@83: (def ^:dynamic *save-state-cache* rlm@83: (File. "/home/r/proj/pokemon-escape/save-states/")) rlm@83: rlm@83: (defn frame->filename [frame] rlm@83: (File. *save-state-cache* (format "%07d.sav" frame))) rlm@83: rlm@83: (defn write-save! [^SaveState save] rlm@83: (let [buf (:data save) rlm@83: bytes (byte-array (.limit buf)) rlm@83: dest (frame->filename (:frame save))] rlm@83: (.get buf bytes) rlm@83: (FileUtils/writeByteArrayToFile dest bytes) rlm@83: (.rewind buf) rlm@83: save)) rlm@83: rlm@83: (defn read-save [frame] rlm@83: (let [save (frame->filename frame)] rlm@83: (if (.exists save) rlm@83: (let [buf (Gb/saveBuffer) rlm@83: bytes (FileUtils/readFileToByteArray save)] rlm@83: (.put buf bytes) rlm@83: (.flip buf) rlm@83: (SaveState. frame buf))))) rlm@83: ;;;;;;;;;;;;;;;; rlm@83: rlm@83: ;; Gameboy management rlm@83: (Gb/loadVBA) rlm@83: rlm@83: (def yellow-rom-image rlm@83: (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc")) rlm@83: rlm@83: (def yellow-save-file rlm@83: (File. "/home/r/proj/pokemon-escape/roms/yellow.sav")) rlm@83: rlm@83: (def on? (atom nil)) rlm@83: rlm@83: (defn shutdown! [] (Gb/shutdown) (reset! on? false)) rlm@83: rlm@83: (defn restart! [] rlm@83: (shutdown!) rlm@83: (.delete yellow-save-file) rlm@83: (Gb/startEmulator (.getCanonicalPath yellow-rom-image)) rlm@83: (reset! on? true)) rlm@83: rlm@83: ;;; The first state! rlm@83: (defn gen-root! [] rlm@83: (restart!) rlm@83: (write-save! (SaveState. 0 (Gb/saveState)))) rlm@83: rlm@83: (defn root [] rlm@83: (if (.exists (frame->filename 0)) rlm@83: (read-save 0) rlm@83: (gen-root!))) rlm@83: rlm@83: ;;;; Press Buttons rlm@83: rlm@83: (def button-code rlm@83: {;; main buttons rlm@83: :a 0x0001 rlm@83: :b 0x0002 rlm@83: rlm@83: ;; directional pad rlm@83: :r 0x0010 rlm@83: :l 0x0020 rlm@83: :u 0x0040 rlm@83: :d 0x0080 rlm@83: rlm@83: ;; meta buttons rlm@83: :select 0x0004 rlm@83: :start 0x0008 rlm@83: rlm@83: ;; pseudo-buttons rlm@83: :restart 0x0800 ; hard reset -- not really a button rlm@83: :listen -1 ; listen for user input rlm@83: }) rlm@83: rlm@83: (defn button-mask [buttons] rlm@83: (reduce bit-or 0x0000 (map button-code buttons))) rlm@83: rlm@83: (def current-state (atom nil)) rlm@83: rlm@83: (defn step rlm@83: ([^SaveState state buttons] rlm@83: (if (not @on?) (restart!)) rlm@83: (if (not= @current-state state) rlm@83: (Gb/loadState (:data state))) rlm@83: (Gb/step (button-mask buttons)) rlm@83: (reset! current-state rlm@83: (SaveState. (inc (:frame state))(Gb/saveState))))) rlm@83: rlm@83: (defn play rlm@83: ([^SaveState state] rlm@83: (step state [:listen])) rlm@83: ([] (step (if @current-state @current-state (root))))) rlm@83: