vba-clojure: clojure/com/aurellem/title2.clj annotate

better functional version of earlier code

rev	line source
rlm@84	1 (ns com.aurellem.title2
rlm@84	2 (:use (com.aurellem gb-funs vbm)))
rlm@84	3
rlm@84	4 (defn first-difference [base alt summary root]
rlm@84	5 (loop [branch-point root
rlm@84	6 actions []]
rlm@84	7 (let [base-branch (step branch-point base)
rlm@84	8 base-val (summary base-branch)
rlm@84	9 alt-branch (step branch-point alt)
rlm@84	10 alt-val (summary alt-branch)]
rlm@84	11 (if (not= base-val alt-val)
rlm@84	12 [(conj actions alt) alt-branch]
rlm@84	13 (recur base-branch (conj actions base))))))
rlm@84	14
rlm@84	15 (defn title []
rlm@84	16 (let [[c-1 s-1] (first-difference [] [:a] AF (root))
rlm@84	17 [c-2 s-2] (first-difference [] [:start] AF s-1)
rlm@84	18 [c-3 s-3] (first-difference [] [:a] AF s-2)
rlm@84	19 [c-4 s-4] (first-difference [] [:start] AF s-3)]
rlm@84	20 [(concat c-1 c-2 c-3 c-3 c-4) s-4]))
rlm@84	21
rlm@84	22 (def menu-end (second (title)))
rlm@84	23
rlm@84	24 (defn scroll-text [[commands state]]
rlm@84	25 (let [[c s] (first-difference [:b] [:a :b] AF state)]
rlm@84	26 [(concat commands c) s]))
rlm@84	27
rlm@84	28 (defn oak []
rlm@84	29 (-> [[] menu-end]
rlm@84	30 scroll-text
rlm@84	31 scroll-text
rlm@84	32 scroll-text
rlm@84	33 scroll-text
rlm@84	34 scroll-text
rlm@84	35 scroll-text
rlm@84	36 scroll-text
rlm@84	37 scroll-text
rlm@84	38 scroll-text
rlm@84	39 scroll-text
rlm@84	40 scroll-text
rlm@84	41 scroll-text
rlm@84	42 scroll-text))
rlm@84	43
rlm@84	44 (def oak-end (second (oak)))
rlm@84	45
rlm@84	46
rlm@84	47 ;; looks like it might need a monad here if this pattern continues

Mercurial > vba-clojure