rlm@313
|
1 (ns com.aurellem.run.util
|
rlm@314
|
2 (:use (com.aurellem.gb util gb-driver vbm characters saves))
|
rlm@313
|
3 (:import [com.aurellem.gb.gb_driver SaveState]))
|
rlm@313
|
4
|
rlm@313
|
5 (def ↑ [:u])
|
rlm@313
|
6 (def ↓ [:d])
|
rlm@313
|
7 (def ← [:l])
|
rlm@313
|
8 (def → [:r])
|
rlm@313
|
9
|
rlm@318
|
10 [↑ ↓ ← →]
|
rlm@318
|
11
|
rlm@313
|
12 (defn first-difference
|
rlm@313
|
13 [base alt difference-metric [moves root :as script]]
|
rlm@313
|
14 (loop [branch-point root
|
rlm@313
|
15 actions moves]
|
rlm@313
|
16 (let [base-branch (step branch-point base)
|
rlm@313
|
17 base-val (difference-metric base-branch)
|
rlm@313
|
18 alt-branch (step branch-point alt)
|
rlm@313
|
19 alt-val (difference-metric alt-branch)]
|
rlm@313
|
20 (if (not= base-val alt-val)
|
rlm@313
|
21 [(conj actions alt) alt-branch]
|
rlm@313
|
22 (recur base-branch (conj actions base))))))
|
rlm@313
|
23
|
rlm@313
|
24 (defn repeat-until-different
|
rlm@314
|
25 [buttons metric [moves root :as script]]
|
rlm@313
|
26 (let [baseline (metric root)]
|
rlm@313
|
27 (loop [actions (vec moves)
|
rlm@313
|
28 state root]
|
rlm@313
|
29 (let [new-state (step state buttons)
|
rlm@313
|
30 new-actions (conj actions buttons)]
|
rlm@313
|
31 (if (not= (metric new-state) baseline)
|
rlm@313
|
32 [new-actions new-state]
|
rlm@313
|
33 (recur new-actions new-state))))))
|
rlm@313
|
34
|
rlm@316
|
35 (defn binary-search [metric]
|
rlm@316
|
36 (let [baseline (metric 0)]
|
rlm@316
|
37 (loop [low 1
|
rlm@316
|
38 high 2]
|
rlm@316
|
39 (let [low-val (metric low)
|
rlm@316
|
40 high-val (metric high)]
|
rlm@316
|
41 (println low high)
|
rlm@316
|
42 (cond
|
rlm@316
|
43 ;; base case
|
rlm@316
|
44 (and (= low (dec high))
|
rlm@316
|
45 (not= low-val high-val))
|
rlm@316
|
46 high
|
rlm@316
|
47 ;; exponential growth
|
rlm@316
|
48 (= baseline high-val low-val)
|
rlm@316
|
49 (recur high (* high 2))
|
rlm@316
|
50
|
rlm@316
|
51 ;; binary search
|
rlm@316
|
52 (and (= baseline low-val)
|
rlm@316
|
53 (not= baseline high-val))
|
rlm@316
|
54 (let [test (int (/ (+ low high) 2))
|
rlm@316
|
55 test-val (metric test)]
|
rlm@316
|
56 (if (= test-val baseline)
|
rlm@316
|
57 (recur test high)
|
rlm@316
|
58 (recur low test))))))))
|
rlm@316
|
59
|
rlm@316
|
60 (defn delayed-difference
|
rlm@316
|
61 [base alt delay difference-metric [moves root :as script]]
|
rlm@316
|
62 (let [generator
|
rlm@316
|
63 (memoize
|
rlm@316
|
64 (fn [n]
|
rlm@316
|
65 (run-moves
|
rlm@316
|
66 root
|
rlm@316
|
67 (repeat n base))))
|
rlm@316
|
68 len
|
rlm@316
|
69 (binary-search
|
rlm@316
|
70 (fn [n]
|
rlm@316
|
71 (= (difference-metric
|
rlm@316
|
72 (run-moves
|
rlm@316
|
73 (generator n)
|
rlm@316
|
74 (concat [alt] (repeat delay base))))
|
rlm@316
|
75 (difference-metric
|
rlm@316
|
76 (run-moves
|
rlm@316
|
77 (generator n)
|
rlm@316
|
78 (repeat (inc delay) base))))))
|
rlm@316
|
79 new-moves (concat moves (repeat len base) [alt])
|
rlm@316
|
80 new-state (run-moves (generator len) [alt])]
|
rlm@316
|
81 [new-moves new-state]))
|
rlm@316
|
82
|
rlm@313
|
83 (def x-position-address 0xD361)
|
rlm@313
|
84 (def y-position-address 0xD362)
|
rlm@313
|
85
|
rlm@313
|
86 (defn x-position
|
rlm@313
|
87 ([^SaveState state]
|
rlm@313
|
88 (aget (memory state) x-position-address))
|
rlm@313
|
89 ([] (x-position @current-state)))
|
rlm@313
|
90
|
rlm@313
|
91 (defn y-position
|
rlm@313
|
92 ([^SaveState state]
|
rlm@313
|
93 (aget (memory state) y-position-address))
|
rlm@313
|
94 ([] (y-position @current-state)))
|
rlm@313
|
95
|
rlm@313
|
96 (defn move
|
rlm@313
|
97 [dir script]
|
rlm@313
|
98 (let [current-position-fn
|
rlm@313
|
99 (cond (#{← →} dir) x-position
|
rlm@313
|
100 (#{↑ ↓} dir) y-position)]
|
rlm@313
|
101 (repeat-until-different dir current-position-fn script)))
|
rlm@313
|
102
|
rlm@313
|
103 (defn walk
|
rlm@313
|
104 "Move the character along the given directions."
|
rlm@313
|
105 [directions script]
|
rlm@313
|
106 (reduce (fn [script dir]
|
rlm@313
|
107 (move dir script)) script directions))
|
rlm@313
|
108
|
rlm@313
|
109 (defn search-string
|
rlm@320
|
110 ([^SaveState state string]
|
rlm@320
|
111 (let [codes
|
rlm@320
|
112 (str->character-codes string)
|
rlm@320
|
113 codes-length (count codes)
|
rlm@320
|
114 mem (vec (memory state))
|
rlm@320
|
115 mem-length (count mem)]
|
rlm@320
|
116 (loop [idx 0]
|
rlm@320
|
117 (if (< (- mem-length idx) codes-length)
|
rlm@320
|
118 nil
|
rlm@320
|
119 (if (= (subvec mem idx (+ idx codes-length))
|
rlm@320
|
120 codes)
|
rlm@320
|
121 idx
|
rlm@320
|
122 (recur (inc idx)))))))
|
rlm@320
|
123 ([string]
|
rlm@320
|
124 (search-string @current-state string)))
|
rlm@313
|
125
|
rlm@314
|
126 (def text-address 0x9DC1)
|
rlm@314
|
127
|
rlm@314
|
128 (defn displayed-text
|
rlm@314
|
129 ([^SaveState state]
|
rlm@314
|
130 (character-codes->str
|
rlm@314
|
131 (subvec (vec (memory state))
|
rlm@314
|
132 text-address
|
rlm@314
|
133 (+ text-address 82))))
|
rlm@314
|
134 ([] (displayed-text @current-state)))
|
rlm@314
|
135
|
rlm@314
|
136 (defn scroll-text
|
rlm@314
|
137 ([script]
|
rlm@314
|
138 (delayed-difference
|
rlm@314
|
139 [:b] [:a :b] 25 displayed-text script))
|
rlm@314
|
140 ([n script]
|
rlm@314
|
141 (reduce (fn [script _]
|
rlm@314
|
142 (scroll-text script))
|
rlm@314
|
143 script
|
rlm@314
|
144 (range n))))
|
rlm@314
|
145
|
rlm@319
|
146 (defn end-text
|
rlm@319
|
147 ([script]
|
rlm@320
|
148 (->>
|
rlm@320
|
149 script
|
rlm@320
|
150 (do-nothing 150)
|
rlm@320
|
151 (play-moves [[:b]]))))
|
rlm@319
|
152
|
rlm@313
|
153 (defn do-nothing [n script]
|
rlm@313
|
154 (->> script
|
rlm@313
|
155 (play-moves
|
rlm@313
|
156 (repeat n []))))
|
rlm@313
|
157
|
rlm@318
|
158 (defn delayed-improbability-search
|
rlm@318
|
159 "insert blank frames before calling script-fn until
|
rlm@318
|
160 metric returns true."
|
rlm@318
|
161 [delay metric script-fn script]
|
rlm@318
|
162 (loop [blanks 0]
|
rlm@318
|
163 (let [new-script
|
rlm@318
|
164 (->> script
|
rlm@318
|
165 (play-moves
|
rlm@318
|
166 (concat (repeat blanks [])))
|
rlm@318
|
167 script-fn)
|
rlm@318
|
168 future-state
|
rlm@318
|
169 (run-moves (second new-script)
|
rlm@318
|
170 (repeat delay []))
|
rlm@318
|
171 result (metric future-state)]
|
rlm@318
|
172 (if result
|
rlm@318
|
173 (do
|
rlm@318
|
174 (println "improbability factor:" blanks)
|
rlm@318
|
175 new-script)
|
rlm@318
|
176 (recur (inc blanks))))))
|
rlm@313
|
177
|
rlm@313
|
178 (defn critical-hit
|
rlm@313
|
179 "Put the cursor over the desired attack. This program will
|
rlm@313
|
180 determine the appropriate amount of blank frames to
|
rlm@313
|
181 insert before pressing [:a] to ensure that the attack is
|
rlm@313
|
182 a critical hit."
|
rlm@313
|
183 [script]
|
rlm@318
|
184 (delayed-improbability-search
|
rlm@318
|
185 400
|
rlm@318
|
186 #(search-string % "Critical")
|
rlm@318
|
187 (partial play-moves [[:a][]])
|
rlm@318
|
188 script))
|
rlm@313
|
189
|
rlm@313
|
190 (defn move-thru-grass
|
rlm@313
|
191 [direction script]
|
rlm@318
|
192 (delayed-improbability-search
|
rlm@318
|
193 600
|
rlm@318
|
194 #(nil? (search-string % "Wild"))
|
rlm@318
|
195 (partial move direction)
|
rlm@318
|
196 script))
|
rlm@313
|
197
|
rlm@313
|
198 (defn walk-thru-grass
|
rlm@313
|
199 [directions script]
|
rlm@313
|
200 (reduce (fn [script direction]
|
rlm@313
|
201 (move-thru-grass direction script))
|
rlm@313
|
202 script directions))
|
rlm@313
|
203
|
rlm@313
|
204 (defn slowly
|
rlm@313
|
205 [delay moves script]
|
rlm@313
|
206 (reduce
|
rlm@313
|
207 (fn [script move]
|
rlm@313
|
208 (->> script
|
rlm@313
|
209 (do-nothing delay)
|
rlm@313
|
210 (play-moves (vector move))))
|
rlm@313
|
211 script moves))
|
rlm@313
|
212
|
rlm@313
|
213 (defn multiple-times
|
rlm@313
|
214 ([n command args script]
|
rlm@313
|
215 (reduce (fn [script _]
|
rlm@313
|
216 (apply command (concat args [script])))
|
rlm@313
|
217 script
|
rlm@313
|
218 (range n)))
|
rlm@313
|
219 ([n command script]
|
rlm@313
|
220 (multiple-times n command [] script)))
|