changeset 86:9864032ef3c8

cleaned up code and made it to the end of the title
author Robert McIntyre <rlm@mit.edu>
date Sat, 10 Mar 2012 14:24:10 -0600
parents 3f4fdd270059
children e8855121f413
files clojure/com/aurellem/gb_funs.clj clojure/com/aurellem/title2.clj
diffstat 2 files changed, 56 insertions(+), 28 deletions(-) [+]
line wrap: on
line diff
     1.1 --- a/clojure/com/aurellem/gb_funs.clj	Sat Mar 10 00:32:11 2012 -0600
     1.2 +++ b/clojure/com/aurellem/gb_funs.clj	Sat Mar 10 14:24:10 2012 -0600
     1.3 @@ -120,10 +120,10 @@
     1.4       (play @current-state n)))
     1.5  
     1.6  (defn play-moves
     1.7 -  ([state moves]
     1.8 -     
     1.9 -  ([moves]
    1.10 -     (dorun (map (fn [move] (step @current-state move)) moves))))
    1.11 +  ([moves [prev state]]
    1.12 +     (set-state! state)
    1.13 +     (dorun (map (fn [move] (step @current-state move)) moves))
    1.14 +     [(concat prev moves) @current-state]))
    1.15    
    1.16  ;;;;;;;;;;;
    1.17  
    1.18 @@ -164,4 +164,12 @@
    1.19  (defn DE [state]
    1.20    (nth (registers state) 4))
    1.21              
    1.22 +;;;;;;;;;;;;;;;
    1.23 +
    1.24 +(defmacro defn-memo
    1.25 +  [& forms]
    1.26 +  (let [fun-name (first forms)]
    1.27 +    `(do
    1.28 +       (defn ~@forms)
    1.29 +       (alter-var-root (var ~fun-name) memoize))))
    1.30    
    1.31 \ No newline at end of file
     2.1 --- a/clojure/com/aurellem/title2.clj	Sat Mar 10 00:32:11 2012 -0600
     2.2 +++ b/clojure/com/aurellem/title2.clj	Sat Mar 10 14:24:10 2012 -0600
     2.3 @@ -23,17 +23,17 @@
     2.4  
     2.5  (def scroll-text (partial advance [:b] [:a :b]))
     2.6  
     2.7 -(defn title []
     2.8 -  (->> [[] (root)]
     2.9 +(defn start [] [[] (root)])
    2.10 +
    2.11 +(defn-memo title [start]
    2.12 +  (->> start
    2.13         (advance [] [:a])
    2.14         (advance [] [:start])
    2.15         (advance [] [:a])
    2.16         (advance [] [:start])))
    2.17  
    2.18 -(def title-end (second (title)))
    2.19 -
    2.20 -(defn oak []
    2.21 -  (->> [[] title-end]
    2.22 +(defn-memo oak [start]
    2.23 +  (->> start
    2.24         scroll-text
    2.25         scroll-text
    2.26         scroll-text
    2.27 @@ -49,23 +49,43 @@
    2.28         scroll-text
    2.29         (advance [] [:a])))
    2.30  
    2.31 -;; looks like it might need a monad here if this pattern continues
    2.32 +(defn-memo name-entry [start]
    2.33 +  (->> start
    2.34 +       (advance [] [:r] DE)
    2.35 +       (play-moves
    2.36 +        [[]
    2.37 +         [:r] [] [:r] [] [:r] [] [:r] []
    2.38 +         [:r] [] [:r] [] [:r] [] [:d] [:a]  
    2.39 +         [:l] [] [:l] [] [:l] [] [:l] []
    2.40 +         [:l] [] [:l] [:a] [] [:r] [:a]
    2.41 +         [:r] [] [:r] [] [:r] [] [:r] []
    2.42 +         [:r] [] [:d] [] [:d] [] [:d] [:a]
    2.43 +         ])))
    2.44 +          
    2.45 +(defn-memo rival-name-entry [start]
    2.46 +  (->> start
    2.47 +       scroll-text
    2.48 +       scroll-text
    2.49 +       scroll-text
    2.50 +       scroll-text
    2.51 +       scroll-text
    2.52 +       (advance [] [:d])
    2.53 +       (advance [] [:d])
    2.54 +       (advance [] [:a])))
    2.55  
    2.56 -(def oak-end (second (oak)))
    2.57 -           
    2.58 -(defn name-entry []
    2.59 -  (->> [[] oak-end]
    2.60 -       (advance [] [:r] DE)
    2.61 -       ((fn [[moves state]]
    2.62 -          (play-moves
    2.63 -           state
    2.64 -            [[]
    2.65 -             [:r] [] [:r] [] [:r] [] [:r] []
    2.66 -             [:r] [] [:r] [] [:r] [] [:d] [:a]  
    2.67 -             [:l] [] [:l] [] [:l] [] [:l] []
    2.68 -             [:l] [] [:l] [:a] [] [:r] [:a]
    2.69 -             [:r] [] [:r] [] [:r] [] [:r] []
    2.70 -             [:r] [] [:d] [] [:d] [] [:d] [:a]
    2.71 -             ])))))
    2.72 -          
    2.73 +(defn-memo finish-title [start]
    2.74 +  (->> start
    2.75 +       scroll-text
    2.76 +       scroll-text
    2.77 +       scroll-text
    2.78 +       scroll-text
    2.79 +       scroll-text
    2.80 +       scroll-text
    2.81 +       scroll-text))
    2.82  
    2.83 +(defn-memo intro []
    2.84 +  (-> (start) title oak name-entry rival-name-entry finish-title))
    2.85 +
    2.86 +
    2.87 +;; TODO might be able to glue these together more elegantly with monads
    2.88 +