view clojure/com/aurellem/run/util.clj @ 476:2d419f7f999c

shortened song.
author Robert McIntyre <rlm@mit.edu>
date Fri, 04 May 2012 06:34:00 -0500
parents 7c89fe478de4
children
line wrap: on
line source
1 (ns com.aurellem.run.util
2 (:use (com.aurellem.gb util gb-driver vbm characters saves))
3 (:import [com.aurellem.gb.gb_driver SaveState]))
5 (def ↑ [:u])
6 (def ↓ [:d])
7 (def ← [:l])
8 (def → [:r])
10 [↑ ↓ ← →]
12 (defn do-nothing [n script]
13 (->> script
14 (play-moves
15 (repeat n []))))
17 (defn first-difference
18 [base alt difference-metric [moves root :as script]]
19 (loop [branch-point root
20 actions (vec moves)]
21 (let [base-branch (step branch-point base)
22 base-val (difference-metric base-branch)
23 alt-branch (step branch-point alt)
24 alt-val (difference-metric alt-branch)]
25 (if (not= base-val alt-val)
26 [(conj actions alt) alt-branch]
27 (recur base-branch (conj actions base))))))
29 (defn repeat-until-different
30 [buttons metric [moves root :as script]]
31 (let [baseline (metric root)]
32 (loop [actions (vec moves)
33 state root]
34 (let [new-state (step state buttons)
35 new-actions (conj actions buttons)]
36 (if (not= (metric new-state) baseline)
37 [new-actions new-state]
38 (recur new-actions new-state))))))
40 (defn binary-search [metric]
41 (loop [low 0
42 high 1]
43 (let [low-val (metric low)
44 high-val (metric high)]
45 (println "(" low high ")")
46 (cond
47 ;; base case
48 (and (= low (dec high))
49 (not= low-val high-val))
50 high
51 ;; exponential growth
52 (= high-val low-val)
53 (recur high (* high 2))
55 ;; binary search
56 (not= low-val high-val)
57 (let [test (int (/ (+ low high) 2))
58 test-val (metric test)]
59 (if (= test-val low-val)
60 (recur test high)
61 (recur low test)))))))
64 (defn delayed-difference
65 "determine the shortest sequence of the form:
67 sequence = (concat (repeat n base) alt)
68 which will cause difference-metric
69 to yield a different value between.
71 (concat sequence (repeat delay base))
72 and
73 (repeat (+ n 1 delay base))
75 This search function is good for finding the optimum keypresses
76 whose effect on the game is not revealed until several frames after
77 those keys have been pressed (such as scrolling text)."
78 [base alt delay difference-metric [moves root :as script]]
79 (let [states-cache (atom {})
80 generator
81 ;; (memoize ;; 32947 msecs
82 ;; (fn gen [n]
83 ;; (run-moves
84 ;; root
85 ;; (repeat n base))))
87 (fn gen [n] ;; 21150 msecs
88 (if (= 0 n)
89 root
90 (if-let [cached (@states-cache n)]
91 cached
92 (do (swap!
93 states-cache
94 #(assoc % n
95 (run-moves
96 (gen (dec n))
97 [base])))
98 (gen n)))))
100 len
101 (binary-search
102 (memoize
103 (fn [n]
104 (if (= n 0) true
105 (=(difference-metric
106 (run-moves
107 (generator n)
108 (concat [alt] (repeat delay base))))
109 (difference-metric
110 (generator (+ n 1 delay))))))))
111 new-moves (concat moves (repeat len base) [alt])
112 new-state (run-moves (generator len) [alt])]
113 [new-moves new-state]))
115 (def x-position-address 0xD361)
116 (def y-position-address 0xD362)
118 (defn x-position
119 ([^SaveState state]
120 (aget (memory state) x-position-address))
121 ([] (x-position @current-state)))
123 (defn y-position
124 ([^SaveState state]
125 (aget (memory state) y-position-address))
126 ([] (y-position @current-state)))
128 (defn move
129 [dir script]
130 (let [current-position-fn
131 (cond (#{← →} dir) x-position
132 (#{↑ ↓} dir) y-position)]
133 (repeat-until-different dir current-position-fn script)))
135 (defn walk
136 "Move the character along the given directions."
137 [directions script]
138 (reduce (fn [script dir]
139 (move dir script)) script directions))
141 (defn search-string
142 ([^SaveState state string]
143 (let [codes
144 (str->character-codes string)
145 codes-length (count codes)
146 mem (vec (memory state))
147 mem-length (count mem)]
148 (loop [idx 0]
149 (if (< (- mem-length idx) codes-length)
150 nil
151 (if (= (subvec mem idx (+ idx codes-length))
152 codes)
153 idx
154 (recur (inc idx)))))))
155 ([string]
156 (search-string @current-state string)))
158 (def text-address 0x9DC1)
160 (defn displayed-text
161 ([^SaveState state]
162 (character-codes->str
163 (subvec (vec (memory state))
164 (+ text-address 0)
165 (+ text-address 90))))
166 ([] (displayed-text @current-state)))
168 (defn scroll-text
169 ([script]
170 (delayed-difference
171 [:b] [:a :b] 25 displayed-text script))
172 ([n script]
173 (reduce (fn [script _]
174 (scroll-text script))
175 script
176 (range n))))
178 (defn end-text
179 ([script]
180 (->>
181 script
182 (do-nothing 150)
183 (play-moves [[:b]]))))
185 (defn delayed-improbability-search
186 "insert blank frames before calling script-fn until
187 metric returns true."
188 [delay metric script-fn script]
189 (loop [blanks 0]
190 (let [new-script
191 (->> script
192 (play-moves
193 (concat (repeat blanks [])))
194 script-fn)
195 future-state
196 (run-moves (second new-script)
197 (repeat delay []))
198 result (metric future-state)]
199 (if result
200 (do
201 (println "improbability factor:" blanks)
202 new-script)
203 (recur (inc blanks))))))
205 (defn critical-hit
206 "Put the cursor over the desired attack. This program will
207 determine the appropriate amount of blank frames to
208 insert before pressing [:a] to ensure that the attack is
209 a critical hit."
210 [script]
211 (delayed-improbability-search
212 400
213 #(search-string % "Critical")
214 (partial play-moves [[:a][]])
215 script))
217 (defn move-thru-grass
218 [direction script]
219 (delayed-improbability-search
220 600
221 #(nil? (search-string % "Wild"))
222 (partial move direction)
223 script))
225 (defn walk-thru-grass
226 [directions script]
227 (reduce (fn [script direction]
228 (move-thru-grass direction script))
229 script directions))
231 (defn slowly
232 [delay moves script]
233 (reduce
234 (fn [script move]
235 (->> script
236 (do-nothing delay)
237 (play-moves (vector move))))
238 script moves))
240 (defn multiple-times
241 ([n command args script]
242 (reduce (fn [script _]
243 (apply command (concat args [script])))
244 script
245 (range n)))
246 ([n command script]
247 (multiple-times n command [] script)))
249 (defn write-script!
250 [[moves state :as script] name]
251 [(write-moves! moves name)
252 (write-state! state name)])
254 (defn read-script
255 [name]
256 [(read-moves name)
257 (read-state name)])