Mercurial > vba-clojure

     1 (ns com.aurellem.run.title

     2   (:use (com.aurellem.gb gb-driver 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 start [] [[] (root)])

    27 

    28 (defn-memo title

    29   ([] (title (start)))

    30   ([script]

    31      (->> script

    32           (advance [] [:a])

    33           (advance [] [:start])

    34           (advance [] [:a])

    35           (advance [] [:start]))))

    36 

    37 (defn-memo oak

    38   ([] (oak (title)))

    39   ([script]

    40      (->> script

    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           scroll-text

    51           scroll-text

    52           scroll-text

    53           scroll-text)))

    54 

    55 (defn-memo name-entry-rlm

    56   ([] (name-entry-rlm (oak)))

    57   ([script]

    58      (->> script

    59           (advance [] [:a])

    60           (advance [] [:r] DE)

    61           (play-moves

    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 (defn-memo name-entry-ash

    71   ([] (name-entry-ash (oak)))

    72   ([script]

    73      (->> script

    74           (advance [] [:d])

    75           (advance [] [:d])

    76           (advance [] [:a]))))

    77        

    78 (defn-memo rival-name-entry-gary

    79   ([] (rival-name-entry-gary (name-entry-ash)))

    80   ([script]

    81      (->> script

    82           scroll-text

    83           scroll-text

    84           scroll-text

    85           scroll-text

    86           scroll-text

    87           (advance [] [:d])

    88           (advance [] [:d])

    89           (advance [] [:a]))))

    90   

    91 (defn-memo rival-name-entry-blue

    92   ([] (rival-name-entry-blue (name-entry-ash)))

    93   ([script]

    94      (->> script

    95           scroll-text

    96           scroll-text

    97           scroll-text

    98           scroll-text

    99           scroll-text

   100           (advance [] [:d])

   101           (advance [] [:a]))))

   102 

   103 (defn-memo finish-title

   104   ([] (finish-title (rival-name-entry-blue)))

   105   ([script]

   106      (->> script

   107           scroll-text

   108           scroll-text

   109           scroll-text

   110           scroll-text

   111           scroll-text

   112           scroll-text

   113           scroll-text)))

   114 

   115 (def title-frames 2194)

   116 

   117 (defn title-checkpoint! []

   118   (let [[moves state] (finish-title)]

   119     (assert (= title-frames (count moves)))

   120     [(write-moves! moves "title-checkpoint")

   121      (write-state! state "title-checkpoint")]))

   122 

   123 (defn intro []

   124   [(read-moves "title-checkpoint")

   125    (read-state "title-checkpoint")])

   126 

   127 (defn test-intro []

   128   (play-vbm (moves->filename title-frames)))

   129 

   130 ;; TODO might be able to glue these together more elegantly with monads

   131
author	Robert McIntyre <rlm@mit.edu>
date	Mon, 26 Mar 2012 03:49:33 -0500
parents	09caf6a5bbf4
children	5dafe6188ca5