# HG changeset patch # User Robert McIntyre # Date 1331412497 21600 # Node ID e8855121f4137ed09187b9be30f308524440a0dc # Parent 9864032ef3c89b12852ff20c20cd0d9217aed115 collect cruft, rename other files diff -r 9864032ef3c8 -r e8855121f413 clojure/com/aurellem/cruft/gb_driver.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/cruft/gb_driver.clj Sat Mar 10 14:48:17 2012 -0600 @@ -0,0 +1,206 @@ +(ns com.aurellem.gb-driver + (:import com.aurellem.gb.Gb) + (:import java.io.File) + (:import org.apache.commons.io.FileUtils) + (:import (java.nio IntBuffer ByteOrder))) + +(Gb/loadVBA) + +(def ^:dynamic *max-history* 2e4) + +(def ^:dynamic *backup-saves-to-disk* true) + +(def ^:dynamic *save-history* true) + +(def ^:dynamic *save-state-cache* + (File. "/home/r/proj/pokemon-escape/save-states/")) + +(def yellow-rom-image + (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc")) + +(def yellow-save-file + (File. "/home/r/proj/pokemon-escape/roms/yellow.sav")) + +(def current-frame (atom 0)) + +(defn vba-init [] + (reset! current-frame 0) + (.delete yellow-save-file) + (Gb/startEmulator (.getCanonicalPath yellow-rom-image))) + +(defn shutdown [] (Gb/shutdown)) + +(defn reset [] (shutdown) (vba-init)) + +(defn cpu-data [size arr-fn] + (let [store (int-array size)] + (fn [] (arr-fn store) store))) + +(def ram + (cpu-data (Gb/getRAMSize) #(Gb/getRAM %))) + +(def rom + (cpu-data (Gb/getROMSize) #(Gb/getROM %))) + +(def working-ram + (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %))) + +(def video-ram + (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %))) + +(def registers + (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %))) + +(def button-code + {;; main buttons + :a 0x0001 + :b 0x0002 + + ;; directional pad + :r 0x0010 + :l 0x0020 + :u 0x0040 + :d 0x0080 + + ;; meta buttons + :select 0x0004 + :start 0x0008 + + ;; hard reset -- not really a button + :reset 0x0800}) + +(defn button-mask [buttons] + (reduce bit-or 0x0000 (map button-code buttons))) + +(defn buttons [mask] + (loop [buttons [] + masks (seq button-code)] + (if (empty? masks) buttons + (let [[button value] (first masks)] + (if (not= 0x0000 (bit-and value mask)) + (recur (conj buttons button) (rest masks)) + (recur buttons (rest masks))))))) + +(defrecord SaveState [frame save-data]) + +(defn frame [] @current-frame) + +(defn save-state [] + (SaveState. (frame) (Gb/saveState))) + +(defn load-state [#^SaveState save] + (reset! current-frame (:frame save)) + (Gb/loadState (:save-data save))) + +(def empty-history (sorted-map)) + +(def history (atom empty-history)) + +(defn frame->disk-save [frame] + (File. *save-state-cache* + (format "%07d.sav" frame))) + +(defn get-save-from-disk [frame] + (let [save (frame->disk-save frame)] + (if (.exists save) + (let [buf (Gb/saveBuffer) + bytes (FileUtils/readFileToByteArray save)] + (.put buf bytes) + (.flip buf) + (SaveState. frame buf))))) + +(defn store-save-to-disk [^SaveState save] + (let [buf (:save-data save) + bytes (byte-array (.limit buf)) + dest (frame->disk-save (:frame save))] + (.get buf bytes) + (FileUtils/writeByteArrayToFile dest bytes) + (.rewind buf) dest)) + +(defn find-save-state [frame] + (let [save (@history frame)] + (if (not (nil? save)) save + (get-save-from-disk frame)))) + +(defn goto [frame] + (let [save (find-save-state frame)] + (if (nil? save) + (println frame "is not in history") + (do + (reset! current-frame frame) + (load-state save))))) + +(defn clear-history [] (reset! history empty-history)) + +(defn rewind + ([] (rewind 1)) + ([n] (goto (- @current-frame n)))) + +(defn backup-state + ([] (backup-state (frame))) + ([frame] + (let [save (save-state)] + (swap! history #(assoc % frame save)) + ;;(store-save-to-disk save) + (if (> (count @history) *max-history*) + (swap! history #(dissoc % (first (first %)))))))) + +(defn advance [] + (if *save-history* + (backup-state @current-frame)) + (swap! current-frame inc)) + +(defn step + ([] (advance) (Gb/step)) + ([mask-or-buttons] + (advance) + (if (number? mask-or-buttons) + (Gb/step mask-or-buttons) + (Gb/step (button-mask mask-or-buttons))))) + +(defn play-moves + ([start moves] + (goto start) + (dorun (map step moves)) + (backup-state) + (frame)) + ([moves] + (dorun (map step moves)) + (backup-state) + (frame))) + +(defn play + ([] (play Integer/MAX_VALUE)) + ([n] (dorun (dotimes [_ n] (step))))) + +(defmacro without-saves [& forms] + `(binding [*save-history* false] + ~@forms)) + + +(require '(clojure [zip :as zip])) + + + + +(defn tree->str [original] + (loop [s ".\n" loc (zip/down (zip/seq-zip (seq original)))] + (if (zip/end? loc) s + (let [d (count (zip/path loc)) + rep + (str + s + (if (and (zip/up loc) + (> (count (-> loc zip/up zip/rights)) 0)) + "|" "") + (apply str (repeat (dec d) " ")) + (if (= (count (zip/rights loc)) 0) + "`-- " + "|-- ") + (zip/node loc) + "\n")] + (recur rep (zip/next loc)))))) + + + + diff -r 9864032ef3c8 -r e8855121f413 clojure/com/aurellem/cruft/title.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/cruft/title.clj Sat Mar 10 14:48:17 2012 -0600 @@ -0,0 +1,141 @@ +(ns com.aurellem.title + (:use (com.aurellem gb-driver vbm))) + +(defn delayed-key + ([key delay total] + (concat (repeat delay []) [key] (repeat (- total delay 1) []))) + ([key total] + (delayed-key key (dec total) total))) + +(defn no-action [length] + (repeat length [])) + +(defn start-summary [] + (nth (registers) 2)) + +(defn common-initial-elements [baseline moves] + (loop [common 0 b baseline m moves] + (if (empty? m) common + (if (= (first b) (first m)) + (recur (inc common) (rest b) (rest m)) + common)))) + +(defn earliest-press + [start-frame + end-frame + key + summary-fn] + (let [action-length (- end-frame start-frame) + baseline (no-action action-length)] + (print "establishing baseline...") + (play-moves start-frame baseline) + (let [bad-value (summary-fn)] + (println bad-value) + (loop [n 0] + (let [moves (delayed-key key n action-length) + header-length + (common-initial-elements moves baseline)] + (print "length" (inc n) "...") + (without-saves + (play-moves + (+ start-frame header-length) + (drop header-length moves))) + (let [result (summary-fn)] + (println result) + (if (not= result bad-value) + (let [keys (delayed-key key (inc n))] + (play-moves start-frame keys) + keys) + (recur (inc n))))))))) + + +(defn search-first + [start-frame + baseline + gen-move-fn + summary-fn] + (print "establishing baseline...") + (play-moves start-frame baseline) + (let [bad-value (summary-fn)] + (println bad-value) + (loop [n 0] + (let [trial-moves (gen-move-fn n) + header-length + (common-initial-elements trial-moves baseline)] + (print "length" (inc n) "...") + (without-saves + (play-moves + (+ start-frame header-length) + (drop header-length trial-moves))) + (let [result (summary-fn)] + (println result) + (if (not= result bad-value) + (let [keys (take (inc n) trial-moves)] + (play-moves start-frame keys) + keys) + (recur (inc n)))))))) + +(defn title-search + [start-frame + end-frame + key + summary-fn] + (let [action-length (- end-frame start-frame)] + (search-first + start-frame + (no-action action-length) + (fn [n] (delayed-key key n action-length)) + summary-fn))) + +(defn gen-title [] + (let [start0 (no-action 300)] + (play-moves 0 start0) + (let [start->first-press + (title-search (frame) (+ 50 (frame)) [:a] start-summary) + first-press->second-press + (title-search (frame) (+ 100 (frame)) [:start] start-summary) + second-press->third-press + (title-search (frame) (+ 151 (frame)) [:a] start-summary) + new-game + (title-search (frame) (+ 151 (frame)) [:a] start-summary)] + (concat + start0 + start->first-press + first-press->second-press + second-press->third-press + new-game)))) + +(def title + [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [ :a] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [ :a] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] + [] [] [] [] [] [ :a]]) + + +(require '(clojure [zip :as zip])) \ No newline at end of file diff -r 9864032ef3c8 -r e8855121f413 clojure/com/aurellem/gb_driver.clj --- a/clojure/com/aurellem/gb_driver.clj Sat Mar 10 14:24:10 2012 -0600 +++ b/clojure/com/aurellem/gb_driver.clj Sat Mar 10 14:48:17 2012 -0600 @@ -1,40 +1,140 @@ (ns com.aurellem.gb-driver - (:import com.aurellem.gb.Gb) - (:import java.io.File) - (:import org.apache.commons.io.FileUtils) - (:import (java.nio IntBuffer ByteOrder))) + (:import com.aurellem.gb.Gb) + (:import java.io.File) + (:import org.apache.commons.io.FileUtils) + (:import (java.nio IntBuffer ByteOrder))) -(Gb/loadVBA) - -(def ^:dynamic *max-history* 2e4) - -(def ^:dynamic *backup-saves-to-disk* true) - -(def ^:dynamic *save-history* true) +;; Savestates +(defrecord SaveState [frame data]) (def ^:dynamic *save-state-cache* (File. "/home/r/proj/pokemon-escape/save-states/")) +(defn frame->filename [frame] + (File. *save-state-cache* (format "%07d.sav" frame))) + +(defn write-save! [^SaveState save] + (let [buf (:data save) + bytes (byte-array (.limit buf)) + dest (frame->filename (:frame save))] + (.get buf bytes) + (FileUtils/writeByteArrayToFile dest bytes) + (.rewind buf) + save)) + +(defn read-save [frame] + (let [save (frame->filename frame)] + (if (.exists save) + (let [buf (Gb/saveBuffer) + bytes (FileUtils/readFileToByteArray save)] + (.put buf bytes) + (.flip buf) + (SaveState. frame buf))))) +;;;;;;;;;;;;;;;; + +;; Gameboy management +(Gb/loadVBA) + (def yellow-rom-image (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc")) (def yellow-save-file (File. "/home/r/proj/pokemon-escape/roms/yellow.sav")) -(def current-frame (atom 0)) +(def on? (atom nil)) -(defn vba-init [] - (reset! current-frame 0) +(defn shutdown! [] (Gb/shutdown) (reset! on? false)) + +(defn restart! [] + (shutdown!) (.delete yellow-save-file) - (Gb/startEmulator (.getCanonicalPath yellow-rom-image))) + (Gb/startEmulator (.getCanonicalPath yellow-rom-image)) + (reset! on? true)) -(defn shutdown [] (Gb/shutdown)) +;;; The first state! +(defn gen-root! [] + (restart!) + (write-save! (SaveState. 0 (Gb/saveState)))) -(defn reset [] (shutdown) (vba-init)) +(defn root [] + (if (.exists (frame->filename 0)) + (read-save 0) + (gen-root!))) + +;;;; Press Buttons + +(def button-code + {;; main buttons + :a 0x0001 + :b 0x0002 + + ;; directional pad + :r 0x0010 + :l 0x0020 + :u 0x0040 + :d 0x0080 + + ;; meta buttons + :select 0x0004 + :start 0x0008 + + ;; pseudo-buttons + :restart 0x0800 ; hard reset + :listen -1 ; listen for user input + }) + +(defn button-mask [buttons] + (reduce bit-or 0x0000 (map button-code buttons))) + +(def current-state (atom nil)) + + +(defn set-state! [^SaveState state] + (assert (:data state) "Not a valid state!") + (if (not @on?) (restart!)) + (if (not= @current-state state) + (Gb/loadState (:data state))) + (reset! current-state state)) + +(defrecord Move [keys state]) + +(defn step + ([^SaveState state buttons] + (set-state! state) + (Gb/step (button-mask buttons)) + (reset! current-state + (SaveState. (inc (:frame state))(Gb/saveState)))) + ([^SaveState state] + (step state [:listen])) + ([] (step (if @current-state @current-state (root))))) + +(defn move + [^Move move buttons] + (Move. (step (:state move) buttons) buttons)) + + +(defn play + ([^SaveState state n] + (reduce (fn [s _] (step s)) state (range n))) + ([n] + (play @current-state n))) + +(defn play-moves + ([moves [prev state]] + (set-state! state) + (dorun (map (fn [move] (step @current-state move)) moves)) + [(concat prev moves) @current-state])) + +;;;;;;;;;;; + + +;;;;;;;;;;;;;;; CPU data + + (defn cpu-data [size arr-fn] (let [store (int-array size)] - (fn [] (arr-fn store) store))) + (fn [state] (set-state! state) (arr-fn store) store))) (def ram (cpu-data (Gb/getRAMSize) #(Gb/getRAM %))) @@ -51,156 +151,25 @@ (def registers (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %))) -(def button-code - {;; main buttons - :a 0x0001 - :b 0x0002 +;; TODO add register names - ;; directional pad - :r 0x0010 - :l 0x0020 - :u 0x0040 - :d 0x0080 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; meta buttons - :select 0x0004 - :start 0x0008 +(defn AF [state] + (nth (registers state) 2)) - ;; hard reset -- not really a button - :reset 0x0800}) +(defn BC [state] + (nth (registers state) 3)) -(defn button-mask [buttons] - (reduce bit-or 0x0000 (map button-code buttons))) +(defn DE [state] + (nth (registers state) 4)) + +;;;;;;;;;;;;;;; -(defn buttons [mask] - (loop [buttons [] - masks (seq button-code)] - (if (empty? masks) buttons - (let [[button value] (first masks)] - (if (not= 0x0000 (bit-and value mask)) - (recur (conj buttons button) (rest masks)) - (recur buttons (rest masks))))))) - -(defrecord SaveState [frame save-data]) - -(defn frame [] @current-frame) - -(defn save-state [] - (SaveState. (frame) (Gb/saveState))) - -(defn load-state [#^SaveState save] - (reset! current-frame (:frame save)) - (Gb/loadState (:save-data save))) - -(def empty-history (sorted-map)) - -(def history (atom empty-history)) - -(defn frame->disk-save [frame] - (File. *save-state-cache* - (format "%07d.sav" frame))) - -(defn get-save-from-disk [frame] - (let [save (frame->disk-save frame)] - (if (.exists save) - (let [buf (Gb/saveBuffer) - bytes (FileUtils/readFileToByteArray save)] - (.put buf bytes) - (.flip buf) - (SaveState. frame buf))))) - -(defn store-save-to-disk [^SaveState save] - (let [buf (:save-data save) - bytes (byte-array (.limit buf)) - dest (frame->disk-save (:frame save))] - (.get buf bytes) - (FileUtils/writeByteArrayToFile dest bytes) - (.rewind buf) dest)) - -(defn find-save-state [frame] - (let [save (@history frame)] - (if (not (nil? save)) save - (get-save-from-disk frame)))) - -(defn goto [frame] - (let [save (find-save-state frame)] - (if (nil? save) - (println frame "is not in history") - (do - (reset! current-frame frame) - (load-state save))))) - -(defn clear-history [] (reset! history empty-history)) - -(defn rewind - ([] (rewind 1)) - ([n] (goto (- @current-frame n)))) - -(defn backup-state - ([] (backup-state (frame))) - ([frame] - (let [save (save-state)] - (swap! history #(assoc % frame save)) - ;;(store-save-to-disk save) - (if (> (count @history) *max-history*) - (swap! history #(dissoc % (first (first %)))))))) - -(defn advance [] - (if *save-history* - (backup-state @current-frame)) - (swap! current-frame inc)) - -(defn step - ([] (advance) (Gb/step)) - ([mask-or-buttons] - (advance) - (if (number? mask-or-buttons) - (Gb/step mask-or-buttons) - (Gb/step (button-mask mask-or-buttons))))) - -(defn play-moves - ([start moves] - (goto start) - (dorun (map step moves)) - (backup-state) - (frame)) - ([moves] - (dorun (map step moves)) - (backup-state) - (frame))) - -(defn play - ([] (play Integer/MAX_VALUE)) - ([n] (dorun (dotimes [_ n] (step))))) - -(defmacro without-saves [& forms] - `(binding [*save-history* false] - ~@forms)) - - -(require '(clojure [zip :as zip])) - - - - -(defn tree->str [original] - (loop [s ".\n" loc (zip/down (zip/seq-zip (seq original)))] - (if (zip/end? loc) s - (let [d (count (zip/path loc)) - rep - (str - s - (if (and (zip/up loc) - (> (count (-> loc zip/up zip/rights)) 0)) - "|" "") - (apply str (repeat (dec d) " ")) - (if (= (count (zip/rights loc)) 0) - "`-- " - "|-- ") - (zip/node loc) - "\n")] - (recur rep (zip/next loc)))))) - - - - +(defmacro defn-memo + [& forms] + (let [fun-name (first forms)] + `(do + (defn ~@forms) + (alter-var-root (var ~fun-name) memoize)))) + \ No newline at end of file diff -r 9864032ef3c8 -r e8855121f413 clojure/com/aurellem/gb_funs.clj --- a/clojure/com/aurellem/gb_funs.clj Sat Mar 10 14:24:10 2012 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,175 +0,0 @@ -(ns com.aurellem.gb-funs - (:import com.aurellem.gb.Gb) - (:import java.io.File) - (:import org.apache.commons.io.FileUtils) - (:import (java.nio IntBuffer ByteOrder))) - -;; Savestates -(defrecord SaveState [frame data]) - -(def ^:dynamic *save-state-cache* - (File. "/home/r/proj/pokemon-escape/save-states/")) - -(defn frame->filename [frame] - (File. *save-state-cache* (format "%07d.sav" frame))) - -(defn write-save! [^SaveState save] - (let [buf (:data save) - bytes (byte-array (.limit buf)) - dest (frame->filename (:frame save))] - (.get buf bytes) - (FileUtils/writeByteArrayToFile dest bytes) - (.rewind buf) - save)) - -(defn read-save [frame] - (let [save (frame->filename frame)] - (if (.exists save) - (let [buf (Gb/saveBuffer) - bytes (FileUtils/readFileToByteArray save)] - (.put buf bytes) - (.flip buf) - (SaveState. frame buf))))) -;;;;;;;;;;;;;;;; - -;; Gameboy management -(Gb/loadVBA) - -(def yellow-rom-image - (File. "/home/r/proj/pokemon-escape/roms/yellow.gbc")) - -(def yellow-save-file - (File. "/home/r/proj/pokemon-escape/roms/yellow.sav")) - -(def on? (atom nil)) - -(defn shutdown! [] (Gb/shutdown) (reset! on? false)) - -(defn restart! [] - (shutdown!) - (.delete yellow-save-file) - (Gb/startEmulator (.getCanonicalPath yellow-rom-image)) - (reset! on? true)) - -;;; The first state! -(defn gen-root! [] - (restart!) - (write-save! (SaveState. 0 (Gb/saveState)))) - -(defn root [] - (if (.exists (frame->filename 0)) - (read-save 0) - (gen-root!))) - -;;;; Press Buttons - -(def button-code - {;; main buttons - :a 0x0001 - :b 0x0002 - - ;; directional pad - :r 0x0010 - :l 0x0020 - :u 0x0040 - :d 0x0080 - - ;; meta buttons - :select 0x0004 - :start 0x0008 - - ;; pseudo-buttons - :restart 0x0800 ; hard reset - :listen -1 ; listen for user input - }) - -(defn button-mask [buttons] - (reduce bit-or 0x0000 (map button-code buttons))) - -(def current-state (atom nil)) - - -(defn set-state! [^SaveState state] - (assert (:data state) "Not a valid state!") - (if (not @on?) (restart!)) - (if (not= @current-state state) - (Gb/loadState (:data state))) - (reset! current-state state)) - -(defrecord Move [keys state]) - -(defn step - ([^SaveState state buttons] - (set-state! state) - (Gb/step (button-mask buttons)) - (reset! current-state - (SaveState. (inc (:frame state))(Gb/saveState)))) - ([^SaveState state] - (step state [:listen])) - ([] (step (if @current-state @current-state (root))))) - -(defn move - [^Move move buttons] - (Move. (step (:state move) buttons) buttons)) - - -(defn play - ([^SaveState state n] - (reduce (fn [s _] (step s)) state (range n))) - ([n] - (play @current-state n))) - -(defn play-moves - ([moves [prev state]] - (set-state! state) - (dorun (map (fn [move] (step @current-state move)) moves)) - [(concat prev moves) @current-state])) - -;;;;;;;;;;; - - -;;;;;;;;;;;;;;; CPU data - - - -(defn cpu-data [size arr-fn] - (let [store (int-array size)] - (fn [state] (set-state! state) (arr-fn store) store))) - -(def ram - (cpu-data (Gb/getRAMSize) #(Gb/getRAM %))) - -(def rom - (cpu-data (Gb/getROMSize) #(Gb/getROM %))) - -(def working-ram - (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %))) - -(def video-ram - (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %))) - -(def registers - (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %))) - -;; TODO add register names - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn AF [state] - (nth (registers state) 2)) - -(defn BC [state] - (nth (registers state) 3)) - -(defn DE [state] - (nth (registers state) 4)) - -;;;;;;;;;;;;;;; - -(defmacro defn-memo - [& forms] - (let [fun-name (first forms)] - `(do - (defn ~@forms) - (alter-var-root (var ~fun-name) memoize)))) - \ No newline at end of file diff -r 9864032ef3c8 -r e8855121f413 clojure/com/aurellem/speedruns.clj --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/clojure/com/aurellem/speedruns.clj Sat Mar 10 14:48:17 2012 -0600 @@ -0,0 +1,13 @@ +(ns com.aurellem.test-vbm + (:import java.io.File) + (:use (com.aurellem vbm gb-driver))) + +(def speedrun-2942 + (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2942.vbm")) + +(def speedrun-2913 + (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2913.vbm")) + +(def speedrun-2771 + (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2771.vbm")) + diff -r 9864032ef3c8 -r e8855121f413 clojure/com/aurellem/test_vbm.clj --- a/clojure/com/aurellem/test_vbm.clj Sat Mar 10 14:24:10 2012 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -(ns com.aurellem.test-vbm - (:import java.io.File) - (:use (com.aurellem vbm gb-driver))) - -(def test-file (File."/home/r/proj/pokemon-escape/speedruns/rlm.vbm")) - -(def speedrun-2942 - (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2942.vbm")) - -(def speedrun-2913 - (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2913.vbm")) - -(def speedrun-2771 - (File. "/home/r/proj/pokemon-escape/speedruns/yellow-2771.vbm")) - -(defn test-speedrun [] - (dorun - (map step (vbm-masks speedrun-2942)))) diff -r 9864032ef3c8 -r e8855121f413 clojure/com/aurellem/title.clj --- a/clojure/com/aurellem/title.clj Sat Mar 10 14:24:10 2012 -0600 +++ b/clojure/com/aurellem/title.clj Sat Mar 10 14:48:17 2012 -0600 @@ -1,141 +1,91 @@ (ns com.aurellem.title (:use (com.aurellem gb-driver vbm))) -(defn delayed-key - ([key delay total] - (concat (repeat delay []) [key] (repeat (- total delay 1) []))) - ([key total] - (delayed-key key (dec total) total))) +(defn first-difference [base alt summary root] + (loop [branch-point root + actions []] + (let [base-branch (step branch-point base) + base-val (summary base-branch) + alt-branch (step branch-point alt) + alt-val (summary alt-branch)] + (if (not= base-val alt-val) + [(conj actions alt) alt-branch] + (recur base-branch (conj actions base)))))) -(defn no-action [length] - (repeat length [])) +(defn advance + ([base alt summary [commands state]] + (let [[c s] (first-difference base alt summary state)] + [(concat commands c) s])) + ([base alt [commands state]] + (advance base alt AF [commands state])) + ([alt [commands state]] + (advance [] alt [commands state]))) -(defn start-summary [] - (nth (registers) 2)) +(def scroll-text (partial advance [:b] [:a :b])) -(defn common-initial-elements [baseline moves] - (loop [common 0 b baseline m moves] - (if (empty? m) common - (if (= (first b) (first m)) - (recur (inc common) (rest b) (rest m)) - common)))) - -(defn earliest-press - [start-frame - end-frame - key - summary-fn] - (let [action-length (- end-frame start-frame) - baseline (no-action action-length)] - (print "establishing baseline...") - (play-moves start-frame baseline) - (let [bad-value (summary-fn)] - (println bad-value) - (loop [n 0] - (let [moves (delayed-key key n action-length) - header-length - (common-initial-elements moves baseline)] - (print "length" (inc n) "...") - (without-saves - (play-moves - (+ start-frame header-length) - (drop header-length moves))) - (let [result (summary-fn)] - (println result) - (if (not= result bad-value) - (let [keys (delayed-key key (inc n))] - (play-moves start-frame keys) - keys) - (recur (inc n))))))))) +(defn start [] [[] (root)]) +(defn-memo title [start] + (->> start + (advance [] [:a]) + (advance [] [:start]) + (advance [] [:a]) + (advance [] [:start]))) -(defn search-first - [start-frame - baseline - gen-move-fn - summary-fn] - (print "establishing baseline...") - (play-moves start-frame baseline) - (let [bad-value (summary-fn)] - (println bad-value) - (loop [n 0] - (let [trial-moves (gen-move-fn n) - header-length - (common-initial-elements trial-moves baseline)] - (print "length" (inc n) "...") - (without-saves - (play-moves - (+ start-frame header-length) - (drop header-length trial-moves))) - (let [result (summary-fn)] - (println result) - (if (not= result bad-value) - (let [keys (take (inc n) trial-moves)] - (play-moves start-frame keys) - keys) - (recur (inc n)))))))) +(defn-memo oak [start] + (->> (title) + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + (advance [] [:a]))) -(defn title-search - [start-frame - end-frame - key - summary-fn] - (let [action-length (- end-frame start-frame)] - (search-first - start-frame - (no-action action-length) - (fn [n] (delayed-key key n action-length)) - summary-fn))) +(defn-memo name-entry [] + (->> (oak) + (advance [] [:r] DE) + (play-moves + [[] + [:r] [] [:r] [] [:r] [] [:r] [] + [:r] [] [:r] [] [:r] [] [:d] [:a] + [:l] [] [:l] [] [:l] [] [:l] [] + [:l] [] [:l] [:a] [] [:r] [:a] + [:r] [] [:r] [] [:r] [] [:r] [] + [:r] [] [:d] [] [:d] [] [:d] [:a] + ]))) + +(defn-memo rival-name-entry [] + (->> (name-entry) + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + (advance [] [:d]) + (advance [] [:d]) + (advance [] [:a]))) -(defn gen-title [] - (let [start0 (no-action 300)] - (play-moves 0 start0) - (let [start->first-press - (title-search (frame) (+ 50 (frame)) [:a] start-summary) - first-press->second-press - (title-search (frame) (+ 100 (frame)) [:start] start-summary) - second-press->third-press - (title-search (frame) (+ 151 (frame)) [:a] start-summary) - new-game - (title-search (frame) (+ 151 (frame)) [:a] start-summary)] - (concat - start0 - start->first-press - first-press->second-press - second-press->third-press - new-game)))) - -(def title - [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [ :a] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [:start] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [ :a] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] - [] [] [] [] [] [ :a]]) +(defn-memo finish-title [] + (->> (rival-name-entry) + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text + scroll-text)) +(defn-memo intro [] + (-> (start) title oak name-entry rival-name-entry finish-title)) -(require '(clojure [zip :as zip])) \ No newline at end of file + +;; TODO might be able to glue these together more elegantly with monads + diff -r 9864032ef3c8 -r e8855121f413 clojure/com/aurellem/title2.clj --- a/clojure/com/aurellem/title2.clj Sat Mar 10 14:24:10 2012 -0600 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,91 +0,0 @@ -(ns com.aurellem.title2 - (:use (com.aurellem gb-funs vbm))) - -(defn first-difference [base alt summary root] - (loop [branch-point root - actions []] - (let [base-branch (step branch-point base) - base-val (summary base-branch) - alt-branch (step branch-point alt) - alt-val (summary alt-branch)] - (if (not= base-val alt-val) - [(conj actions alt) alt-branch] - (recur base-branch (conj actions base)))))) - -(defn advance - ([base alt summary [commands state]] - (let [[c s] (first-difference base alt summary state)] - [(concat commands c) s])) - ([base alt [commands state]] - (advance base alt AF [commands state])) - ([alt [commands state]] - (advance [] alt [commands state]))) - -(def scroll-text (partial advance [:b] [:a :b])) - -(defn start [] [[] (root)]) - -(defn-memo title [start] - (->> start - (advance [] [:a]) - (advance [] [:start]) - (advance [] [:a]) - (advance [] [:start]))) - -(defn-memo oak [start] - (->> start - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - (advance [] [:a]))) - -(defn-memo name-entry [start] - (->> start - (advance [] [:r] DE) - (play-moves - [[] - [:r] [] [:r] [] [:r] [] [:r] [] - [:r] [] [:r] [] [:r] [] [:d] [:a] - [:l] [] [:l] [] [:l] [] [:l] [] - [:l] [] [:l] [:a] [] [:r] [:a] - [:r] [] [:r] [] [:r] [] [:r] [] - [:r] [] [:d] [] [:d] [] [:d] [:a] - ]))) - -(defn-memo rival-name-entry [start] - (->> start - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - (advance [] [:d]) - (advance [] [:d]) - (advance [] [:a]))) - -(defn-memo finish-title [start] - (->> start - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text - scroll-text)) - -(defn-memo intro [] - (-> (start) title oak name-entry rival-name-entry finish-title)) - - -;; TODO might be able to glue these together more elegantly with monads - diff -r 9864032ef3c8 -r e8855121f413 clojure/com/aurellem/vbm.clj --- a/clojure/com/aurellem/vbm.clj Sat Mar 10 14:24:10 2012 -0600 +++ b/clojure/com/aurellem/vbm.clj Sat Mar 10 14:48:17 2012 -0600 @@ -3,6 +3,15 @@ (:import org.apache.commons.io.FileUtils) (:use com.aurellem.gb-driver)) +(defn buttons [mask] + (loop [buttons [] + masks (seq (dissoc button-code :listen))] + (if (empty? masks) buttons + (let [[button value] (first masks)] + (if (not= 0x0000 (bit-and value mask)) + (recur (conj buttons button) (rest masks)) + (recur buttons (rest masks))))))) + (defn vbm-bytes [#^File vbm] (let [bytes (FileUtils/readFileToByteArray vbm) ints (int-array (count bytes))] @@ -35,7 +44,7 @@ (map buttons (vbm-masks vbm))) (defn play-vbm [#^File vbm] - (reset) + (restart!) (dorun (map step (vbm-masks vbm)))) (defn convert-buttons