Mercurial > vba-clojure

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