view clojure/com/aurellem/run/bootstrap_0.clj @ 260:11cfe6dcb803

script: defeated rival.
author Robert McIntyre <rlm@mit.edu>
date Mon, 26 Mar 2012 19:56:57 -0500
parents 2a46422902be
children 868783405ac2
line wrap: on
line source
1 (ns com.aurellem.run.bootstrap-0
2 (:use (com.aurellem.gb gb-driver vbm characters))
3 (:use (com.aurellem.run title save-corruption))
4 (:use (com.aurellem.exp item-bridge)))
7 (defn-memo boot-root []
8 [ [] (root)])
10 (defn-memo to-rival-name
11 ([] (to-rival-name (boot-root)))
12 ([script]
13 (-> script
14 title
15 oak
16 name-entry-rlm
17 scroll-text
18 scroll-text
19 scroll-text
20 scroll-text
21 scroll-text
22 )))
24 (defn-memo name-rival-bootstrap
25 ([] (name-rival-bootstrap (to-rival-name)))
26 ([script]
27 (->> script
28 (advance [] [:a])
29 (advance [] [:r] DE)
30 (play-moves
31 [[]
32 [:r] [] [:r] [] [:r] [] [:r] []
33 [:r] [] [:r] [] [:r] [] [:d] []
34 [:d] [:a] ;; space
35 [:l] [] [:d] [:a] ;; [PK]
36 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
37 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
38 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
39 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
41 [:d] [] [:r] [:a] ;; finish
42 ]))))
44 (defn walk
45 "Move the character along the given directions."
46 [directions script]
47 (reduce (fn [script direction]
48 (move direction script))
49 script directions))
51 (def ↑ [:u])
52 (def ↓ [:d])
53 (def ← [:l])
54 (def → [:r])
56 (defn-memo leave-house
57 ([] (leave-house (name-rival-bootstrap)))
58 ([script]
59 (->> script
60 finish-title
61 start-walking
62 walk-to-stairs
63 walk-to-door
64 (walk [↓ ↓]))))
66 (defn-memo to-pallet-town-edge
67 ([] (to-pallet-town-edge (leave-house)))
68 ([script]
69 (->> script
70 start-walking
71 (walk [→ → → → →
72 ↑ ↑ ↑ ↑ ↑ ↑]))))
74 (defn end-text [script]
75 (->> script
76 (scroll-text)
77 (play-moves [[] [:a]])))
79 (defn-memo start-pikachu-battle
80 ([] (start-pikachu-battle
81 (to-pallet-town-edge)))
82 ([script]
83 (->> script
84 (advance [:b] [:b :a] DE)
85 (scroll-text)
86 (play-moves [[:b]])
87 (scroll-text)
88 (end-text) ;; battle begins
89 (scroll-text))))
91 (defn-memo capture-pikachu
92 ([] (capture-pikachu (start-pikachu-battle)))
93 ([script]
94 (->> script
95 (scroll-text 2)
96 (end-text))))
98 (defn-memo go-to-lab
99 ([] (go-to-lab (capture-pikachu)))
100 ([script]
101 (->> script
102 (scroll-text 5)
103 (end-text)
104 (scroll-text)
105 (end-text)
106 (scroll-text 8)
107 (end-text)
108 (scroll-text)
109 (end-text))))
111 (defn-memo obtain-pikachu
112 ([] (obtain-pikachu (go-to-lab)))
113 ([script]
114 (->> script
115 (scroll-text)
116 (play-moves
117 (concat
118 (repeat 51 [])
119 [[:a] []]))
120 (walk [↓ ↓ → → ↑])
121 (play-moves
122 (concat [[] [:a]]
123 (repeat 100 [])))
124 (scroll-text 9)
125 (end-text)
126 (scroll-text 7)
128 (play-moves
129 (concat
130 (repeat 42 [])
131 [[:b] [:b] [:b] [:b]])))))
133 (defn-memo begin-battle-with-rival
134 ([] (begin-battle-with-rival
135 (obtain-pikachu)))
136 ([script]
137 (->> script
138 (walk [↓ ↓ ↓ ↓])
139 (scroll-text 3)
140 (end-text)
141 (scroll-text))))
143 (defn search-string
144 [array string]
145 (let [codes
146 (str->character-codes string)
147 codes-length (count codes)
148 mem (vec array)
149 mem-length (count mem)]
150 (loop [idx 0]
151 (if (< (- mem-length idx) codes-length)
152 nil
153 (if (= (subvec mem idx (+ idx codes-length))
154 codes)
155 idx
156 (recur (inc idx)))))))
158 (defn critical-hit
159 "Put the cursor over the desired attack. This program will
160 determine the appropriate amount of blank frames to
161 insert before pressing [:a] to ensure that the attack is
162 a critical hit."
163 [script]
164 (loop [blanks 6]
165 (let [new-script
166 (->> script
167 (play-moves
168 (concat (repeat blanks [])
169 [[:a][]])))]
170 (if (let [future-state
171 (run-moves (second new-script)
172 (repeat 400 []))
174 result (search-string (memory future-state)
175 "Critical")]
176 (if result
177 (println "critical hit with" blanks "blank frames"))
178 result)
179 new-script
180 (recur (inc blanks))))))
182 (defn-memo battle-with-rival
183 ([] (battle-with-rival
184 (begin-battle-with-rival)))
185 ([script]
186 (->> script
187 (play-moves (repeat 381 []))
188 (play-moves [[:a]])
189 (critical-hit)
190 (play-moves (repeat 100 []))
191 (scroll-text)
192 (play-moves
193 (concat (repeat 275 []) [[:a]]))
194 (critical-hit)
195 (play-moves (repeat 100 []))
196 (scroll-text)
197 (play-moves
198 (concat (repeat 270 []) [[:a]]))
199 (play-moves [[][][][][][][][][:a]]))))
201 (defn-memo finish-rival-text
202 ([] (finish-rival-text
203 (battle-with-rival)))
204 ([script]
205 (->> script
206 (scroll-text 2)
207 (end-text)
208 (scroll-text 9)
209 (end-text))))