Mercurial > vba-clojure
view clojure/com/aurellem/run/util.clj @ 536:c2ee7222a3c4
investigating a problem with bad sound when writing RAM with bootstrapping program
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Mon, 25 Jun 2012 14:23:16 -0500 |
parents | 7c89fe478de4 |
children |
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 do-nothing [n script]13 (->> script14 (play-moves15 (repeat n []))))17 (defn first-difference18 [base alt difference-metric [moves root :as script]]19 (loop [branch-point root20 actions (vec moves)]21 (let [base-branch (step branch-point base)22 base-val (difference-metric base-branch)23 alt-branch (step branch-point alt)24 alt-val (difference-metric alt-branch)]25 (if (not= base-val alt-val)26 [(conj actions alt) alt-branch]27 (recur base-branch (conj actions base))))))29 (defn repeat-until-different30 [buttons metric [moves root :as script]]31 (let [baseline (metric root)]32 (loop [actions (vec moves)33 state root]34 (let [new-state (step state buttons)35 new-actions (conj actions buttons)]36 (if (not= (metric new-state) baseline)37 [new-actions new-state]38 (recur new-actions new-state))))))40 (defn binary-search [metric]41 (loop [low 042 high 1]43 (let [low-val (metric low)44 high-val (metric high)]45 (println "(" low high ")")46 (cond47 ;; base case48 (and (= low (dec high))49 (not= low-val high-val))50 high51 ;; exponential growth52 (= high-val low-val)53 (recur high (* high 2))55 ;; binary search56 (not= low-val high-val)57 (let [test (int (/ (+ low high) 2))58 test-val (metric test)]59 (if (= test-val low-val)60 (recur test high)61 (recur low test)))))))64 (defn delayed-difference65 "determine the shortest sequence of the form:67 sequence = (concat (repeat n base) alt)68 which will cause difference-metric69 to yield a different value between.71 (concat sequence (repeat delay base))72 and73 (repeat (+ n 1 delay base))75 This search function is good for finding the optimum keypresses76 whose effect on the game is not revealed until several frames after77 those keys have been pressed (such as scrolling text)."78 [base alt delay difference-metric [moves root :as script]]79 (let [states-cache (atom {})80 generator81 ;; (memoize ;; 32947 msecs82 ;; (fn gen [n]83 ;; (run-moves84 ;; root85 ;; (repeat n base))))87 (fn gen [n] ;; 21150 msecs88 (if (= 0 n)89 root90 (if-let [cached (@states-cache n)]91 cached92 (do (swap!93 states-cache94 #(assoc % n95 (run-moves96 (gen (dec n))97 [base])))98 (gen n)))))100 len101 (binary-search102 (memoize103 (fn [n]104 (if (= n 0) true105 (=(difference-metric106 (run-moves107 (generator n)108 (concat [alt] (repeat delay base))))109 (difference-metric110 (generator (+ n 1 delay))))))))111 new-moves (concat moves (repeat len base) [alt])112 new-state (run-moves (generator len) [alt])]113 [new-moves new-state]))115 (def x-position-address 0xD361)116 (def y-position-address 0xD362)118 (defn x-position119 ([^SaveState state]120 (aget (memory state) x-position-address))121 ([] (x-position @current-state)))123 (defn y-position124 ([^SaveState state]125 (aget (memory state) y-position-address))126 ([] (y-position @current-state)))128 (defn move129 [dir script]130 (let [current-position-fn131 (cond (#{← →} dir) x-position132 (#{↑ ↓} dir) y-position)]133 (repeat-until-different dir current-position-fn script)))135 (defn walk136 "Move the character along the given directions."137 [directions script]138 (reduce (fn [script dir]139 (move dir script)) script directions))141 (defn search-string142 ([^SaveState state string]143 (let [codes144 (str->character-codes string)145 codes-length (count codes)146 mem (vec (memory state))147 mem-length (count mem)]148 (loop [idx 0]149 (if (< (- mem-length idx) codes-length)150 nil151 (if (= (subvec mem idx (+ idx codes-length))152 codes)153 idx154 (recur (inc idx)))))))155 ([string]156 (search-string @current-state string)))158 (def text-address 0x9DC1)160 (defn displayed-text161 ([^SaveState state]162 (character-codes->str163 (subvec (vec (memory state))164 (+ text-address 0)165 (+ text-address 90))))166 ([] (displayed-text @current-state)))168 (defn scroll-text169 ([script]170 (delayed-difference171 [:b] [:a :b] 25 displayed-text script))172 ([n script]173 (reduce (fn [script _]174 (scroll-text script))175 script176 (range n))))178 (defn end-text179 ([script]180 (->>181 script182 (do-nothing 150)183 (play-moves [[:b]]))))185 (defn delayed-improbability-search186 "insert blank frames before calling script-fn until187 metric returns true."188 [delay metric script-fn script]189 (loop [blanks 0]190 (let [new-script191 (->> script192 (play-moves193 (concat (repeat blanks [])))194 script-fn)195 future-state196 (run-moves (second new-script)197 (repeat delay []))198 result (metric future-state)]199 (if result200 (do201 (println "improbability factor:" blanks)202 new-script)203 (recur (inc blanks))))))205 (defn critical-hit206 "Put the cursor over the desired attack. This program will207 determine the appropriate amount of blank frames to208 insert before pressing [:a] to ensure that the attack is209 a critical hit."210 [script]211 (delayed-improbability-search212 400213 #(search-string % "Critical")214 (partial play-moves [[:a][]])215 script))217 (defn move-thru-grass218 [direction script]219 (delayed-improbability-search220 600221 #(nil? (search-string % "Wild"))222 (partial move direction)223 script))225 (defn walk-thru-grass226 [directions script]227 (reduce (fn [script direction]228 (move-thru-grass direction script))229 script directions))231 (defn slowly232 [delay moves script]233 (reduce234 (fn [script move]235 (->> script236 (do-nothing delay)237 (play-moves (vector move))))238 script moves))240 (defn multiple-times241 ([n command args script]242 (reduce (fn [script _]243 (apply command (concat args [script])))244 script245 (range n)))246 ([n command script]247 (multiple-times n command [] script)))249 (defn write-script!250 [[moves state :as script] name]251 [(write-moves! moves name)252 (write-state! state name)])254 (defn read-script255 [name]256 [(read-moves name)257 (read-state name)])