Mercurial > vba-clojure

comparison clojure/com/aurellem/gb_funs.clj @ 83:95cb2152d7cd

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fleshing out functional gb interface
author Robert McIntyre <rlm@mit.edu>
date Fri, 09 Mar 2012 19:18:00 -0600
parents
children 26f002f2868c
comparison
equal deleted inserted replaced
82:04d539d26bdc 83:95cb2152d7cd
1 (ns com.aurellem.gb-funs
2 (:import com.aurellem.gb.Gb)
3 (:import java.io.File)
4 (:import org.apache.commons.io.FileUtils)
5 (:import (java.nio IntBuffer ByteOrder)))
6
7 ;; Savestates
8 (defrecord SaveState [frame data])
9
10 (def ^:dynamic *save-state-cache*
11 (File. "/home/r/proj/pokemon-escape/save-states/"))
12
13 (defn frame->filename [frame]
14 (File. *save-state-cache* (format "%07d.sav" frame)))
15
16 (defn write-save! [^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 save))
24
25 (defn read-save [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 ;;;;;;;;;;;;;;;;
34
35 ;; Gameboy management
36 (Gb/loadVBA)
37
38 (def yellow-rom-image
39 (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc"))
40
41 (def yellow-save-file
42 (File. "/home/r/proj/pokemon-escape/roms/yellow.sav"))
43
44 (def on? (atom nil))
45
46 (defn shutdown! [] (Gb/shutdown) (reset! on? false))
47
48 (defn restart! []
49 (shutdown!)
50 (.delete yellow-save-file)
51 (Gb/startEmulator (.getCanonicalPath yellow-rom-image))
52 (reset! on? true))
53
54 ;;; The first state!
55 (defn gen-root! []
56 (restart!)
57 (write-save! (SaveState. 0 (Gb/saveState))))
58
59 (defn root []
60 (if (.exists (frame->filename 0))
61 (read-save 0)
62 (gen-root!)))
63
64 ;;;; Press Buttons
65
66 (def button-code
67 {;; main buttons
68 :a 0x0001
69 :b 0x0002
70
71 ;; directional pad
72 :r 0x0010
73 :l 0x0020
74 :u 0x0040
75 :d 0x0080
76
77 ;; meta buttons
78 :select 0x0004
79 :start 0x0008
80
81 ;; pseudo-buttons
82 :restart 0x0800 ; hard reset -- not really a button
83 :listen -1 ; listen for user input
84 })
85
86 (defn button-mask [buttons]
87 (reduce bit-or 0x0000 (map button-code buttons)))
88
89 (def current-state (atom nil))
90
91 (defn step
92 ([^SaveState state buttons]
93 (if (not @on?) (restart!))
94 (if (not= @current-state state)
95 (Gb/loadState (:data state)))
96 (Gb/step (button-mask buttons))
97 (reset! current-state
98 (SaveState. (inc (:frame state))(Gb/saveState)))))
99
100 (defn play
101 ([^SaveState state]
102 (step state [:listen]))
103 ([] (step (if @current-state @current-state (root)))))
104