view clojure/com/aurellem/run/title.clj @ 303:5bcda2d6d135

item manipulation program works!
author Robert McIntyre <rlm@mit.edu>
date Sat, 31 Mar 2012 00:33:35 -0500
parents c7b002525041
children 8e63b0bb8ea3
line wrap: on
line source
1 (ns com.aurellem.run.title
2 (:use (com.aurellem.gb gb-driver 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 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])))
24 (defn scroll-text
25 ([script]
26 (advance [:b] [:a :b] script))
27 ([n script]
28 (reduce (fn [script _]
29 (scroll-text script))
30 script
31 (range n))))
33 (defn start [] [[] (root)])
35 (defn-memo title
36 ([] (title (start)))
37 ([script]
38 (->> script
39 (advance [] [:a])
40 (advance [] [:start])
41 (advance [] [:a])
42 (advance [] [:start]))))
44 (defn-memo oak
45 ([] (oak (title)))
46 ([script]
47 (->> script
48 (scroll-text 13))))
50 (defn-memo name-entry-rlm
51 ([] (name-entry-rlm (oak)))
52 ([script]
53 (->> script
54 (advance [] [:a])
55 (advance [] [:r] DE)
56 (play-moves
57 [[]
58 [:r] [] [:r] [] [:r] [] [:r] []
59 [:r] [] [:r] [] [:r] [] [:d] [:a]
60 [:l] [] [:l] [] [:l] [] [:l] []
61 [:l] [] [:l] [:a] [] [:r] [:a]
62 [:r] [] [:r] [] [:r] [] [:r] []
63 [:r] [] [:d] [] [:d] [] [:d] [:a]]))))
65 (defn-memo name-entry-ash
66 ([] (name-entry-ash (oak)))
67 ([script]
68 (->> script
69 (advance [] [:d])
70 (advance [] [:d])
71 (advance [] [:a]))))
73 (defn-memo rival-name-entry-gary
74 ([] (rival-name-entry-gary (name-entry-ash)))
75 ([script]
76 (->> script
77 (scroll-text 5)
78 (advance [] [:d])
79 (advance [] [:d])
80 (advance [] [:a]))))
82 (defn-memo rival-name-entry-blue
83 ([] (rival-name-entry-blue (name-entry-ash)))
84 ([script]
85 (->> script
86 (scroll-text 5)
87 (advance [] [:d])
88 (advance [] [:a]))))
90 (defn-memo finish-title
91 ([] (finish-title (rival-name-entry-blue)))
92 ([script]
93 (->> script
94 (scroll-text 7))))
96 (def title-frames 2194)
98 (defn title-checkpoint! []
99 (let [[moves state] (finish-title)]
100 (assert (= title-frames (count moves)))
101 [(write-moves! moves "title-checkpoint")
102 (write-state! state "title-checkpoint")]))
104 (defn intro []
105 [(read-moves "title-checkpoint")
106 (read-state "title-checkpoint")])
108 (defn test-intro []
109 (play-vbm (moves-filename "title-checkpoint")))
111 ;; TODO might be able to glue these together more elegantly with monads