Mercurial > vba-clojure

     1 (ns com.aurellem.run.title

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

     3 

     4 

     5 (defn start [] [[] (root)])

     6 

     7 (defn-memo title

     8   ([] (title (start)))

     9   ([script]

    10      (->> script

    11           (advance [] [:a])

    12           (advance [] [:start])

    13           (advance [] [:a])

    14           (advance [] [:start]))))

    15 

    16 (defn-memo oak

    17   ([] (oak (title)))

    18   ([script]

    19      (->> script

    20           (scroll-text 13))))

    21 

    22 (defn-memo name-entry-rlm

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

    24   ([script]

    25      (->> script

    26           (advance [] [:a])

    27           (advance [] [:r] DE)

    28           (play-moves

    29            [[]

    30             [:r] [] [:r] [] [:r] [] [:r] []

    31             [:r] [] [:r] [] [:r] [] [:d] [:a]  

    32             [:l] [] [:l] [] [:l] [] [:l] []

    33             [:l] [] [:l] [:a] [] [:r] [:a]

    34             [:r] [] [:r] [] [:r] [] [:r] []

    35             [:r] [] [:d] [] [:d] [] [:d] [:a]]))))

    36 

    37 (defn-memo name-entry-ash

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

    39   ([script]

    40      (->> script

    41           (advance [] [:d])

    42           (advance [] [:d])

    43           (advance [] [:a]))))

    44        

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

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

    47   ([script]

    48      (->> script

    49           (scroll-text 5)

    50           (advance [] [:d])

    51           (advance [] [:d])

    52           (advance [] [:a]))))

    53   

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

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

    56   ([script]

    57      (->> script

    58           (scroll-text 5)

    59           (advance [] [:d])

    60           (advance [] [:a]))))

    61 

    62 (defn-memo finish-title

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

    64   ([script]

    65      (->> script

    66           (scroll-text 7))))

    67           

    68 (def title-frames 2194)

    69 

    70 (defn title-checkpoint! []

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

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

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

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

    75 

    76 (defn intro []

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

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

    79 

    80 (defn test-intro []

    81   (play-vbm (moves-filename "title-checkpoint")))

    82 

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

    84
author	Robert McIntyre <rlm@mit.edu>
date	Mon, 02 Apr 2012 10:58:16 -0500
parents	c7b002525041
children	9a4d3f801c89