Mercurial > vba-clojure
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.util2 (: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-difference13 [base alt difference-metric [moves root :as script]]14 (loop [branch-point root15 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-different25 [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 139 high 2]40 (let [low-val (metric low)41 high-val (metric high)]42 (println low high)43 (cond44 ;; base case45 (and (= low (dec high))46 (not= low-val high-val))47 high48 ;; exponential growth49 (= baseline high-val low-val)50 (recur high (* high 2))52 ;; binary search53 (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-difference62 [base alt delay difference-metric [moves root :as script]]63 (let [generator64 (memoize65 (fn [n]66 (run-moves67 root68 (repeat n base))))69 len70 (binary-search71 (fn [n]72 (= (difference-metric73 (run-moves74 (generator n)75 (concat [alt] (repeat delay base))))76 (difference-metric77 (run-moves78 (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-position88 ([^SaveState state]89 (aget (memory state) x-position-address))90 ([] (x-position @current-state)))92 (defn y-position93 ([^SaveState state]94 (aget (memory state) y-position-address))95 ([] (y-position @current-state)))97 (defn move98 [dir script]99 (let [current-position-fn100 (cond (#{← →} dir) x-position101 (#{↑ ↓} dir) y-position)]102 (repeat-until-different dir current-position-fn script)))104 (defn walk105 "Move the character along the given directions."106 [directions script]107 (reduce (fn [script dir]108 (move dir script)) script directions))110 (defn search-string111 [^SaveState state string]112 (let [codes113 (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 nil120 (if (= (subvec mem idx (+ idx codes-length))121 codes)122 idx123 (recur (inc idx)))))))125 (def text-address 0x9DC1)127 (defn displayed-text128 ([^SaveState state]129 (character-codes->str130 (subvec (vec (memory state))131 text-address132 (+ text-address 82))))133 ([] (displayed-text @current-state)))135 (defn scroll-text136 ([script]137 (delayed-difference138 [:b] [:a :b] 25 displayed-text script))139 ([n script]140 (reduce (fn [script _]141 (scroll-text script))142 script143 (range n))))145 (defn do-nothing [n script]146 (->> script147 (play-moves148 (repeat n []))))150 (defn delayed-improbability-search151 "insert blank frames before calling script-fn until152 metric returns true."153 [delay metric script-fn script]154 (loop [blanks 0]155 (let [new-script156 (->> script157 (play-moves158 (concat (repeat blanks [])))159 script-fn)160 future-state161 (run-moves (second new-script)162 (repeat delay []))163 result (metric future-state)]164 (if result165 (do166 (println "improbability factor:" blanks)167 new-script)168 (recur (inc blanks))))))170 (defn critical-hit171 "Put the cursor over the desired attack. This program will172 determine the appropriate amount of blank frames to173 insert before pressing [:a] to ensure that the attack is174 a critical hit."175 [script]176 (delayed-improbability-search177 400178 #(search-string % "Critical")179 (partial play-moves [[:a][]])180 script))182 (defn move-thru-grass183 [direction script]184 (delayed-improbability-search185 600186 #(nil? (search-string % "Wild"))187 (partial move direction)188 script))190 (defn walk-thru-grass191 [directions script]192 (reduce (fn [script direction]193 (move-thru-grass direction script))194 script directions))196 (defn slowly197 [delay moves script]198 (reduce199 (fn [script move]200 (->> script201 (do-nothing delay)202 (play-moves (vector move))))203 script moves))205 (defn multiple-times206 ([n command args script]207 (reduce (fn [script _]208 (apply command (concat args [script])))209 script210 (range n)))211 ([n command script]212 (multiple-times n command [] script)))