Mercurial > vba-clojure
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 +