rlm@247
|
1 (ns com.aurellem.run.bootstrap-0
|
rlm@260
|
2 (:use (com.aurellem.gb gb-driver vbm characters))
|
rlm@250
|
3 (:use (com.aurellem.run title save-corruption))
|
rlm@264
|
4 (:use (com.aurellem.exp item-bridge))
|
rlm@264
|
5 (:import [com.aurellem.gb.gb_driver SaveState]))
|
rlm@247
|
6
|
rlm@250
|
7 (defn-memo boot-root []
|
rlm@255
|
8 [ [] (root)])
|
rlm@247
|
9
|
rlm@255
|
10 (defn-memo to-rival-name
|
rlm@255
|
11 ([] (to-rival-name (boot-root)))
|
rlm@255
|
12 ([script]
|
rlm@255
|
13 (-> script
|
rlm@255
|
14 title
|
rlm@255
|
15 oak
|
rlm@255
|
16 name-entry-rlm
|
rlm@255
|
17 scroll-text
|
rlm@255
|
18 scroll-text
|
rlm@255
|
19 scroll-text
|
rlm@255
|
20 scroll-text
|
rlm@274
|
21 scroll-text)))
|
rlm@247
|
22
|
rlm@255
|
23 (defn-memo name-rival-bootstrap
|
rlm@255
|
24 ([] (name-rival-bootstrap (to-rival-name)))
|
rlm@255
|
25 ([script]
|
rlm@255
|
26 (->> script
|
rlm@255
|
27 (advance [] [:a])
|
rlm@255
|
28 (advance [] [:r] DE)
|
rlm@255
|
29 (play-moves
|
rlm@255
|
30 [[]
|
rlm@255
|
31 [:r] [] [:r] [] [:r] [] [:r] []
|
rlm@255
|
32 [:r] [] [:r] [] [:r] [] [:d] []
|
rlm@255
|
33 [:d] [:a] ;; space
|
rlm@255
|
34 [:l] [] [:d] [:a] ;; [PK]
|
rlm@255
|
35 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
|
rlm@255
|
36 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
|
rlm@255
|
37 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
|
rlm@255
|
38 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
|
rlm@247
|
39
|
rlm@255
|
40 [:d] [] [:r] [:a] ;; finish
|
rlm@255
|
41 ]))))
|
rlm@255
|
42
|
rlm@255
|
43 (defn walk
|
rlm@255
|
44 "Move the character along the given directions."
|
rlm@255
|
45 [directions script]
|
rlm@255
|
46 (reduce (fn [script direction]
|
rlm@255
|
47 (move direction script))
|
rlm@255
|
48 script directions))
|
rlm@255
|
49
|
rlm@255
|
50 (def ↑ [:u])
|
rlm@255
|
51 (def ↓ [:d])
|
rlm@255
|
52 (def ← [:l])
|
rlm@255
|
53 (def → [:r])
|
rlm@255
|
54
|
rlm@255
|
55 (defn-memo leave-house
|
rlm@255
|
56 ([] (leave-house (name-rival-bootstrap)))
|
rlm@255
|
57 ([script]
|
rlm@255
|
58 (->> script
|
rlm@255
|
59 finish-title
|
rlm@255
|
60 start-walking
|
rlm@255
|
61 walk-to-stairs
|
rlm@255
|
62 walk-to-door
|
rlm@255
|
63 (walk [↓ ↓]))))
|
rlm@255
|
64
|
rlm@255
|
65 (defn-memo to-pallet-town-edge
|
rlm@255
|
66 ([] (to-pallet-town-edge (leave-house)))
|
rlm@255
|
67 ([script]
|
rlm@255
|
68 (->> script
|
rlm@255
|
69 start-walking
|
rlm@255
|
70 (walk [→ → → → →
|
rlm@255
|
71 ↑ ↑ ↑ ↑ ↑ ↑]))))
|
rlm@255
|
72
|
rlm@257
|
73 (defn end-text [script]
|
rlm@257
|
74 (->> script
|
rlm@257
|
75 (scroll-text)
|
rlm@257
|
76 (play-moves [[] [:a]])))
|
rlm@257
|
77
|
rlm@257
|
78 (defn-memo start-pikachu-battle
|
rlm@257
|
79 ([] (start-pikachu-battle
|
rlm@257
|
80 (to-pallet-town-edge)))
|
rlm@257
|
81 ([script]
|
rlm@257
|
82 (->> script
|
rlm@257
|
83 (advance [:b] [:b :a] DE)
|
rlm@257
|
84 (scroll-text)
|
rlm@257
|
85 (play-moves [[:b]])
|
rlm@257
|
86 (scroll-text)
|
rlm@257
|
87 (end-text) ;; battle begins
|
rlm@257
|
88 (scroll-text))))
|
rlm@257
|
89
|
rlm@257
|
90 (defn-memo capture-pikachu
|
rlm@257
|
91 ([] (capture-pikachu (start-pikachu-battle)))
|
rlm@257
|
92 ([script]
|
rlm@257
|
93 (->> script
|
rlm@257
|
94 (scroll-text 2)
|
rlm@257
|
95 (end-text))))
|
rlm@257
|
96
|
rlm@257
|
97 (defn-memo go-to-lab
|
rlm@257
|
98 ([] (go-to-lab (capture-pikachu)))
|
rlm@257
|
99 ([script]
|
rlm@257
|
100 (->> script
|
rlm@257
|
101 (scroll-text 5)
|
rlm@257
|
102 (end-text)
|
rlm@257
|
103 (scroll-text)
|
rlm@257
|
104 (end-text)
|
rlm@257
|
105 (scroll-text 8)
|
rlm@257
|
106 (end-text)
|
rlm@257
|
107 (scroll-text)
|
rlm@257
|
108 (end-text))))
|
rlm@257
|
109
|
rlm@257
|
110 (defn-memo obtain-pikachu
|
rlm@257
|
111 ([] (obtain-pikachu (go-to-lab)))
|
rlm@257
|
112 ([script]
|
rlm@257
|
113 (->> script
|
rlm@257
|
114 (scroll-text)
|
rlm@257
|
115 (play-moves
|
rlm@257
|
116 (concat
|
rlm@257
|
117 (repeat 51 [])
|
rlm@257
|
118 [[:a] []]))
|
rlm@257
|
119 (walk [↓ ↓ → → ↑])
|
rlm@258
|
120 (play-moves
|
rlm@258
|
121 (concat [[] [:a]]
|
rlm@258
|
122 (repeat 100 [])))
|
rlm@258
|
123 (scroll-text 9)
|
rlm@258
|
124 (end-text)
|
rlm@258
|
125 (scroll-text 7)
|
rlm@258
|
126
|
rlm@258
|
127 (play-moves
|
rlm@258
|
128 (concat
|
rlm@258
|
129 (repeat 42 [])
|
rlm@260
|
130 [[:b] [:b] [:b] [:b]])))))
|
rlm@258
|
131
|
rlm@258
|
132 (defn-memo begin-battle-with-rival
|
rlm@258
|
133 ([] (begin-battle-with-rival
|
rlm@258
|
134 (obtain-pikachu)))
|
rlm@258
|
135 ([script]
|
rlm@258
|
136 (->> script
|
rlm@260
|
137 (walk [↓ ↓ ↓ ↓])
|
rlm@260
|
138 (scroll-text 3)
|
rlm@260
|
139 (end-text)
|
rlm@260
|
140 (scroll-text))))
|
rlm@260
|
141
|
rlm@260
|
142 (defn search-string
|
rlm@260
|
143 [array string]
|
rlm@260
|
144 (let [codes
|
rlm@260
|
145 (str->character-codes string)
|
rlm@260
|
146 codes-length (count codes)
|
rlm@260
|
147 mem (vec array)
|
rlm@260
|
148 mem-length (count mem)]
|
rlm@260
|
149 (loop [idx 0]
|
rlm@260
|
150 (if (< (- mem-length idx) codes-length)
|
rlm@260
|
151 nil
|
rlm@260
|
152 (if (= (subvec mem idx (+ idx codes-length))
|
rlm@260
|
153 codes)
|
rlm@260
|
154 idx
|
rlm@260
|
155 (recur (inc idx)))))))
|
rlm@260
|
156
|
rlm@260
|
157 (defn critical-hit
|
rlm@260
|
158 "Put the cursor over the desired attack. This program will
|
rlm@260
|
159 determine the appropriate amount of blank frames to
|
rlm@260
|
160 insert before pressing [:a] to ensure that the attack is
|
rlm@260
|
161 a critical hit."
|
rlm@260
|
162 [script]
|
rlm@260
|
163 (loop [blanks 6]
|
rlm@260
|
164 (let [new-script
|
rlm@260
|
165 (->> script
|
rlm@260
|
166 (play-moves
|
rlm@260
|
167 (concat (repeat blanks [])
|
rlm@260
|
168 [[:a][]])))]
|
rlm@260
|
169 (if (let [future-state
|
rlm@260
|
170 (run-moves (second new-script)
|
rlm@260
|
171 (repeat 400 []))
|
rlm@260
|
172
|
rlm@260
|
173 result (search-string (memory future-state)
|
rlm@260
|
174 "Critical")]
|
rlm@260
|
175 (if result
|
rlm@260
|
176 (println "critical hit with" blanks "blank frames"))
|
rlm@260
|
177 result)
|
rlm@260
|
178 new-script
|
rlm@260
|
179 (recur (inc blanks))))))
|
rlm@260
|
180
|
rlm@260
|
181 (defn-memo battle-with-rival
|
rlm@260
|
182 ([] (battle-with-rival
|
rlm@260
|
183 (begin-battle-with-rival)))
|
rlm@260
|
184 ([script]
|
rlm@260
|
185 (->> script
|
rlm@260
|
186 (play-moves (repeat 381 []))
|
rlm@260
|
187 (play-moves [[:a]])
|
rlm@260
|
188 (critical-hit)
|
rlm@260
|
189 (play-moves (repeat 100 []))
|
rlm@260
|
190 (scroll-text)
|
rlm@258
|
191 (play-moves
|
rlm@260
|
192 (concat (repeat 275 []) [[:a]]))
|
rlm@260
|
193 (critical-hit)
|
rlm@260
|
194 (play-moves (repeat 100 []))
|
rlm@260
|
195 (scroll-text)
|
rlm@258
|
196 (play-moves
|
rlm@260
|
197 (concat (repeat 270 []) [[:a]]))
|
rlm@260
|
198 (play-moves [[][][][][][][][][:a]]))))
|
rlm@260
|
199
|
rlm@260
|
200 (defn-memo finish-rival-text
|
rlm@260
|
201 ([] (finish-rival-text
|
rlm@260
|
202 (battle-with-rival)))
|
rlm@260
|
203 ([script]
|
rlm@260
|
204 (->> script
|
rlm@260
|
205 (scroll-text 2)
|
rlm@260
|
206 (end-text)
|
rlm@260
|
207 (scroll-text 9)
|
rlm@260
|
208 (end-text))))
|
rlm@260
|
209
|
rlm@262
|
210 (defn do-nothing [n script]
|
rlm@262
|
211 (->> script
|
rlm@262
|
212 (play-moves
|
rlm@262
|
213 (repeat n []))))
|
rlm@260
|
214
|
rlm@262
|
215 (defn-memo pikachu-comes-out
|
rlm@262
|
216 ([] (pikachu-comes-out
|
rlm@262
|
217 (finish-rival-text)))
|
rlm@262
|
218 ([script]
|
rlm@262
|
219 (->> script
|
rlm@262
|
220 (do-nothing 177)
|
rlm@262
|
221 (end-text)
|
rlm@262
|
222 (scroll-text 7)
|
rlm@262
|
223 (end-text))))
|
rlm@260
|
224
|
rlm@262
|
225 (defn-memo leave-oaks-lab
|
rlm@262
|
226 ([] (leave-oaks-lab
|
rlm@262
|
227 (pikachu-comes-out)))
|
rlm@262
|
228 ([script]
|
rlm@262
|
229 (->> script
|
rlm@262
|
230 (walk [← ← ↓ ↓ ↓ ↓ ↓ ↓]))))
|
rlm@257
|
231
|
rlm@271
|
232 (defn-memo oaks-lab->pallet-town-edge
|
rlm@262
|
233 ([] (oaks-lab->pallet-town-edge
|
rlm@262
|
234 (leave-oaks-lab)))
|
rlm@262
|
235 ([script]
|
rlm@262
|
236 (->> script
|
rlm@262
|
237 (walk [← ← ← ←
|
rlm@262
|
238 ↑ ↑ ↑ ↑
|
rlm@262
|
239 ↑ ↑ ↑ ↑ ↑ ↑
|
rlm@262
|
240 → ↑]))))
|
rlm@264
|
241
|
rlm@264
|
242 (defn move-thru-grass
|
rlm@264
|
243 [direction script]
|
rlm@264
|
244 (loop [blanks 0]
|
rlm@264
|
245 (let [new-script
|
rlm@264
|
246 (->> script
|
rlm@264
|
247 (play-moves (repeat blanks []))
|
rlm@264
|
248 (move direction))
|
rlm@264
|
249
|
rlm@264
|
250 future-state
|
rlm@264
|
251 (run-moves (second new-script)
|
rlm@264
|
252 (repeat 600 []))
|
rlm@264
|
253
|
rlm@264
|
254 result (search-string (memory future-state)
|
rlm@264
|
255 "Wild")]
|
rlm@264
|
256 (if (nil? result)
|
rlm@264
|
257 new-script
|
rlm@264
|
258 (recur (inc blanks))))))
|
rlm@264
|
259
|
rlm@264
|
260 (defn walk-thru-grass
|
rlm@264
|
261 [directions script]
|
rlm@264
|
262 (reduce (fn [script direction]
|
rlm@264
|
263 (move-thru-grass direction script))
|
rlm@264
|
264 script directions))
|
rlm@264
|
265
|
rlm@264
|
266 (defn-memo pallet-edge->viridian-mart
|
rlm@271
|
267 ([] (pallet-edge->viridian-mart true
|
rlm@264
|
268 (oaks-lab->pallet-town-edge)))
|
rlm@271
|
269 ([dodge-stupid-guy? script]
|
rlm@271
|
270 (let [dodge-1 (if dodge-stupid-guy?
|
rlm@271
|
271 [→ →]
|
rlm@271
|
272 [→])
|
rlm@271
|
273 dodge-2 (if dodge-stupid-guy?
|
rlm@271
|
274 [↑ ↑ ←]
|
rlm@271
|
275 [↑ ↑ ←])]
|
rlm@271
|
276
|
rlm@271
|
277 (->> script
|
rlm@264
|
278 ;; leave straight grass
|
rlm@264
|
279 (walk-thru-grass
|
rlm@264
|
280 [↑ ↑ ↑ ↑ ↑])
|
rlm@264
|
281
|
rlm@264
|
282 (walk [↑ ↑ ↑ ↑])
|
rlm@264
|
283
|
rlm@264
|
284 (walk-thru-grass
|
rlm@264
|
285 [← ← ↑])
|
rlm@264
|
286 (walk [↑ ↑ ↑ ↑ → → → ])
|
rlm@264
|
287
|
rlm@264
|
288 (walk-thru-grass
|
rlm@264
|
289 [→ ↑ ↑ ←])
|
rlm@264
|
290
|
rlm@264
|
291 (walk
|
rlm@264
|
292 [← ←
|
rlm@264
|
293 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
|
rlm@264
|
294 → → → → ])
|
rlm@264
|
295
|
rlm@271
|
296 ;; this part is dependent on that
|
rlm@266
|
297 ;; stupid NPC in the grass patch
|
rlm@264
|
298 (walk-thru-grass
|
rlm@271
|
299 (concat dodge-1
|
rlm@271
|
300 [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ]))
|
rlm@271
|
301
|
rlm@264
|
302 (walk
|
rlm@271
|
303 (concat
|
rlm@271
|
304 dodge-2
|
rlm@271
|
305 [← ← ←
|
rlm@271
|
306 ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
|
rlm@271
|
307 ← ←
|
rlm@271
|
308 ↑ ↑ ↑ ↑
|
rlm@271
|
309 → → → → → → → → → →
|
rlm@271
|
310 ↑ ↑ ↑ ↑ ↑ ↑ ↑]))))))
|
rlm@264
|
311
|
rlm@266
|
312 (defn-memo get-oaks-parcel
|
rlm@266
|
313 ([] (get-oaks-parcel
|
rlm@266
|
314 (pallet-edge->viridian-mart)))
|
rlm@266
|
315 ([script]
|
rlm@266
|
316 (->> script
|
rlm@266
|
317 (end-text)
|
rlm@266
|
318 (scroll-text 3)
|
rlm@266
|
319 (do-nothing 197)
|
rlm@266
|
320 (play-moves [[:a] []])
|
rlm@266
|
321 (walk [↓ ↓ → ↓]))))
|
rlm@266
|
322
|
rlm@269
|
323 (defn-memo viridian-store->oaks-lab
|
rlm@269
|
324 ([] (viridian-store->oaks-lab
|
rlm@269
|
325 (get-oaks-parcel)))
|
rlm@269
|
326 ([script]
|
rlm@269
|
327 (->> script
|
rlm@269
|
328 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
|
rlm@269
|
329 ← ← ← ← ← ← ← ← ← ←
|
rlm@269
|
330 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
|
rlm@269
|
331 ← ←
|
rlm@269
|
332 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
|
rlm@269
|
333 ↓ ↓ ↓ ↓ ↓ ↓ ↓
|
rlm@269
|
334 → → → → → → → →
|
rlm@269
|
335 ↓ ↓ ↓ ↓
|
rlm@269
|
336 ← ← ← ← ←
|
rlm@269
|
337 ↓ ↓ ↓ ↓])
|
rlm@266
|
338
|
rlm@269
|
339 (walk-thru-grass
|
rlm@269
|
340 [↓ ↓ ↓ ↓ ↓ ↓ ↓])
|
rlm@269
|
341
|
rlm@269
|
342 (walk [↓ ↓ ← ↓ ↓ ↓ ←
|
rlm@269
|
343 ↓ ↓ ↓ ↓ ↓
|
rlm@269
|
344 → → → ↑]))))
|
rlm@269
|
345
|
rlm@269
|
346 (defn-memo viridian-store->oaks-lab-like-a-boss
|
rlm@269
|
347 ([] (viridian-store->oaks-lab-like-a-boss
|
rlm@269
|
348 (get-oaks-parcel)))
|
rlm@269
|
349 ([script]
|
rlm@269
|
350 (->> script
|
rlm@269
|
351 (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
|
rlm@269
|
352 ← ← ← ← ← ← ← ← ← ←
|
rlm@269
|
353 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])
|
rlm@269
|
354
|
rlm@269
|
355 (walk-thru-grass
|
rlm@269
|
356 [↓ ↓ ↓ ↓ ↓])
|
rlm@269
|
357
|
rlm@269
|
358 (walk
|
rlm@269
|
359 [↓ ↓ ← ↓
|
rlm@269
|
360 ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
|
rlm@269
|
361 → →])
|
rlm@269
|
362
|
rlm@269
|
363 (walk-thru-grass
|
rlm@269
|
364 [→ ↓ ↓ ↓])
|
rlm@269
|
365
|
rlm@269
|
366 (walk [↓ ← ← ↓ ↓ ↓ ↓ ↓ ↓])
|
rlm@269
|
367
|
rlm@269
|
368 (walk-thru-grass
|
rlm@269
|
369 [↓ ↓ ↓ ↓ ↓ ↓ ↓])
|
rlm@269
|
370
|
rlm@269
|
371 (walk [↓ ↓ ← ↓ ↓ ↓ ←
|
rlm@269
|
372 ↓ ↓ ↓ ↓ ↓
|
rlm@269
|
373 → → → ↑]))))
|
rlm@270
|
374
|
rlm@270
|
375 (defn-memo deliver-oaks-parcel
|
rlm@270
|
376 ([] (deliver-oaks-parcel
|
rlm@270
|
377 (viridian-store->oaks-lab-like-a-boss)))
|
rlm@270
|
378 ([script]
|
rlm@270
|
379 (->> script
|
rlm@270
|
380 (walk [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
|
rlm@270
|
381 (play-moves [[:a]])
|
rlm@270
|
382 (scroll-text 11)
|
rlm@270
|
383 (end-text)
|
rlm@270
|
384 (end-text)
|
rlm@270
|
385 (do-nothing 200)
|
rlm@270
|
386 (end-text)
|
rlm@270
|
387 (scroll-text 3)
|
rlm@270
|
388 (end-text)
|
rlm@270
|
389 (scroll-text 2)
|
rlm@270
|
390 (end-text)
|
rlm@270
|
391 (scroll-text 5)
|
rlm@270
|
392 (end-text)
|
rlm@270
|
393 (scroll-text 2)
|
rlm@270
|
394 (end-text)
|
rlm@270
|
395 (scroll-text 9)
|
rlm@270
|
396 (end-text)
|
rlm@270
|
397 (scroll-text 7)
|
rlm@270
|
398 (end-text)
|
rlm@271
|
399 (walk [← ← ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓]))))
|
rlm@271
|
400
|
rlm@271
|
401 (defn-memo return-to-viridian-mart
|
rlm@271
|
402 ([] (return-to-viridian-mart
|
rlm@271
|
403 (deliver-oaks-parcel)))
|
rlm@271
|
404 ([script]
|
rlm@271
|
405 (->> script
|
rlm@271
|
406 oaks-lab->pallet-town-edge
|
rlm@274
|
407 (pallet-edge->viridian-mart false))))
|
rlm@274
|
408
|
rlm@274
|
409 (defn-memo walk-to-counter
|
rlm@274
|
410 ([] (walk-to-counter
|
rlm@274
|
411 (return-to-viridian-mart)))
|
rlm@274
|
412 ([script]
|
rlm@274
|
413 (->> script
|
rlm@274
|
414 (walk [↑ ↑ ← ←]))))
|
rlm@275
|
415
|
rlm@275
|
416 (defn buy-item
|
rlm@275
|
417 "Assumes that the main item-screen is up, and buys
|
rlm@275
|
418 quantity of the nth item in the list, assuming that you
|
rlm@275
|
419 have enough money."
|
rlm@275
|
420 [n quantity script]
|
rlm@275
|
421 (if (= 0 quantity)
|
rlm@275
|
422 script
|
rlm@275
|
423 (let [after-initial-pause
|
rlm@275
|
424 (do-nothing 20 script)
|
rlm@275
|
425 move-to-item
|
rlm@275
|
426 (reduce (fn [script _]
|
rlm@275
|
427 (->> script
|
rlm@275
|
428 (play-moves [[:d]])
|
rlm@275
|
429 (do-nothing 3)))
|
rlm@275
|
430 after-initial-pause
|
rlm@275
|
431 (range n))
|
rlm@275
|
432 select-item
|
rlm@275
|
433 (play-moves [[:a]] move-to-item)
|
rlm@275
|
434 request-items
|
rlm@275
|
435 (reduce (fn [script _]
|
rlm@275
|
436 (->> script
|
rlm@275
|
437 (play-moves [[:u]])
|
rlm@275
|
438 (do-nothing 1)))
|
rlm@275
|
439 select-item
|
rlm@275
|
440 (range (dec quantity)))
|
rlm@275
|
441 buy-items
|
rlm@275
|
442 (->> request-items
|
rlm@275
|
443 (do-nothing 3)
|
rlm@275
|
444 (play-moves [[:a]])
|
rlm@275
|
445 (scroll-text)
|
rlm@275
|
446 (scroll-text)
|
rlm@275
|
447 (play-moves [[:a]])
|
rlm@275
|
448 (scroll-text))]
|
rlm@275
|
449 buy-items)))
|
rlm@275
|
450
|
rlm@275
|
451
|
rlm@275
|
452 (defn buy-items
|
rlm@275
|
453 "Given a list of [item-no quantity], buys the quantity
|
rlm@275
|
454 from the shop's list. Assumes that the item list is
|
rlm@275
|
455 already up."
|
rlm@275
|
456 [item-pairs script]
|
rlm@275
|
457 (let [item-lookup (into {0 0 1 0 2 0 3 0 4 0} item-pairs)
|
rlm@275
|
458 initial-purchase
|
rlm@275
|
459 (->> script
|
rlm@275
|
460 (buy-item 0 (item-lookup 0))
|
rlm@275
|
461 (buy-item 1 (item-lookup 1))
|
rlm@275
|
462 (buy-item 2 (item-lookup 2)))]
|
rlm@275
|
463 (cond
|
rlm@275
|
464 (and
|
rlm@275
|
465 (not= 0 (item-lookup 3))
|
rlm@275
|
466 (not= 0 (item-lookup 4)))
|
rlm@275
|
467 (->> initial-purchase
|
rlm@275
|
468 (do-nothing 20)
|
rlm@275
|
469 (play-moves [[:d]])
|
rlm@275
|
470 (do-nothing 3)
|
rlm@275
|
471 (play-moves [[:d]])
|
rlm@275
|
472 (do-nothing 3)
|
rlm@275
|
473 (play-moves [[:d]])
|
rlm@275
|
474 (do-nothing 10)
|
rlm@275
|
475 (buy-item 0 (item-lookup 3))
|
rlm@275
|
476 (do-nothing 20)
|
rlm@275
|
477 (play-moves [[:d]])
|
rlm@275
|
478 (do-nothing 3)
|
rlm@275
|
479 (play-moves [[:d]])
|
rlm@275
|
480 (do-nothing 3)
|
rlm@275
|
481 (play-moves [[:d]])
|
rlm@275
|
482 (do-nothing 10)
|
rlm@275
|
483 (buy-item 0 (item-lookup 4)))
|
rlm@275
|
484 (and (= 0 (item-lookup 3))
|
rlm@275
|
485 (not= 0 (item-lookup 4)))
|
rlm@275
|
486 (->> initial-purchase
|
rlm@275
|
487 (do-nothing 20)
|
rlm@275
|
488 (play-moves [[:d]])
|
rlm@275
|
489 (do-nothing 3)
|
rlm@275
|
490 (play-moves [[:d]])
|
rlm@275
|
491 (do-nothing 3)
|
rlm@275
|
492 (play-moves [[:d]])
|
rlm@275
|
493 (do-nothing 10)
|
rlm@275
|
494 (play-moves [[:d]])
|
rlm@275
|
495 (do-nothing 10)
|
rlm@275
|
496 (buy-item 0 (item-lookup 4)))
|
rlm@275
|
497 (and (not= 0 (item-lookup 3))
|
rlm@275
|
498 (= 0 (item-lookup 4)))
|
rlm@275
|
499 (->> initial-purchase
|
rlm@275
|
500 (do-nothing 20)
|
rlm@275
|
501 (play-moves [[:d]])
|
rlm@275
|
502 (do-nothing 3)
|
rlm@275
|
503 (play-moves [[:d]])
|
rlm@275
|
504 (do-nothing 3)
|
rlm@275
|
505 (play-moves [[:d]])
|
rlm@275
|
506 (do-nothing 10)
|
rlm@275
|
507 (buy-item 0 (item-lookup 3))))))
|
rlm@275
|
508
|
rlm@275
|
509
|
rlm@275
|
510 (defn test-buy-items
|
rlm@275
|
511 ([] (test-buy-itemss
|
rlm@274
|
512 (walk-to-counter)))
|
rlm@274
|
513 ([script]
|
rlm@275
|
514 (->> [(first script) (set-money (second script)
|
rlm@275
|
515 999999)]
|
rlm@274
|
516 (play-moves
|
rlm@274
|
517 [[] [:a] []])
|
rlm@274
|
518 (scroll-text)
|
rlm@274
|
519 (do-nothing 100)
|
rlm@274
|
520 (play-moves [[:a]])
|
rlm@274
|
521 (do-nothing 100)
|
rlm@275
|
522 (buy-items
|
rlm@275
|
523 [[0 1]
|
rlm@275
|
524 [1 15]
|
rlm@275
|
525 [2 1]
|
rlm@275
|
526 [3 20]
|
rlm@275
|
527 [4 95]
|
rlm@275
|
528 ]))))
|
rlm@275
|
529
|
rlm@275
|
530 (defn-memo buy-initial-items
|
rlm@275
|
531 ([] (buy-initial-items
|
rlm@275
|
532 (walk-to-counter)))
|
rlm@275
|
533 ([script]
|
rlm@275
|
534 (->> script
|
rlm@275
|
535 (play-moves
|
rlm@275
|
536 [[] [:a] []])
|
rlm@274
|
537 (scroll-text)
|
rlm@274
|
538 (do-nothing 100)
|
rlm@274
|
539 (play-moves [[:a]])
|
rlm@274
|
540 (do-nothing 100)
|
rlm@275
|
541 (buy-items
|
rlm@275
|
542 [[0 1]
|
rlm@275
|
543 [1 1]
|
rlm@275
|
544 [2 1]
|
rlm@275
|
545 [3 1]
|
rlm@275
|
546 [4 1]
|
rlm@275
|
547 ]))))
|
rlm@274
|
548
|
rlm@274
|
549
|
rlm@274
|
550
|
rlm@274
|
551 |