view clojure/com/aurellem/run/util.clj @ 318:9a4d3f801c89

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