view clojure/com/aurellem/title2.clj @ 84:26f002f2868c

better functional version of earlier code
author Robert McIntyre <rlm@mit.edu>
date Fri, 09 Mar 2012 23:28:07 -0600
parents
children 3f4fdd270059
line wrap: on
line source
1 (ns com.aurellem.title2
2 (:use (com.aurellem gb-funs vbm)))
4 (defn first-difference [base alt summary root]
5 (loop [branch-point root
6 actions []]
7 (let [base-branch (step branch-point base)
8 base-val (summary base-branch)
9 alt-branch (step branch-point alt)
10 alt-val (summary alt-branch)]
11 (if (not= base-val alt-val)
12 [(conj actions alt) alt-branch]
13 (recur base-branch (conj actions base))))))
15 (defn title []
16 (let [[c-1 s-1] (first-difference [] [:a] AF (root))
17 [c-2 s-2] (first-difference [] [:start] AF s-1)
18 [c-3 s-3] (first-difference [] [:a] AF s-2)
19 [c-4 s-4] (first-difference [] [:start] AF s-3)]
20 [(concat c-1 c-2 c-3 c-3 c-4) s-4]))
22 (def menu-end (second (title)))
24 (defn scroll-text [[commands state]]
25 (let [[c s] (first-difference [:b] [:a :b] AF state)]
26 [(concat commands c) s]))
28 (defn oak []
29 (-> [[] menu-end]
30 scroll-text
31 scroll-text
32 scroll-text
33 scroll-text
34 scroll-text
35 scroll-text
36 scroll-text
37 scroll-text
38 scroll-text
39 scroll-text
40 scroll-text
41 scroll-text
42 scroll-text))
44 (def oak-end (second (oak)))
47 ;; looks like it might need a monad here if this pattern continues