view clojure/com/aurellem/run/util.clj @ 319:92c47a9cdaea

adapting bootstrap to new util functions.
author Robert McIntyre <rlm@mit.edu>
date Tue, 03 Apr 2012 04:16:20 -0500
parents 9a4d3f801c89
children 9637a0f52e7b
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))))))
35 (defn binary-search [metric]
36 (let [baseline (metric 0)]
37 (loop [low 1
38 high 2]
39 (let [low-val (metric low)
40 high-val (metric high)]
41 (println low high)
42 (cond
43 ;; base case
44 (and (= low (dec high))
45 (not= low-val high-val))
46 high
47 ;; exponential growth
48 (= baseline high-val low-val)
49 (recur high (* high 2))
51 ;; binary search
52 (and (= baseline low-val)
53 (not= baseline high-val))
54 (let [test (int (/ (+ low high) 2))
55 test-val (metric test)]
56 (if (= test-val baseline)
57 (recur test high)
58 (recur low test))))))))
60 (defn delayed-difference
61 [base alt delay difference-metric [moves root :as script]]
62 (let [generator
63 (memoize
64 (fn [n]
65 (run-moves
66 root
67 (repeat n base))))
68 len
69 (binary-search
70 (fn [n]
71 (= (difference-metric
72 (run-moves
73 (generator n)
74 (concat [alt] (repeat delay base))))
75 (difference-metric
76 (run-moves
77 (generator n)
78 (repeat (inc delay) base))))))
79 new-moves (concat moves (repeat len base) [alt])
80 new-state (run-moves (generator len) [alt])]
81 [new-moves new-state]))
83 (def x-position-address 0xD361)
84 (def y-position-address 0xD362)
86 (defn x-position
87 ([^SaveState state]
88 (aget (memory state) x-position-address))
89 ([] (x-position @current-state)))
91 (defn y-position
92 ([^SaveState state]
93 (aget (memory state) y-position-address))
94 ([] (y-position @current-state)))
96 (defn move
97 [dir script]
98 (let [current-position-fn
99 (cond (#{← →} dir) x-position
100 (#{↑ ↓} dir) y-position)]
101 (repeat-until-different dir current-position-fn script)))
103 (defn walk
104 "Move the character along the given directions."
105 [directions script]
106 (reduce (fn [script dir]
107 (move dir script)) script directions))
109 (defn search-string
110 [^SaveState state string]
111 (let [codes
112 (str->character-codes string)
113 codes-length (count codes)
114 mem (vec (memory state))
115 mem-length (count mem)]
116 (loop [idx 0]
117 (if (< (- mem-length idx) codes-length)
118 nil
119 (if (= (subvec mem idx (+ idx codes-length))
120 codes)
121 idx
122 (recur (inc idx)))))))
124 (def text-address 0x9DC1)
126 (defn displayed-text
127 ([^SaveState state]
128 (character-codes->str
129 (subvec (vec (memory state))
130 text-address
131 (+ text-address 82))))
132 ([] (displayed-text @current-state)))
134 (defn scroll-text
135 ([script]
136 (delayed-difference
137 [:b] [:a :b] 25 displayed-text script))
138 ([n script]
139 (reduce (fn [script _]
140 (scroll-text script))
141 script
142 (range n))))
144 (defn end-text
145 ([script]
146 (->> (do-nothing 150)
147 (play-moves [[:b]]))))
149 (defn do-nothing [n script]
150 (->> script
151 (play-moves
152 (repeat n []))))
154 (defn delayed-improbability-search
155 "insert blank frames before calling script-fn until
156 metric returns true."
157 [delay metric script-fn script]
158 (loop [blanks 0]
159 (let [new-script
160 (->> script
161 (play-moves
162 (concat (repeat blanks [])))
163 script-fn)
164 future-state
165 (run-moves (second new-script)
166 (repeat delay []))
167 result (metric future-state)]
168 (if result
169 (do
170 (println "improbability factor:" blanks)
171 new-script)
172 (recur (inc blanks))))))
174 (defn critical-hit
175 "Put the cursor over the desired attack. This program will
176 determine the appropriate amount of blank frames to
177 insert before pressing [:a] to ensure that the attack is
178 a critical hit."
179 [script]
180 (delayed-improbability-search
181 400
182 #(search-string % "Critical")
183 (partial play-moves [[:a][]])
184 script))
186 (defn move-thru-grass
187 [direction script]
188 (delayed-improbability-search
189 600
190 #(nil? (search-string % "Wild"))
191 (partial move direction)
192 script))
194 (defn walk-thru-grass
195 [directions script]
196 (reduce (fn [script direction]
197 (move-thru-grass direction script))
198 script directions))
200 (defn slowly
201 [delay moves script]
202 (reduce
203 (fn [script move]
204 (->> script
205 (do-nothing delay)
206 (play-moves (vector move))))
207 script moves))
209 (defn multiple-times
210 ([n command args script]
211 (reduce (fn [script _]
212 (apply command (concat args [script])))
213 script
214 (range n)))
215 ([n command script]
216 (multiple-times n command [] script)))