Mercurial > vba-clojure
changeset 87:e8855121f413
collect cruft, rename other files
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 10 Mar 2012 14:48:17 -0600 |
parents | 9864032ef3c8 |
children | 65c2854c5875 |
files | clojure/com/aurellem/cruft/gb_driver.clj clojure/com/aurellem/cruft/title.clj clojure/com/aurellem/gb_driver.clj clojure/com/aurellem/gb_funs.clj clojure/com/aurellem/speedruns.clj clojure/com/aurellem/test_vbm.clj clojure/com/aurellem/title.clj clojure/com/aurellem/title2.clj clojure/com/aurellem/vbm.clj |
diffstat | 9 files changed, 584 insertions(+), 580 deletions(-) [+] |
line wrap: on
line diff
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 1.2 +++ b/clojure/com/aurellem/cruft/gb_driver.clj Sat Mar 10 14:48:17 2012 -0600 1.3 @@ -0,0 +1,206 @@ 1.4 +(ns com.aurellem.gb-driver 1.5 + (:import com.aurellem.gb.Gb) 1.6 + (:import java.io.File) 1.7 + (:import org.apache.commons.io.FileUtils) 1.8 + (:import (java.nio IntBuffer ByteOrder))) 1.9 + 1.10 +(Gb/loadVBA) 1.11 + 1.12 +(def ^:dynamic *max-history* 2e4) 1.13 + 1.14 +(def ^:dynamic *backup-saves-to-disk* true) 1.15 + 1.16 +(def ^:dynamic *save-history* true) 1.17 + 1.18 +(def ^:dynamic *save-state-cache* 1.19 + (File. "/home/r/proj/pokemon-escape/save-states/")) 1.20 + 1.21 +(def yellow-rom-image 1.22 + (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc")) 1.23 + 1.24 +(def yellow-save-file 1.25 + (File. "/home/r/proj/pokemon-escape/roms/yellow.sav")) 1.26 + 1.27 +(def current-frame (atom 0)) 1.28 + 1.29 +(defn vba-init [] 1.30 + (reset! current-frame 0) 1.31 + (.delete yellow-save-file) 1.32 + (Gb/startEmulator (.getCanonicalPath yellow-rom-image))) 1.33 + 1.34 +(defn shutdown [] (Gb/shutdown)) 1.35 + 1.36 +(defn reset [] (shutdown) (vba-init)) 1.37 + 1.38 +(defn cpu-data [size arr-fn] 1.39 + (let [store (int-array size)] 1.40 + (fn [] (arr-fn store) store))) 1.41 + 1.42 +(def ram 1.43 + (cpu-data (Gb/getRAMSize) #(Gb/getRAM %))) 1.44 + 1.45 +(def rom 1.46 + (cpu-data (Gb/getROMSize) #(Gb/getROM %))) 1.47 + 1.48 +(def working-ram 1.49 + (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %))) 1.50 + 1.51 +(def video-ram 1.52 + (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %))) 1.53 + 1.54 +(def registers 1.55 + (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %))) 1.56 + 1.57 +(def button-code 1.58 + {;; main buttons 1.59 + :a 0x0001 1.60 + :b 0x0002 1.61 + 1.62 + ;; directional pad 1.63 + :r 0x0010 1.64 + :l 0x0020 1.65 + :u 0x0040 1.66 + :d 0x0080 1.67 + 1.68 + ;; meta buttons 1.69 + :select 0x0004 1.70 + :start 0x0008 1.71 + 1.72 + ;; hard reset -- not really a button 1.73 + :reset 0x0800}) 1.74 + 1.75 +(defn button-mask [buttons] 1.76 + (reduce bit-or 0x0000 (map button-code buttons))) 1.77 + 1.78 +(defn buttons [mask] 1.79 + (loop [buttons [] 1.80 + masks (seq button-code)] 1.81 + (if (empty? masks) buttons 1.82 + (let [[button value] (first masks)] 1.83 + (if (not= 0x0000 (bit-and value mask)) 1.84 + (recur (conj buttons button) (rest masks)) 1.85 + (recur buttons (rest masks))))))) 1.86 + 1.87 +(defrecord SaveState [frame save-data]) 1.88 + 1.89 +(defn frame [] @current-frame) 1.90 + 1.91 +(defn save-state [] 1.92 + (SaveState. (frame) (Gb/saveState))) 1.93 + 1.94 +(defn load-state [#^SaveState save] 1.95 + (reset! current-frame (:frame save)) 1.96 + (Gb/loadState (:save-data save))) 1.97 + 1.98 +(def empty-history (sorted-map)) 1.99 + 1.100 +(def history (atom empty-history)) 1.101 + 1.102 +(defn frame->disk-save [frame] 1.103 + (File. *save-state-cache* 1.104 + (format "%07d.sav" frame))) 1.105 + 1.106 +(defn get-save-from-disk [frame] 1.107 + (let [save (frame->disk-save frame)] 1.108 + (if (.exists save) 1.109 + (let [buf (Gb/saveBuffer) 1.110 + bytes (FileUtils/readFileToByteArray save)] 1.111 + (.put buf bytes) 1.112 + (.flip buf) 1.113 + (SaveState. frame buf))))) 1.114 + 1.115 +(defn store-save-to-disk [^SaveState save] 1.116 + (let [buf (:save-data save) 1.117 + bytes (byte-array (.limit buf)) 1.118 + dest (frame->disk-save (:frame save))] 1.119 + (.get buf bytes) 1.120 + (FileUtils/writeByteArrayToFile dest bytes) 1.121 + (.rewind buf) dest)) 1.122 + 1.123 +(defn find-save-state [frame] 1.124 + (let [save (@history frame)] 1.125 + (if (not (nil? save)) save 1.126 + (get-save-from-disk frame)))) 1.127 + 1.128 +(defn goto [frame] 1.129 + (let [save (find-save-state frame)] 1.130 + (if (nil? save) 1.131 + (println frame "is not in history") 1.132 + (do 1.133 + (reset! current-frame frame) 1.134 + (load-state save))))) 1.135 + 1.136 +(defn clear-history [] (reset! history empty-history)) 1.137 + 1.138 +(defn rewind 1.139 + ([] (rewind 1)) 1.140 + ([n] (goto (- @current-frame n)))) 1.141 + 1.142 +(defn backup-state 1.143 + ([] (backup-state (frame))) 1.144 + ([frame] 1.145 + (let [save (save-state)] 1.146 + (swap! history #(assoc % frame save)) 1.147 + ;;(store-save-to-disk save) 1.148 + (if (> (count @history) *max-history*) 1.149 + (swap! history #(dissoc % (first (first %)))))))) 1.150 + 1.151 +(defn advance [] 1.152 + (if *save-history* 1.153 + (backup-state @current-frame)) 1.154 + (swap! current-frame inc)) 1.155 + 1.156 +(defn step 1.157 + ([] (advance) (Gb/step)) 1.158 + ([mask-or-buttons] 1.159 + (advance) 1.160 + (if (number? mask-or-buttons) 1.161 + (Gb/step mask-or-buttons) 1.162 + (Gb/step (button-mask mask-or-buttons))))) 1.163 + 1.164 +(defn play-moves 1.165 + ([start moves] 1.166 + (goto start) 1.167 + (dorun (map step moves)) 1.168 + (backup-state) 1.169 + (frame)) 1.170 + ([moves] 1.171 + (dorun (map step moves)) 1.172 + (backup-state) 1.173 + (frame))) 1.174 + 1.175 +(defn play 1.176 + ([] (play Integer/MAX_VALUE)) 1.177 + ([n] (dorun (dotimes [_ n] (step))))) 1.178 + 1.179 +(defmacro without-saves [& forms] 1.180 + `(binding [*save-history* false] 1.181 + ~@forms)) 1.182 + 1.183 + 1.184 +(require '(clojure [zip :as zip])) 1.185 + 1.186 + 1.187 + 1.188 + 1.189 +(defn tree->str [original] 1.190 + (loop [s ".\n" loc (zip/down (zip/seq-zip (seq original)))] 1.191 + (if (zip/end? loc) s 1.192 + (let [d (count (zip/path loc)) 1.193 + rep 1.194 + (str 1.195 + s 1.196 + (if (and (zip/up loc) 1.197 + (> (count (-> loc zip/up zip/rights)) 0)) 1.198 + "|" "") 1.199 + (apply str (repeat (dec d) " ")) 1.200 + (if (= (count (zip/rights loc)) 0) 1.201 + "`-- " 1.202 + "|-- ") 1.203 + (zip/node loc) 1.204 + "\n")] 1.205 + (recur rep (zip/next loc)))))) 1.206 + 1.207 + 1.208 + 1.209 +
2.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 2.2 +++ b/clojure/com/aurellem/cruft/title.clj Sat Mar 10 14:48:17 2012 -0600 2.3 @@ -0,0 +1,141 @@ 2.4 +(ns com.aurellem.title 2.5 + (:use (com.aurellem gb-driver vbm))) 2.6 + 2.7 +(defn delayed-key 2.8 + ([key delay total] 2.9 + (concat (repeat delay []) [key] (repeat (- total delay 1) []))) 2.10 + ([key total] 2.11 + (delayed-key key (dec total) total))) 2.12 + 2.13 +(defn no-action [length] 2.14 + (repeat length [])) 2.15 + 2.16 +(defn start-summary [] 2.17 + (nth (registers) 2)) 2.18 + 2.19 +(defn common-initial-elements [baseline moves] 2.20 + (loop [common 0 b baseline m moves] 2.21 + (if (empty? m) common 2.22 + (if (= (first b) (first m)) 2.23 + (recur (inc common) (rest b) (rest m)) 2.24 + common)))) 2.25 + 2.26 +(defn earliest-press 2.27 + [start-frame 2.28 + end-frame 2.29 + key 2.30 + summary-fn] 2.31 + (let [action-length (- end-frame start-frame) 2.32 + baseline (no-action action-length)] 2.33 + (print "establishing baseline...") 2.34 + (play-moves start-frame baseline) 2.35 + (let [bad-value (summary-fn)] 2.36 + (println bad-value) 2.37 + (loop [n 0] 2.38 + (let [moves (delayed-key key n action-length) 2.39 + header-length 2.40 + (common-initial-elements moves baseline)] 2.41 + (print "length" (inc n) "...") 2.42 + (without-saves 2.43 + (play-moves 2.44 + (+ start-frame header-length) 2.45 + (drop header-length moves))) 2.46 + (let [result (summary-fn)] 2.47 + (println result) 2.48 + (if (not= result bad-value) 2.49 + (let [keys (delayed-key key (inc n))] 2.50 + (play-moves start-frame keys) 2.51 + keys) 2.52 + (recur (inc n))))))))) 2.53 + 2.54 + 2.55 +(defn search-first 2.56 + [start-frame 2.57 + baseline 2.58 + gen-move-fn 2.59 + summary-fn] 2.60 + (print "establishing baseline...") 2.61 + (play-moves start-frame baseline) 2.62 + (let [bad-value (summary-fn)] 2.63 + (println bad-value) 2.64 + (loop [n 0] 2.65 + (let [trial-moves (gen-move-fn n) 2.66 + header-length 2.67 + (common-initial-elements trial-moves baseline)] 2.68 + (print "length" (inc n) "...") 2.69 + (without-saves 2.70 + (play-moves 2.71 + (+ start-frame header-length) 2.72 + (drop header-length trial-moves))) 2.73 + (let [result (summary-fn)] 2.74 + (println result) 2.75 + (if (not= result bad-value) 2.76 + (let [keys (take (inc n) trial-moves)] 2.77 + (play-moves start-frame keys) 2.78 + keys) 2.79 + (recur (inc n)))))))) 2.80 + 2.81 +(defn title-search 2.82 + [start-frame 2.83 + end-frame 2.84 + key 2.85 + summary-fn] 2.86 + (let [action-length (- end-frame start-frame)] 2.87 + (search-first 2.88 + start-frame 2.89 + (no-action action-length) 2.90 + (fn [n] (delayed-key key n action-length)) 2.91 + summary-fn))) 2.92 + 2.93 +(defn gen-title [] 2.94 + (let [start0 (no-action 300)] 2.95 + (play-moves 0 start0) 2.96 + (let [start->first-press 2.97 + (title-search (frame) (+ 50 (frame)) [:a] start-summary) 2.98 + first-press->second-press 2.99 + (title-search (frame) (+ 100 (frame)) [:start] start-summary) 2.100 + second-press->third-press 2.101 + (title-search (frame) (+ 151 (frame)) [:a] start-summary) 2.102 + new-game 2.103 + (title-search (frame) (+ 151 (frame)) [:a] start-summary)] 2.104 + (concat 2.105 + start0 2.106 + start->first-press 2.107 + first-press->second-press 2.108 + second-press->third-press 2.109 + new-game)))) 2.110 + 2.111 +(def title 2.112 + [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.113 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.114 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.115 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.116 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.117 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.118 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.119 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.120 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.121 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.122 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.123 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.124 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.125 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.126 + [] [] [] [] [] [] [] [] [] [] [] [] [] [ :a] [] [] [] [] [] [] [] 2.127 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.128 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.129 + [] [] [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] [] 2.130 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.131 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.132 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.133 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.134 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.135 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.136 + [] [] [] [] [ :a] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.137 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.138 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.139 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.140 + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 2.141 + [] [] [] [] [] [ :a]]) 2.142 + 2.143 + 2.144 +(require '(clojure [zip :as zip])) 2.145 \ No newline at end of file
3.1 --- a/clojure/com/aurellem/gb_driver.clj Sat Mar 10 14:24:10 2012 -0600 3.2 +++ b/clojure/com/aurellem/gb_driver.clj Sat Mar 10 14:48:17 2012 -0600 3.3 @@ -1,40 +1,140 @@ 3.4 (ns com.aurellem.gb-driver 3.5 - (:import com.aurellem.gb.Gb) 3.6 - (:import java.io.File) 3.7 - (:import org.apache.commons.io.FileUtils) 3.8 - (:import (java.nio IntBuffer ByteOrder))) 3.9 + (:import com.aurellem.gb.Gb) 3.10 + (:import java.io.File) 3.11 + (:import org.apache.commons.io.FileUtils) 3.12 + (:import (java.nio IntBuffer ByteOrder))) 3.13 3.14 -(Gb/loadVBA) 3.15 - 3.16 -(def ^:dynamic *max-history* 2e4) 3.17 - 3.18 -(def ^:dynamic *backup-saves-to-disk* true) 3.19 - 3.20 -(def ^:dynamic *save-history* true) 3.21 +;; Savestates 3.22 +(defrecord SaveState [frame data]) 3.23 3.24 (def ^:dynamic *save-state-cache* 3.25 (File. "/home/r/proj/pokemon-escape/save-states/")) 3.26 3.27 +(defn frame->filename [frame] 3.28 + (File. *save-state-cache* (format "%07d.sav" frame))) 3.29 + 3.30 +(defn write-save! [^SaveState save] 3.31 + (let [buf (:data save) 3.32 + bytes (byte-array (.limit buf)) 3.33 + dest (frame->filename (:frame save))] 3.34 + (.get buf bytes) 3.35 + (FileUtils/writeByteArrayToFile dest bytes) 3.36 + (.rewind buf) 3.37 + save)) 3.38 + 3.39 +(defn read-save [frame] 3.40 + (let [save (frame->filename frame)] 3.41 + (if (.exists save) 3.42 + (let [buf (Gb/saveBuffer) 3.43 + bytes (FileUtils/readFileToByteArray save)] 3.44 + (.put buf bytes) 3.45 + (.flip buf) 3.46 + (SaveState. frame buf))))) 3.47 +;;;;;;;;;;;;;;;; 3.48 + 3.49 +;; Gameboy management 3.50 +(Gb/loadVBA) 3.51 + 3.52 (def yellow-rom-image 3.53 (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc")) 3.54 3.55 (def yellow-save-file 3.56 (File. "/home/r/proj/pokemon-escape/roms/yellow.sav")) 3.57 3.58 -(def current-frame (atom 0)) 3.59 +(def on? (atom nil)) 3.60 3.61 -(defn vba-init [] 3.62 - (reset! current-frame 0) 3.63 +(defn shutdown! [] (Gb/shutdown) (reset! on? false)) 3.64 + 3.65 +(defn restart! [] 3.66 + (shutdown!) 3.67 (.delete yellow-save-file) 3.68 - (Gb/startEmulator (.getCanonicalPath yellow-rom-image))) 3.69 + (Gb/startEmulator (.getCanonicalPath yellow-rom-image)) 3.70 + (reset! on? true)) 3.71 3.72 -(defn shutdown [] (Gb/shutdown)) 3.73 +;;; The first state! 3.74 +(defn gen-root! [] 3.75 + (restart!) 3.76 + (write-save! (SaveState. 0 (Gb/saveState)))) 3.77 3.78 -(defn reset [] (shutdown) (vba-init)) 3.79 +(defn root [] 3.80 + (if (.exists (frame->filename 0)) 3.81 + (read-save 0) 3.82 + (gen-root!))) 3.83 + 3.84 +;;;; Press Buttons 3.85 + 3.86 +(def button-code 3.87 + {;; main buttons 3.88 + :a 0x0001 3.89 + :b 0x0002 3.90 + 3.91 + ;; directional pad 3.92 + :r 0x0010 3.93 + :l 0x0020 3.94 + :u 0x0040 3.95 + :d 0x0080 3.96 + 3.97 + ;; meta buttons 3.98 + :select 0x0004 3.99 + :start 0x0008 3.100 + 3.101 + ;; pseudo-buttons 3.102 + :restart 0x0800 ; hard reset 3.103 + :listen -1 ; listen for user input 3.104 + }) 3.105 + 3.106 +(defn button-mask [buttons] 3.107 + (reduce bit-or 0x0000 (map button-code buttons))) 3.108 + 3.109 +(def current-state (atom nil)) 3.110 + 3.111 + 3.112 +(defn set-state! [^SaveState state] 3.113 + (assert (:data state) "Not a valid state!") 3.114 + (if (not @on?) (restart!)) 3.115 + (if (not= @current-state state) 3.116 + (Gb/loadState (:data state))) 3.117 + (reset! current-state state)) 3.118 + 3.119 +(defrecord Move [keys state]) 3.120 + 3.121 +(defn step 3.122 + ([^SaveState state buttons] 3.123 + (set-state! state) 3.124 + (Gb/step (button-mask buttons)) 3.125 + (reset! current-state 3.126 + (SaveState. (inc (:frame state))(Gb/saveState)))) 3.127 + ([^SaveState state] 3.128 + (step state [:listen])) 3.129 + ([] (step (if @current-state @current-state (root))))) 3.130 + 3.131 +(defn move 3.132 + [^Move move buttons] 3.133 + (Move. (step (:state move) buttons) buttons)) 3.134 + 3.135 + 3.136 +(defn play 3.137 + ([^SaveState state n] 3.138 + (reduce (fn [s _] (step s)) state (range n))) 3.139 + ([n] 3.140 + (play @current-state n))) 3.141 + 3.142 +(defn play-moves 3.143 + ([moves [prev state]] 3.144 + (set-state! state) 3.145 + (dorun (map (fn [move] (step @current-state move)) moves)) 3.146 + [(concat prev moves) @current-state])) 3.147 + 3.148 +;;;;;;;;;;; 3.149 + 3.150 + 3.151 +;;;;;;;;;;;;;;; CPU data 3.152 + 3.153 + 3.154 3.155 (defn cpu-data [size arr-fn] 3.156 (let [store (int-array size)] 3.157 - (fn [] (arr-fn store) store))) 3.158 + (fn [state] (set-state! state) (arr-fn store) store))) 3.159 3.160 (def ram 3.161 (cpu-data (Gb/getRAMSize) #(Gb/getRAM %))) 3.162 @@ -51,156 +151,25 @@ 3.163 (def registers 3.164 (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %))) 3.165 3.166 -(def button-code 3.167 - {;; main buttons 3.168 - :a 0x0001 3.169 - :b 0x0002 3.170 +;; TODO add register names 3.171 3.172 - ;; directional pad 3.173 - :r 0x0010 3.174 - :l 0x0020 3.175 - :u 0x0040 3.176 - :d 0x0080 3.177 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3.178 3.179 - ;; meta buttons 3.180 - :select 0x0004 3.181 - :start 0x0008 3.182 +(defn AF [state] 3.183 + (nth (registers state) 2)) 3.184 3.185 - ;; hard reset -- not really a button 3.186 - :reset 0x0800}) 3.187 +(defn BC [state] 3.188 + (nth (registers state) 3)) 3.189 3.190 -(defn button-mask [buttons] 3.191 - (reduce bit-or 0x0000 (map button-code buttons))) 3.192 +(defn DE [state] 3.193 + (nth (registers state) 4)) 3.194 + 3.195 +;;;;;;;;;;;;;;; 3.196 3.197 -(defn buttons [mask] 3.198 - (loop [buttons [] 3.199 - masks (seq button-code)] 3.200 - (if (empty? masks) buttons 3.201 - (let [[button value] (first masks)] 3.202 - (if (not= 0x0000 (bit-and value mask)) 3.203 - (recur (conj buttons button) (rest masks)) 3.204 - (recur buttons (rest masks))))))) 3.205 - 3.206 -(defrecord SaveState [frame save-data]) 3.207 - 3.208 -(defn frame [] @current-frame) 3.209 - 3.210 -(defn save-state [] 3.211 - (SaveState. (frame) (Gb/saveState))) 3.212 - 3.213 -(defn load-state [#^SaveState save] 3.214 - (reset! current-frame (:frame save)) 3.215 - (Gb/loadState (:save-data save))) 3.216 - 3.217 -(def empty-history (sorted-map)) 3.218 - 3.219 -(def history (atom empty-history)) 3.220 - 3.221 -(defn frame->disk-save [frame] 3.222 - (File. *save-state-cache* 3.223 - (format "%07d.sav" frame))) 3.224 - 3.225 -(defn get-save-from-disk [frame] 3.226 - (let [save (frame->disk-save frame)] 3.227 - (if (.exists save) 3.228 - (let [buf (Gb/saveBuffer) 3.229 - bytes (FileUtils/readFileToByteArray save)] 3.230 - (.put buf bytes) 3.231 - (.flip buf) 3.232 - (SaveState. frame buf))))) 3.233 - 3.234 -(defn store-save-to-disk [^SaveState save] 3.235 - (let [buf (:save-data save) 3.236 - bytes (byte-array (.limit buf)) 3.237 - dest (frame->disk-save (:frame save))] 3.238 - (.get buf bytes) 3.239 - (FileUtils/writeByteArrayToFile dest bytes) 3.240 - (.rewind buf) dest)) 3.241 - 3.242 -(defn find-save-state [frame] 3.243 - (let [save (@history frame)] 3.244 - (if (not (nil? save)) save 3.245 - (get-save-from-disk frame)))) 3.246 - 3.247 -(defn goto [frame] 3.248 - (let [save (find-save-state frame)] 3.249 - (if (nil? save) 3.250 - (println frame "is not in history") 3.251 - (do 3.252 - (reset! current-frame frame) 3.253 - (load-state save))))) 3.254 - 3.255 -(defn clear-history [] (reset! history empty-history)) 3.256 - 3.257 -(defn rewind 3.258 - ([] (rewind 1)) 3.259 - ([n] (goto (- @current-frame n)))) 3.260 - 3.261 -(defn backup-state 3.262 - ([] (backup-state (frame))) 3.263 - ([frame] 3.264 - (let [save (save-state)] 3.265 - (swap! history #(assoc % frame save)) 3.266 - ;;(store-save-to-disk save) 3.267 - (if (> (count @history) *max-history*) 3.268 - (swap! history #(dissoc % (first (first %)))))))) 3.269 - 3.270 -(defn advance [] 3.271 - (if *save-history* 3.272 - (backup-state @current-frame)) 3.273 - (swap! current-frame inc)) 3.274 - 3.275 -(defn step 3.276 - ([] (advance) (Gb/step)) 3.277 - ([mask-or-buttons] 3.278 - (advance) 3.279 - (if (number? mask-or-buttons) 3.280 - (Gb/step mask-or-buttons) 3.281 - (Gb/step (button-mask mask-or-buttons))))) 3.282 - 3.283 -(defn play-moves 3.284 - ([start moves] 3.285 - (goto start) 3.286 - (dorun (map step moves)) 3.287 - (backup-state) 3.288 - (frame)) 3.289 - ([moves] 3.290 - (dorun (map step moves)) 3.291 - (backup-state) 3.292 - (frame))) 3.293 - 3.294 -(defn play 3.295 - ([] (play Integer/MAX_VALUE)) 3.296 - ([n] (dorun (dotimes [_ n] (step))))) 3.297 - 3.298 -(defmacro without-saves [& forms] 3.299 - `(binding [*save-history* false] 3.300 - ~@forms)) 3.301 - 3.302 - 3.303 -(require '(clojure [zip :as zip])) 3.304 - 3.305 - 3.306 - 3.307 - 3.308 -(defn tree->str [original] 3.309 - (loop [s ".\n" loc (zip/down (zip/seq-zip (seq original)))] 3.310 - (if (zip/end? loc) s 3.311 - (let [d (count (zip/path loc)) 3.312 - rep 3.313 - (str 3.314 - s 3.315 - (if (and (zip/up loc) 3.316 - (> (count (-> loc zip/up zip/rights)) 0)) 3.317 - "|" "") 3.318 - (apply str (repeat (dec d) " ")) 3.319 - (if (= (count (zip/rights loc)) 0) 3.320 - "`-- " 3.321 - "|-- ") 3.322 - (zip/node loc) 3.323 - "\n")] 3.324 - (recur rep (zip/next loc)))))) 3.325 - 3.326 - 3.327 - 3.328 - 3.329 +(defmacro defn-memo 3.330 + [& forms] 3.331 + (let [fun-name (first forms)] 3.332 + `(do 3.333 + (defn ~@forms) 3.334 + (alter-var-root (var ~fun-name) memoize)))) 3.335 + 3.336 \ No newline at end of file
4.1 --- a/clojure/com/aurellem/gb_funs.clj Sat Mar 10 14:24:10 2012 -0600 4.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 4.3 @@ -1,175 +0,0 @@ 4.4 -(ns com.aurellem.gb-funs 4.5 - (:import com.aurellem.gb.Gb) 4.6 - (:import java.io.File) 4.7 - (:import org.apache.commons.io.FileUtils) 4.8 - (:import (java.nio IntBuffer ByteOrder))) 4.9 - 4.10 -;; Savestates 4.11 -(defrecord SaveState [frame data]) 4.12 - 4.13 -(def ^:dynamic *save-state-cache* 4.14 - (File. "/home/r/proj/pokemon-escape/save-states/")) 4.15 - 4.16 -(defn frame->filename [frame] 4.17 - (File. *save-state-cache* (format "%07d.sav" frame))) 4.18 - 4.19 -(defn write-save! [^SaveState save] 4.20 - (let [buf (:data save) 4.21 - bytes (byte-array (.limit buf)) 4.22 - dest (frame->filename (:frame save))] 4.23 - (.get buf bytes) 4.24 - (FileUtils/writeByteArrayToFile dest bytes) 4.25 - (.rewind buf) 4.26 - save)) 4.27 - 4.28 -(defn read-save [frame] 4.29 - (let [save (frame->filename frame)] 4.30 - (if (.exists save) 4.31 - (let [buf (Gb/saveBuffer) 4.32 - bytes (FileUtils/readFileToByteArray save)] 4.33 - (.put buf bytes) 4.34 - (.flip buf) 4.35 - (SaveState. frame buf))))) 4.36 -;;;;;;;;;;;;;;;; 4.37 - 4.38 -;; Gameboy management 4.39 -(Gb/loadVBA) 4.40 - 4.41 -(def yellow-rom-image 4.42 - (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc")) 4.43 - 4.44 -(def yellow-save-file 4.45 - (File. "/home/r/proj/pokemon-escape/roms/yellow.sav")) 4.46 - 4.47 -(def on? (atom nil)) 4.48 - 4.49 -(defn shutdown! [] (Gb/shutdown) (reset! on? false)) 4.50 - 4.51 -(defn restart! [] 4.52 - (shutdown!) 4.53 - (.delete yellow-save-file) 4.54 - (Gb/startEmulator (.getCanonicalPath yellow-rom-image)) 4.55 - (reset! on? true)) 4.56 - 4.57 -;;; The first state! 4.58 -(defn gen-root! [] 4.59 - (restart!) 4.60 - (write-save! (SaveState. 0 (Gb/saveState)))) 4.61 - 4.62 -(defn root [] 4.63 - (if (.exists (frame->filename 0)) 4.64 - (read-save 0) 4.65 - (gen-root!))) 4.66 - 4.67 -;;;; Press Buttons 4.68 - 4.69 -(def button-code 4.70 - {;; main buttons 4.71 - :a 0x0001 4.72 - :b 0x0002 4.73 - 4.74 - ;; directional pad 4.75 - :r 0x0010 4.76 - :l 0x0020 4.77 - :u 0x0040 4.78 - :d 0x0080 4.79 - 4.80 - ;; meta buttons 4.81 - :select 0x0004 4.82 - :start 0x0008 4.83 - 4.84 - ;; pseudo-buttons 4.85 - :restart 0x0800 ; hard reset 4.86 - :listen -1 ; listen for user input 4.87 - }) 4.88 - 4.89 -(defn button-mask [buttons] 4.90 - (reduce bit-or 0x0000 (map button-code buttons))) 4.91 - 4.92 -(def current-state (atom nil)) 4.93 - 4.94 - 4.95 -(defn set-state! [^SaveState state] 4.96 - (assert (:data state) "Not a valid state!") 4.97 - (if (not @on?) (restart!)) 4.98 - (if (not= @current-state state) 4.99 - (Gb/loadState (:data state))) 4.100 - (reset! current-state state)) 4.101 - 4.102 -(defrecord Move [keys state]) 4.103 - 4.104 -(defn step 4.105 - ([^SaveState state buttons] 4.106 - (set-state! state) 4.107 - (Gb/step (button-mask buttons)) 4.108 - (reset! current-state 4.109 - (SaveState. (inc (:frame state))(Gb/saveState)))) 4.110 - ([^SaveState state] 4.111 - (step state [:listen])) 4.112 - ([] (step (if @current-state @current-state (root))))) 4.113 - 4.114 -(defn move 4.115 - [^Move move buttons] 4.116 - (Move. (step (:state move) buttons) buttons)) 4.117 - 4.118 - 4.119 -(defn play 4.120 - ([^SaveState state n] 4.121 - (reduce (fn [s _] (step s)) state (range n))) 4.122 - ([n] 4.123 - (play @current-state n))) 4.124 - 4.125 -(defn play-moves 4.126 - ([moves [prev state]] 4.127 - (set-state! state) 4.128 - (dorun (map (fn [move] (step @current-state move)) moves)) 4.129 - [(concat prev moves) @current-state])) 4.130 - 4.131 -;;;;;;;;;;; 4.132 - 4.133 - 4.134 -;;;;;;;;;;;;;;; CPU data 4.135 - 4.136 - 4.137 - 4.138 -(defn cpu-data [size arr-fn] 4.139 - (let [store (int-array size)] 4.140 - (fn [state] (set-state! state) (arr-fn store) store))) 4.141 - 4.142 -(def ram 4.143 - (cpu-data (Gb/getRAMSize) #(Gb/getRAM %))) 4.144 - 4.145 -(def rom 4.146 - (cpu-data (Gb/getROMSize) #(Gb/getROM %))) 4.147 - 4.148 -(def working-ram 4.149 - (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %))) 4.150 - 4.151 -(def video-ram 4.152 - (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %))) 4.153 - 4.154 -(def registers 4.155 - (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %))) 4.156 - 4.157 -;; TODO add register names 4.158 - 4.159 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4.160 - 4.161 -(defn AF [state] 4.162 - (nth (registers state) 2)) 4.163 - 4.164 -(defn BC [state] 4.165 - (nth (registers state) 3)) 4.166 - 4.167 -(defn DE [state] 4.168 - (nth (registers state) 4)) 4.169 - 4.170 -;;;;;;;;;;;;;;; 4.171 - 4.172 -(defmacro defn-memo 4.173 - [& forms] 4.174 - (let [fun-name (first forms)] 4.175 - `(do 4.176 - (defn ~@forms) 4.177 - (alter-var-root (var ~fun-name) memoize)))) 4.178 - 4.179 \ No newline at end of file
5.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 5.2 +++ b/clojure/com/aurellem/speedruns.clj Sat Mar 10 14:48:17 2012 -0600 5.3 @@ -0,0 +1,13 @@ 5.4 +(ns com.aurellem.test-vbm 5.5 + (:import java.io.File) 5.6 + (:use (com.aurellem vbm gb-driver))) 5.7 + 5.8 +(def speedrun-2942 5.9 + (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2942.vbm")) 5.10 + 5.11 +(def speedrun-2913 5.12 + (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2913.vbm")) 5.13 + 5.14 +(def speedrun-2771 5.15 + (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2771.vbm")) 5.16 +
6.1 --- a/clojure/com/aurellem/test_vbm.clj Sat Mar 10 14:24:10 2012 -0600 6.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 6.3 @@ -1,18 +0,0 @@ 6.4 -(ns com.aurellem.test-vbm 6.5 - (:import java.io.File) 6.6 - (:use (com.aurellem vbm gb-driver))) 6.7 - 6.8 -(def test-file (File."/home/r/proj/pokemon-escape/speedruns/rlm.vbm")) 6.9 - 6.10 -(def speedrun-2942 6.11 - (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2942.vbm")) 6.12 - 6.13 -(def speedrun-2913 6.14 - (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2913.vbm")) 6.15 - 6.16 -(def speedrun-2771 6.17 - (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2771.vbm")) 6.18 - 6.19 -(defn test-speedrun [] 6.20 - (dorun 6.21 - (map step (vbm-masks speedrun-2942))))
7.1 --- a/clojure/com/aurellem/title.clj Sat Mar 10 14:24:10 2012 -0600 7.2 +++ b/clojure/com/aurellem/title.clj Sat Mar 10 14:48:17 2012 -0600 7.3 @@ -1,141 +1,91 @@ 7.4 (ns com.aurellem.title 7.5 (:use (com.aurellem gb-driver vbm))) 7.6 7.7 -(defn delayed-key 7.8 - ([key delay total] 7.9 - (concat (repeat delay []) [key] (repeat (- total delay 1) []))) 7.10 - ([key total] 7.11 - (delayed-key key (dec total) total))) 7.12 +(defn first-difference [base alt summary root] 7.13 + (loop [branch-point root 7.14 + actions []] 7.15 + (let [base-branch (step branch-point base) 7.16 + base-val (summary base-branch) 7.17 + alt-branch (step branch-point alt) 7.18 + alt-val (summary alt-branch)] 7.19 + (if (not= base-val alt-val) 7.20 + [(conj actions alt) alt-branch] 7.21 + (recur base-branch (conj actions base)))))) 7.22 7.23 -(defn no-action [length] 7.24 - (repeat length [])) 7.25 +(defn advance 7.26 + ([base alt summary [commands state]] 7.27 + (let [[c s] (first-difference base alt summary state)] 7.28 + [(concat commands c) s])) 7.29 + ([base alt [commands state]] 7.30 + (advance base alt AF [commands state])) 7.31 + ([alt [commands state]] 7.32 + (advance [] alt [commands state]))) 7.33 7.34 -(defn start-summary [] 7.35 - (nth (registers) 2)) 7.36 +(def scroll-text (partial advance [:b] [:a :b])) 7.37 7.38 -(defn common-initial-elements [baseline moves] 7.39 - (loop [common 0 b baseline m moves] 7.40 - (if (empty? m) common 7.41 - (if (= (first b) (first m)) 7.42 - (recur (inc common) (rest b) (rest m)) 7.43 - common)))) 7.44 - 7.45 -(defn earliest-press 7.46 - [start-frame 7.47 - end-frame 7.48 - key 7.49 - summary-fn] 7.50 - (let [action-length (- end-frame start-frame) 7.51 - baseline (no-action action-length)] 7.52 - (print "establishing baseline...") 7.53 - (play-moves start-frame baseline) 7.54 - (let [bad-value (summary-fn)] 7.55 - (println bad-value) 7.56 - (loop [n 0] 7.57 - (let [moves (delayed-key key n action-length) 7.58 - header-length 7.59 - (common-initial-elements moves baseline)] 7.60 - (print "length" (inc n) "...") 7.61 - (without-saves 7.62 - (play-moves 7.63 - (+ start-frame header-length) 7.64 - (drop header-length moves))) 7.65 - (let [result (summary-fn)] 7.66 - (println result) 7.67 - (if (not= result bad-value) 7.68 - (let [keys (delayed-key key (inc n))] 7.69 - (play-moves start-frame keys) 7.70 - keys) 7.71 - (recur (inc n))))))))) 7.72 +(defn start [] [[] (root)]) 7.73 7.74 +(defn-memo title [start] 7.75 + (->> start 7.76 + (advance [] [:a]) 7.77 + (advance [] [:start]) 7.78 + (advance [] [:a]) 7.79 + (advance [] [:start]))) 7.80 7.81 -(defn search-first 7.82 - [start-frame 7.83 - baseline 7.84 - gen-move-fn 7.85 - summary-fn] 7.86 - (print "establishing baseline...") 7.87 - (play-moves start-frame baseline) 7.88 - (let [bad-value (summary-fn)] 7.89 - (println bad-value) 7.90 - (loop [n 0] 7.91 - (let [trial-moves (gen-move-fn n) 7.92 - header-length 7.93 - (common-initial-elements trial-moves baseline)] 7.94 - (print "length" (inc n) "...") 7.95 - (without-saves 7.96 - (play-moves 7.97 - (+ start-frame header-length) 7.98 - (drop header-length trial-moves))) 7.99 - (let [result (summary-fn)] 7.100 - (println result) 7.101 - (if (not= result bad-value) 7.102 - (let [keys (take (inc n) trial-moves)] 7.103 - (play-moves start-frame keys) 7.104 - keys) 7.105 - (recur (inc n)))))))) 7.106 +(defn-memo oak [start] 7.107 + (->> (title) 7.108 + scroll-text 7.109 + scroll-text 7.110 + scroll-text 7.111 + scroll-text 7.112 + scroll-text 7.113 + scroll-text 7.114 + scroll-text 7.115 + scroll-text 7.116 + scroll-text 7.117 + scroll-text 7.118 + scroll-text 7.119 + scroll-text 7.120 + scroll-text 7.121 + (advance [] [:a]))) 7.122 7.123 -(defn title-search 7.124 - [start-frame 7.125 - end-frame 7.126 - key 7.127 - summary-fn] 7.128 - (let [action-length (- end-frame start-frame)] 7.129 - (search-first 7.130 - start-frame 7.131 - (no-action action-length) 7.132 - (fn [n] (delayed-key key n action-length)) 7.133 - summary-fn))) 7.134 +(defn-memo name-entry [] 7.135 + (->> (oak) 7.136 + (advance [] [:r] DE) 7.137 + (play-moves 7.138 + [[] 7.139 + [:r] [] [:r] [] [:r] [] [:r] [] 7.140 + [:r] [] [:r] [] [:r] [] [:d] [:a] 7.141 + [:l] [] [:l] [] [:l] [] [:l] [] 7.142 + [:l] [] [:l] [:a] [] [:r] [:a] 7.143 + [:r] [] [:r] [] [:r] [] [:r] [] 7.144 + [:r] [] [:d] [] [:d] [] [:d] [:a] 7.145 + ]))) 7.146 + 7.147 +(defn-memo rival-name-entry [] 7.148 + (->> (name-entry) 7.149 + scroll-text 7.150 + scroll-text 7.151 + scroll-text 7.152 + scroll-text 7.153 + scroll-text 7.154 + (advance [] [:d]) 7.155 + (advance [] [:d]) 7.156 + (advance [] [:a]))) 7.157 7.158 -(defn gen-title [] 7.159 - (let [start0 (no-action 300)] 7.160 - (play-moves 0 start0) 7.161 - (let [start->first-press 7.162 - (title-search (frame) (+ 50 (frame)) [:a] start-summary) 7.163 - first-press->second-press 7.164 - (title-search (frame) (+ 100 (frame)) [:start] start-summary) 7.165 - second-press->third-press 7.166 - (title-search (frame) (+ 151 (frame)) [:a] start-summary) 7.167 - new-game 7.168 - (title-search (frame) (+ 151 (frame)) [:a] start-summary)] 7.169 - (concat 7.170 - start0 7.171 - start->first-press 7.172 - first-press->second-press 7.173 - second-press->third-press 7.174 - new-game)))) 7.175 - 7.176 -(def title 7.177 - [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.178 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.179 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.180 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.181 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.182 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.183 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.184 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.185 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.186 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.187 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.188 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.189 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.190 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.191 - [] [] [] [] [] [] [] [] [] [] [] [] [] [ :a] [] [] [] [] [] [] [] 7.192 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.193 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.194 - [] [] [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] [] 7.195 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.196 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.197 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.198 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.199 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.200 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.201 - [] [] [] [] [ :a] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.202 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.203 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.204 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.205 - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 7.206 - [] [] [] [] [] [ :a]]) 7.207 +(defn-memo finish-title [] 7.208 + (->> (rival-name-entry) 7.209 + scroll-text 7.210 + scroll-text 7.211 + scroll-text 7.212 + scroll-text 7.213 + scroll-text 7.214 + scroll-text 7.215 + scroll-text)) 7.216 7.217 +(defn-memo intro [] 7.218 + (-> (start) title oak name-entry rival-name-entry finish-title)) 7.219 7.220 -(require '(clojure [zip :as zip])) 7.221 \ No newline at end of file 7.222 + 7.223 +;; TODO might be able to glue these together more elegantly with monads 7.224 +
8.1 --- a/clojure/com/aurellem/title2.clj Sat Mar 10 14:24:10 2012 -0600 8.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 8.3 @@ -1,91 +0,0 @@ 8.4 -(ns com.aurellem.title2 8.5 - (:use (com.aurellem gb-funs vbm))) 8.6 - 8.7 -(defn first-difference [base alt summary root] 8.8 - (loop [branch-point root 8.9 - actions []] 8.10 - (let [base-branch (step branch-point base) 8.11 - base-val (summary base-branch) 8.12 - alt-branch (step branch-point alt) 8.13 - alt-val (summary alt-branch)] 8.14 - (if (not= base-val alt-val) 8.15 - [(conj actions alt) alt-branch] 8.16 - (recur base-branch (conj actions base)))))) 8.17 - 8.18 -(defn advance 8.19 - ([base alt summary [commands state]] 8.20 - (let [[c s] (first-difference base alt summary state)] 8.21 - [(concat commands c) s])) 8.22 - ([base alt [commands state]] 8.23 - (advance base alt AF [commands state])) 8.24 - ([alt [commands state]] 8.25 - (advance [] alt [commands state]))) 8.26 - 8.27 -(def scroll-text (partial advance [:b] [:a :b])) 8.28 - 8.29 -(defn start [] [[] (root)]) 8.30 - 8.31 -(defn-memo title [start] 8.32 - (->> start 8.33 - (advance [] [:a]) 8.34 - (advance [] [:start]) 8.35 - (advance [] [:a]) 8.36 - (advance [] [:start]))) 8.37 - 8.38 -(defn-memo oak [start] 8.39 - (->> start 8.40 - scroll-text 8.41 - scroll-text 8.42 - scroll-text 8.43 - scroll-text 8.44 - scroll-text 8.45 - scroll-text 8.46 - scroll-text 8.47 - scroll-text 8.48 - scroll-text 8.49 - scroll-text 8.50 - scroll-text 8.51 - scroll-text 8.52 - scroll-text 8.53 - (advance [] [:a]))) 8.54 - 8.55 -(defn-memo name-entry [start] 8.56 - (->> start 8.57 - (advance [] [:r] DE) 8.58 - (play-moves 8.59 - [[] 8.60 - [:r] [] [:r] [] [:r] [] [:r] [] 8.61 - [:r] [] [:r] [] [:r] [] [:d] [:a] 8.62 - [:l] [] [:l] [] [:l] [] [:l] [] 8.63 - [:l] [] [:l] [:a] [] [:r] [:a] 8.64 - [:r] [] [:r] [] [:r] [] [:r] [] 8.65 - [:r] [] [:d] [] [:d] [] [:d] [:a] 8.66 - ]))) 8.67 - 8.68 -(defn-memo rival-name-entry [start] 8.69 - (->> start 8.70 - scroll-text 8.71 - scroll-text 8.72 - scroll-text 8.73 - scroll-text 8.74 - scroll-text 8.75 - (advance [] [:d]) 8.76 - (advance [] [:d]) 8.77 - (advance [] [:a]))) 8.78 - 8.79 -(defn-memo finish-title [start] 8.80 - (->> start 8.81 - scroll-text 8.82 - scroll-text 8.83 - scroll-text 8.84 - scroll-text 8.85 - scroll-text 8.86 - scroll-text 8.87 - scroll-text)) 8.88 - 8.89 -(defn-memo intro [] 8.90 - (-> (start) title oak name-entry rival-name-entry finish-title)) 8.91 - 8.92 - 8.93 -;; TODO might be able to glue these together more elegantly with monads 8.94 -
9.1 --- a/clojure/com/aurellem/vbm.clj Sat Mar 10 14:24:10 2012 -0600 9.2 +++ b/clojure/com/aurellem/vbm.clj Sat Mar 10 14:48:17 2012 -0600 9.3 @@ -3,6 +3,15 @@ 9.4 (:import org.apache.commons.io.FileUtils) 9.5 (:use com.aurellem.gb-driver)) 9.6 9.7 +(defn buttons [mask] 9.8 + (loop [buttons [] 9.9 + masks (seq (dissoc button-code :listen))] 9.10 + (if (empty? masks) buttons 9.11 + (let [[button value] (first masks)] 9.12 + (if (not= 0x0000 (bit-and value mask)) 9.13 + (recur (conj buttons button) (rest masks)) 9.14 + (recur buttons (rest masks))))))) 9.15 + 9.16 (defn vbm-bytes [#^File vbm] 9.17 (let [bytes (FileUtils/readFileToByteArray vbm) 9.18 ints (int-array (count bytes))] 9.19 @@ -35,7 +44,7 @@ 9.20 (map buttons (vbm-masks vbm))) 9.21 9.22 (defn play-vbm [#^File vbm] 9.23 - (reset) 9.24 + (restart!) 9.25 (dorun (map step (vbm-masks vbm)))) 9.26 9.27 (defn convert-buttons