Mercurial > vba-clojure
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.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))))))35 (defn binary-search [metric]36 (let [baseline (metric 0)]37 (loop [low 138 high 2]39 (let [low-val (metric low)40 high-val (metric high)]41 (println low high)42 (cond43 ;; base case44 (and (= low (dec high))45 (not= low-val high-val))46 high47 ;; exponential growth48 (= baseline high-val low-val)49 (recur high (* high 2))51 ;; binary search52 (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-difference61 [base alt delay difference-metric [moves root :as script]]62 (let [generator63 (memoize64 (fn [n]65 (run-moves66 root67 (repeat n base))))68 len69 (binary-search70 (fn [n]71 (= (difference-metric72 (run-moves73 (generator n)74 (concat [alt] (repeat delay base))))75 (difference-metric76 (run-moves77 (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-position87 ([^SaveState state]88 (aget (memory state) x-position-address))89 ([] (x-position @current-state)))91 (defn y-position92 ([^SaveState state]93 (aget (memory state) y-position-address))94 ([] (y-position @current-state)))96 (defn move97 [dir script]98 (let [current-position-fn99 (cond (#{← →} dir) x-position100 (#{↑ ↓} dir) y-position)]101 (repeat-until-different dir current-position-fn script)))103 (defn walk104 "Move the character along the given directions."105 [directions script]106 (reduce (fn [script dir]107 (move dir script)) script directions))109 (defn search-string110 [^SaveState state string]111 (let [codes112 (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 nil119 (if (= (subvec mem idx (+ idx codes-length))120 codes)121 idx122 (recur (inc idx)))))))124 (def text-address 0x9DC1)126 (defn displayed-text127 ([^SaveState state]128 (character-codes->str129 (subvec (vec (memory state))130 text-address131 (+ text-address 82))))132 ([] (displayed-text @current-state)))134 (defn scroll-text135 ([script]136 (delayed-difference137 [:b] [:a :b] 25 displayed-text script))138 ([n script]139 (reduce (fn [script _]140 (scroll-text script))141 script142 (range n))))144 (defn end-text145 ([script]146 (->> (do-nothing 150)147 (play-moves [[:b]]))))149 (defn do-nothing [n script]150 (->> script151 (play-moves152 (repeat n []))))154 (defn delayed-improbability-search155 "insert blank frames before calling script-fn until156 metric returns true."157 [delay metric script-fn script]158 (loop [blanks 0]159 (let [new-script160 (->> script161 (play-moves162 (concat (repeat blanks [])))163 script-fn)164 future-state165 (run-moves (second new-script)166 (repeat delay []))167 result (metric future-state)]168 (if result169 (do170 (println "improbability factor:" blanks)171 new-script)172 (recur (inc blanks))))))174 (defn critical-hit175 "Put the cursor over the desired attack. This program will176 determine the appropriate amount of blank frames to177 insert before pressing [:a] to ensure that the attack is178 a critical hit."179 [script]180 (delayed-improbability-search181 400182 #(search-string % "Critical")183 (partial play-moves [[:a][]])184 script))186 (defn move-thru-grass187 [direction script]188 (delayed-improbability-search189 600190 #(nil? (search-string % "Wild"))191 (partial move direction)192 script))194 (defn walk-thru-grass195 [directions script]196 (reduce (fn [script direction]197 (move-thru-grass direction script))198 script directions))200 (defn slowly201 [delay moves script]202 (reduce203 (fn [script move]204 (->> script205 (do-nothing delay)206 (play-moves (vector move))))207 script moves))209 (defn multiple-times210 ([n command args script]211 (reduce (fn [script _]212 (apply command (concat args [script])))213 script214 (range n)))215 ([n command script]216 (multiple-times n command [] script)))