1.1 --- a/clojure/com/aurellem/gb_funs.clj	Fri Mar 09 19:18:00 2012 -0600
     1.2 +++ b/clojure/com/aurellem/gb_funs.clj	Fri Mar 09 23:28:07 2012 -0600
     1.3 @@ -79,7 +79,7 @@
     1.4     :start     0x0008
     1.5  
     1.6     ;; pseudo-buttons
     1.7 -   :restart   0x0800 ; hard reset -- not really a button
     1.8 +   :restart   0x0800 ; hard reset 
     1.9     :listen -1        ; listen for user input
    1.10     })
    1.11  
    1.12 @@ -88,17 +88,71 @@
    1.13  
    1.14  (def current-state (atom nil))
    1.15  
    1.16 +
    1.17 +(defn set-state! [^SaveState state]
    1.18 +  (if (not @on?) (restart!))
    1.19 +  (if (not= @current-state state)
    1.20 +    (Gb/loadState (:data state)))
    1.21 +  (reset! current-state state))
    1.22 +
    1.23 +(defrecord Move [keys state])
    1.24 +
    1.25  (defn step
    1.26    ([^SaveState state buttons]
    1.27 -     (if (not @on?) (restart!))
    1.28 -     (if (not= @current-state state)
    1.29 -       (Gb/loadState (:data state)))
    1.30 +     (set-state! state)
    1.31       (Gb/step (button-mask buttons))
    1.32       (reset! current-state 
    1.33 -             (SaveState. (inc (:frame state))(Gb/saveState)))))
    1.34 -
    1.35 -(defn play
    1.36 +             (SaveState. (inc (:frame state))(Gb/saveState))))
    1.37    ([^SaveState state]
    1.38       (step state [:listen]))
    1.39    ([] (step (if @current-state @current-state (root)))))
    1.40 -  
    1.41 +
    1.42 +(defn move
    1.43 +  [^Move move buttons]
    1.44 +  (Move. (step (:state move) buttons) buttons))
    1.45 +
    1.46 +
    1.47 +(defn play
    1.48 +  ([state n]
    1.49 +     (reduce (fn [s _] (step s)) state (range n)))
    1.50 +  ([state]
    1.51 +     (dorun (iterate step state))))
    1.52 +;;;;;;;;;;;
    1.53 +
    1.54 +
    1.55 +;;;;;;;;;;;;;;; CPU data
    1.56 +
    1.57 +
    1.58 +
    1.59 +(defn cpu-data [size arr-fn]
    1.60 +  (let [store (int-array size)]
    1.61 +    (fn [state] (set-state! state) (arr-fn store) store)))
    1.62 +
    1.63 +(def ram
    1.64 +  (cpu-data (Gb/getRAMSize) #(Gb/getRAM %)))
    1.65 +
    1.66 +(def rom 
    1.67 +  (cpu-data (Gb/getROMSize) #(Gb/getROM %)))
    1.68 +
    1.69 +(def working-ram 
    1.70 +  (cpu-data Gb/WRAM_SIZE #(Gb/getWRAM %)))
    1.71 +
    1.72 +(def video-ram 
    1.73 +  (cpu-data Gb/VRAM_SIZE #(Gb/getVRAM %)))
    1.74 +
    1.75 +(def registers
    1.76 +  (cpu-data Gb/NUM_REGISTERS #(Gb/getRegisters %)))
    1.77 +
    1.78 +;; TODO add register names
    1.79 +
    1.80 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1.81 +
    1.82 +(defn AF [state]
    1.83 +  (nth (registers state) 2))
    1.84 +
    1.85 +(defn BC [state]
    1.86 +  (nth (registers state) 3))
    1.87 +
    1.88 +        
    1.89 +            
    1.90 +  
    1.91 \ No newline at end of file

     2.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2 +++ b/clojure/com/aurellem/title2.clj	Fri Mar 09 23:28:07 2012 -0600
     2.3 @@ -0,0 +1,47 @@
     2.4 +(ns com.aurellem.title2
     2.5 +  (:use (com.aurellem gb-funs vbm)))
     2.6 +
     2.7 +(defn first-difference [base alt summary root]
     2.8 +  (loop [branch-point root
     2.9 +         actions []]
    2.10 +    (let [base-branch (step branch-point base)
    2.11 +          base-val (summary base-branch)
    2.12 +          alt-branch (step branch-point alt)
    2.13 +          alt-val (summary alt-branch)]
    2.14 +      (if (not= base-val alt-val)
    2.15 +        [(conj actions alt) alt-branch]
    2.16 +        (recur base-branch (conj actions base))))))
    2.17 +
    2.18 +(defn title []
    2.19 +  (let [[c-1 s-1] (first-difference [] [:a] AF (root))
    2.20 +        [c-2 s-2] (first-difference [] [:start] AF s-1)
    2.21 +        [c-3 s-3] (first-difference [] [:a] AF s-2)
    2.22 +        [c-4 s-4] (first-difference [] [:start] AF s-3)]
    2.23 +    [(concat c-1 c-2 c-3 c-3 c-4) s-4]))
    2.24 +
    2.25 +(def menu-end (second (title)))
    2.26 +
    2.27 +(defn scroll-text [[commands state]]
    2.28 +  (let [[c s] (first-difference [:b] [:a :b] AF state)]
    2.29 +    [(concat commands c) s]))
    2.30 +
    2.31 +(defn oak []
    2.32 +  (-> [[] menu-end]
    2.33 +      scroll-text
    2.34 +      scroll-text
    2.35 +      scroll-text
    2.36 +      scroll-text
    2.37 +      scroll-text
    2.38 +      scroll-text
    2.39 +      scroll-text
    2.40 +      scroll-text
    2.41 +      scroll-text
    2.42 +      scroll-text
    2.43 +      scroll-text
    2.44 +      scroll-text
    2.45 +      scroll-text))
    2.46 +
    2.47 +(def oak-end (second (oak)))
    2.48 +  
    2.49 +
    2.50 +;; looks like it might need a monad here if this pattern continues
    2.51 \ No newline at end of file