view clojure/com/aurellem/run/util.clj @ 322:d604bd3c122c

added function to determine wuantity of items currently selected
author Robert McIntyre <rlm@mit.edu>
date Wed, 04 Apr 2012 00:35:44 -0500
parents 9637a0f52e7b
children fe6fd2323264
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)))))))
123 ([string]
124 (search-string @current-state string)))
126 (def text-address 0x9DC1)
128 (defn displayed-text
129 ([^SaveState state]
130 (character-codes->str
131 (subvec (vec (memory state))
132 text-address
133 (+ text-address 82))))
134 ([] (displayed-text @current-state)))
136 (defn scroll-text
137 ([script]
138 (delayed-difference
139 [:b] [:a :b] 25 displayed-text script))
140 ([n script]
141 (reduce (fn [script _]
142 (scroll-text script))
143 script
144 (range n))))
146 (defn end-text
147 ([script]
148 (->>
149 script
150 (do-nothing 150)
151 (play-moves [[:b]]))))
153 (defn do-nothing [n script]
154 (->> script
155 (play-moves
156 (repeat n []))))
158 (defn delayed-improbability-search
159 "insert blank frames before calling script-fn until
160 metric returns true."
161 [delay metric script-fn script]
162 (loop [blanks 0]
163 (let [new-script
164 (->> script
165 (play-moves
166 (concat (repeat blanks [])))
167 script-fn)
168 future-state
169 (run-moves (second new-script)
170 (repeat delay []))
171 result (metric future-state)]
172 (if result
173 (do
174 (println "improbability factor:" blanks)
175 new-script)
176 (recur (inc blanks))))))
178 (defn critical-hit
179 "Put the cursor over the desired attack. This program will
180 determine the appropriate amount of blank frames to
181 insert before pressing [:a] to ensure that the attack is
182 a critical hit."
183 [script]
184 (delayed-improbability-search
185 400
186 #(search-string % "Critical")
187 (partial play-moves [[:a][]])
188 script))
190 (defn move-thru-grass
191 [direction script]
192 (delayed-improbability-search
193 600
194 #(nil? (search-string % "Wild"))
195 (partial move direction)
196 script))
198 (defn walk-thru-grass
199 [directions script]
200 (reduce (fn [script direction]
201 (move-thru-grass direction script))
202 script directions))
204 (defn slowly
205 [delay moves script]
206 (reduce
207 (fn [script move]
208 (->> script
209 (do-nothing delay)
210 (play-moves (vector move))))
211 script moves))
213 (defn multiple-times
214 ([n command args script]
215 (reduce (fn [script _]
216 (apply command (concat args [script])))
217 script
218 (range n)))
219 ([n command script]
220 (multiple-times n command [] script)))