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