Mercurial > vba-clojure

     1 (ns com.aurellem.title2

     2   (:use (com.aurellem gb-funs vbm)))

     3 

     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))))))

    14 

    15 (defn advance

    16   ([base alt summary [commands state]]

    17      (let [[c s] (first-difference base alt summary state)]

    18        [(concat commands c) s]))

    19   ([base alt [commands state]]

    20      (advance base alt AF [commands state]))

    21   ([alt [commands state]]

    22      (advance [] alt [commands state])))

    23 

    24 (def scroll-text (partial advance [:b] [:a :b]))

    25 

    26 (defn title []

    27   (->> [[] (root)]

    28        (advance [] [:a])

    29        (advance [] [:start])

    30        (advance [] [:a])

    31        (advance [] [:start])))

    32 

    33 (def title-end (second (title)))

    34 

    35 (defn oak []

    36   (->> [[] title-end]

    37        scroll-text

    38        scroll-text

    39        scroll-text

    40        scroll-text

    41        scroll-text

    42        scroll-text

    43        scroll-text

    44        scroll-text

    45        scroll-text

    46        scroll-text

    47        scroll-text

    48        scroll-text

    49        scroll-text

    50        (advance [] [:a])))

    51 

    52 ;; looks like it might need a monad here if this pattern continues

    53 

    54 (def oak-end (second (oak)))

    55            

    56 (defn name-entry []

    57   (->> [[] oak-end]

    58        (advance [] [:r] DE)

    59        ((fn [[moves state]]

    60           (play-moves

    61            state

    62             [[]

    63              [:r] [] [:r] [] [:r] [] [:r] []

    64              [:r] [] [:r] [] [:r] [] [:d] [:a]  

    65              [:l] [] [:l] [] [:l] [] [:l] []

    66              [:l] [] [:l] [:a] [] [:r] [:a]

    67              [:r] [] [:r] [] [:r] [] [:r] []

    68              [:r] [] [:d] [] [:d] [] [:d] [:a]

    69              ])))))

    70           

    71
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 10 Mar 2012 00:32:11 -0600
parents	26f002f2868c
children	9864032ef3c8