Mercurial > vba-clojure

comparison clojure/com/aurellem/run/util.clj @ 313:8e63b0bb8ea3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
major refactoring; made (walk) more robust
author Robert McIntyre <rlm@mit.edu>
date Mon, 02 Apr 2012 10:58:16 -0500
parents
children 073600cba28a
comparison
equal deleted inserted replaced
305:7998b1cf18cf 313:8e63b0bb8ea3
1 (ns com.aurellem.run.util
2 (:use (com.aurellem.gb util gb-driver vbm characters))
3 (:import [com.aurellem.gb.gb_driver SaveState]))
4
5 (def ↑ [:u])
6 (def ↓ [:d])
7 (def ← [:l])
8 (def → [:r])
9
10 (defn first-difference
11 [base alt difference-metric [moves root :as script]]
12 (loop [branch-point root
13 actions moves]
14 (let [base-branch (step branch-point base)
15 base-val (difference-metric base-branch)
16 alt-branch (step branch-point alt)
17 alt-val (difference-metric alt-branch)]
18 (if (not= base-val alt-val)
19 [(conj actions alt) alt-branch]
20 (recur base-branch (conj actions base))))))
21
22
23 (defn repeat-until-different
24 [buttons metric [moves root]]
25 (let [baseline (metric root)]
26 (loop [actions (vec moves)
27 state root]
28 (let [new-state (step state buttons)
29 new-actions (conj actions buttons)]
30 (if (not= (metric new-state) baseline)
31 [new-actions new-state]
32 (recur new-actions new-state))))))
33
34
35
36 ;; (defn advance
37 ;; ([base alt difference-metric [commands state]]
38 ;; (let [[c s]
39 ;; (first-difference base alt difference-metric state)]
40 ;; [(concat commands c) s]))
41 ;; ([base alt [commands state]]
42 ;; (advance base alt AF [commands state]))
43 ;; ([alt [commands state]]
44 ;; (advance [] alt [commands state])))
45
46
47 (def x-position-address 0xD361)
48 (def y-position-address 0xD362)
49
50 (defn x-position
51 ([^SaveState state]
52 (aget (memory state) x-position-address))
53 ([] (x-position @current-state)))
54
55 (defn y-position
56 ([^SaveState state]
57 (aget (memory state) y-position-address))
58 ([] (y-position @current-state)))
59
60 (defn move
61 [dir script]
62 (let [current-position-fn
63 (cond (#{← →} dir) x-position
64 (#{↑ ↓} dir) y-position)]
65 (repeat-until-different dir current-position-fn script)))
66
67 (defn walk
68 "Move the character along the given directions."
69 [directions script]
70 (reduce (fn [script dir]
71 (move dir script)) script directions))
72
73 (defn scroll-text
74 ([script]
75 (advance [:b] [:a :b] script))
76 ([n script]
77 (reduce (fn [script _]
78 (scroll-text script))
79 script
80 (range n))))
81
82 (defn menu
83 [directions script]
84 (reduce (fn [script direction]
85 (move direction script))
86 script directions))
87
88 (defn end-text [script]
89 (->> script
90 (scroll-text)
91 (play-moves [[] [:a]])))
92
93 (defn search-string
94 [array string]
95 (let [codes
96 (str->character-codes string)
97 codes-length (count codes)
98 mem (vec array)
99 mem-length (count mem)]
100 (loop [idx 0]
101 (if (< (- mem-length idx) codes-length)
102 nil
103 (if (= (subvec mem idx (+ idx codes-length))
104 codes)
105 idx
106 (recur (inc idx)))))))
107
108
109 (defn do-nothing [n script]
110 (->> script
111 (play-moves
112 (repeat n []))))
113
114
115 (defn critical-hit
116 "Put the cursor over the desired attack. This program will
117 determine the appropriate amount of blank frames to
118 insert before pressing [:a] to ensure that the attack is
119 a critical hit."
120 [script]
121 (loop [blanks 6]
122 (let [new-script
123 (->> script
124 (play-moves
125 (concat (repeat blanks [])
126 [[:a][]])))]
127 (if (let [future-state
128 (run-moves (second new-script)
129 (repeat 400 []))
130
131 result (search-string (memory future-state)
132 "Critical")]
133 (if result
134 (println "critical hit with" blanks "blank frames"))
135 result)
136 new-script
137 (recur (inc blanks))))))
138
139 (defn move-thru-grass
140 [direction script]
141 (loop [blanks 0]
142 (let [new-script
143 (->> script
144 (play-moves (repeat blanks []))
145 (move direction))
146
147 future-state
148 (run-moves (second new-script)
149 (repeat 600 []))
150
151 result (search-string (memory future-state)
152 "Wild")]
153 (if (nil? result)
154 (do
155 (if (< 0 blanks)
156 (do
157 (println "avoided pokemon with"
158 blanks "blank frames")))
159 new-script)
160 (recur (inc blanks))))))
161
162 (defn walk-thru-grass
163 [directions script]
164 (reduce (fn [script direction]
165 (move-thru-grass direction script))
166 script directions))
167
168 (defn slowly
169 [delay moves script]
170 (reduce
171 (fn [script move]
172 (->> script
173 (do-nothing delay)
174 (play-moves (vector move))))
175 script moves))
176
177 (defn multiple-times
178 ([n command args script]
179 (reduce (fn [script _]
180 (apply command (concat args [script])))
181 script
182 (range n)))
183 ([n command script]
184 (multiple-times n command [] script)))