diff clojure/com/aurellem/title2.clj @ 85:3f4fdd270059

more progress with the title
author Robert McIntyre <rlm@mit.edu>
date Sat, 10 Mar 2012 00:32:11 -0600
parents 26f002f2868c
children 9864032ef3c8
line wrap: on
line diff
     1.1 --- a/clojure/com/aurellem/title2.clj	Fri Mar 09 23:28:07 2012 -0600
     1.2 +++ b/clojure/com/aurellem/title2.clj	Sat Mar 10 00:32:11 2012 -0600
     1.3 @@ -12,36 +12,60 @@
     1.4          [(conj actions alt) alt-branch]
     1.5          (recur base-branch (conj actions base))))))
     1.6  
     1.7 +(defn advance
     1.8 +  ([base alt summary [commands state]]
     1.9 +     (let [[c s] (first-difference base alt summary state)]
    1.10 +       [(concat commands c) s]))
    1.11 +  ([base alt [commands state]]
    1.12 +     (advance base alt AF [commands state]))
    1.13 +  ([alt [commands state]]
    1.14 +     (advance [] alt [commands state])))
    1.15 +
    1.16 +(def scroll-text (partial advance [:b] [:a :b]))
    1.17 +
    1.18  (defn title []
    1.19 -  (let [[c-1 s-1] (first-difference [] [:a] AF (root))
    1.20 -        [c-2 s-2] (first-difference [] [:start] AF s-1)
    1.21 -        [c-3 s-3] (first-difference [] [:a] AF s-2)
    1.22 -        [c-4 s-4] (first-difference [] [:start] AF s-3)]
    1.23 -    [(concat c-1 c-2 c-3 c-3 c-4) s-4]))
    1.24 +  (->> [[] (root)]
    1.25 +       (advance [] [:a])
    1.26 +       (advance [] [:start])
    1.27 +       (advance [] [:a])
    1.28 +       (advance [] [:start])))
    1.29  
    1.30 -(def menu-end (second (title)))
    1.31 -
    1.32 -(defn scroll-text [[commands state]]
    1.33 -  (let [[c s] (first-difference [:b] [:a :b] AF state)]
    1.34 -    [(concat commands c) s]))
    1.35 +(def title-end (second (title)))
    1.36  
    1.37  (defn oak []
    1.38 -  (-> [[] menu-end]
    1.39 -      scroll-text
    1.40 -      scroll-text
    1.41 -      scroll-text
    1.42 -      scroll-text
    1.43 -      scroll-text
    1.44 -      scroll-text
    1.45 -      scroll-text
    1.46 -      scroll-text
    1.47 -      scroll-text
    1.48 -      scroll-text
    1.49 -      scroll-text
    1.50 -      scroll-text
    1.51 -      scroll-text))
    1.52 +  (->> [[] title-end]
    1.53 +       scroll-text
    1.54 +       scroll-text
    1.55 +       scroll-text
    1.56 +       scroll-text
    1.57 +       scroll-text
    1.58 +       scroll-text
    1.59 +       scroll-text
    1.60 +       scroll-text
    1.61 +       scroll-text
    1.62 +       scroll-text
    1.63 +       scroll-text
    1.64 +       scroll-text
    1.65 +       scroll-text
    1.66 +       (advance [] [:a])))
    1.67 +
    1.68 +;; looks like it might need a monad here if this pattern continues
    1.69  
    1.70  (def oak-end (second (oak)))
    1.71 -  
    1.72 +           
    1.73 +(defn name-entry []
    1.74 +  (->> [[] oak-end]
    1.75 +       (advance [] [:r] DE)
    1.76 +       ((fn [[moves state]]
    1.77 +          (play-moves
    1.78 +           state
    1.79 +            [[]
    1.80 +             [:r] [] [:r] [] [:r] [] [:r] []
    1.81 +             [:r] [] [:r] [] [:r] [] [:d] [:a]  
    1.82 +             [:l] [] [:l] [] [:l] [] [:l] []
    1.83 +             [:l] [] [:l] [:a] [] [:r] [:a]
    1.84 +             [:r] [] [:r] [] [:r] [] [:r] []
    1.85 +             [:r] [] [:d] [] [:d] [] [:d] [:a]
    1.86 +             ])))))
    1.87 +          
    1.88  
    1.89 -;; looks like it might need a monad here if this pattern continues
    1.90 \ No newline at end of file