1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/clojure/com/aurellem/run/util.clj	Mon Apr 02 10:58:16 2012 -0500
     1.3 @@ -0,0 +1,184 @@
     1.4 +(ns com.aurellem.run.util
     1.5 +  (:use (com.aurellem.gb util gb-driver vbm characters))
     1.6 +  (:import [com.aurellem.gb.gb_driver SaveState]))
     1.7 +
     1.8 +(def ↑ [:u])
     1.9 +(def ↓ [:d])
    1.10 +(def ← [:l])
    1.11 +(def → [:r])
    1.12 +
    1.13 +(defn first-difference
    1.14 +  [base alt difference-metric [moves root :as script]]
    1.15 +  (loop [branch-point root
    1.16 +         actions moves]
    1.17 +    (let [base-branch (step branch-point base)
    1.18 +          base-val (difference-metric base-branch)
    1.19 +          alt-branch (step branch-point alt)
    1.20 +          alt-val (difference-metric alt-branch)]
    1.21 +      (if (not= base-val alt-val)
    1.22 +        [(conj actions alt) alt-branch]
    1.23 +        (recur base-branch (conj actions base))))))
    1.24 +
    1.25 +
    1.26 +(defn repeat-until-different
    1.27 +  [buttons metric [moves root]]
    1.28 +  (let [baseline (metric root)]
    1.29 +    (loop [actions (vec moves)
    1.30 +           state root]
    1.31 +      (let [new-state (step state buttons)
    1.32 +            new-actions (conj actions buttons)]
    1.33 +        (if (not= (metric new-state) baseline)
    1.34 +          [new-actions new-state]
    1.35 +          (recur new-actions new-state))))))
    1.36 +
    1.37 +
    1.38 +
    1.39 +;; (defn advance
    1.40 +;;   ([base alt difference-metric [commands state]]
    1.41 +;;      (let [[c s]
    1.42 +;;            (first-difference base alt difference-metric state)]
    1.43 +;;        [(concat commands c) s]))
    1.44 +;;   ([base alt [commands state]]
    1.45 +;;      (advance base alt AF [commands state]))
    1.46 +;;   ([alt [commands state]]
    1.47 +;;      (advance [] alt [commands state])))
    1.48 +
    1.49 +
    1.50 +(def x-position-address 0xD361)
    1.51 +(def y-position-address 0xD362)
    1.52 +
    1.53 +(defn x-position
    1.54 +  ([^SaveState state]
    1.55 +     (aget (memory state) x-position-address))
    1.56 +  ([] (x-position @current-state)))
    1.57 +
    1.58 +(defn y-position
    1.59 +  ([^SaveState state]
    1.60 +     (aget (memory state) y-position-address))
    1.61 +  ([] (y-position @current-state)))
    1.62 +
    1.63 +(defn move
    1.64 +  [dir script]
    1.65 +  (let [current-position-fn
    1.66 +        (cond (#{← →} dir) x-position
    1.67 +              (#{↑ ↓} dir) y-position)]
    1.68 +    (repeat-until-different dir current-position-fn script)))
    1.69 +  
    1.70 +(defn walk 
    1.71 +  "Move the character along the given directions."
    1.72 +  [directions script]
    1.73 +  (reduce (fn [script dir]
    1.74 +            (move dir script)) script directions))
    1.75 +
    1.76 +(defn scroll-text
    1.77 +  ([script]
    1.78 +     (advance [:b] [:a :b] script))
    1.79 +  ([n script]
    1.80 +     (reduce (fn [script _]
    1.81 +               (scroll-text script))
    1.82 +             script
    1.83 +             (range n))))
    1.84 +
    1.85 +(defn menu
    1.86 +  [directions script]
    1.87 +  (reduce (fn [script direction]
    1.88 +            (move direction script))
    1.89 +          script directions))
    1.90 +
    1.91 +(defn end-text [script]
    1.92 +  (->> script
    1.93 +       (scroll-text)
    1.94 +       (play-moves [[] [:a]])))
    1.95 +
    1.96 +(defn search-string
    1.97 +  [array string]
    1.98 +  (let [codes
    1.99 +        (str->character-codes string)
   1.100 +        codes-length (count codes)
   1.101 +        mem (vec array)
   1.102 +        mem-length (count mem)]
   1.103 +    (loop [idx 0]
   1.104 +      (if (< (- mem-length idx) codes-length)
   1.105 +        nil
   1.106 +        (if (= (subvec mem idx (+ idx codes-length))
   1.107 +               codes)
   1.108 +          idx
   1.109 +          (recur (inc idx)))))))
   1.110 +
   1.111 +
   1.112 +(defn do-nothing [n script]
   1.113 +  (->> script
   1.114 +       (play-moves
   1.115 +        (repeat n []))))
   1.116 +
   1.117 +
   1.118 +(defn critical-hit
   1.119 +  "Put the cursor over the desired attack. This program will
   1.120 +   determine the appropriate amount of blank frames to
   1.121 +   insert before pressing [:a] to ensure that the attack is
   1.122 +   a critical hit."
   1.123 +  [script]
   1.124 +  (loop [blanks 6]
   1.125 +    (let [new-script
   1.126 +          (->> script
   1.127 +               (play-moves
   1.128 +                (concat (repeat blanks [])
   1.129 +                        [[:a][]])))]
   1.130 +      (if (let [future-state
   1.131 +                (run-moves (second new-script)
   1.132 +                           (repeat 400 []))
   1.133 +
   1.134 +                result (search-string (memory future-state)
   1.135 +                                      "Critical")]
   1.136 +            (if result
   1.137 +              (println "critical hit with" blanks "blank frames"))
   1.138 +            result) 
   1.139 +        new-script
   1.140 +        (recur (inc blanks))))))  
   1.141 +
   1.142 +(defn move-thru-grass
   1.143 +  [direction script]
   1.144 +  (loop [blanks 0]
   1.145 +    (let [new-script
   1.146 +          (->> script
   1.147 +               (play-moves (repeat blanks []))
   1.148 +               (move direction))
   1.149 +
   1.150 +          future-state
   1.151 +          (run-moves (second new-script)
   1.152 +                     (repeat 600 []))
   1.153 +          
   1.154 +          result (search-string (memory future-state)
   1.155 +                                "Wild")]
   1.156 +      (if (nil? result)
   1.157 +        (do
   1.158 +          (if (< 0 blanks)
   1.159 +            (do
   1.160 +              (println "avoided pokemon with"
   1.161 +                       blanks "blank frames")))
   1.162 +             new-script)
   1.163 +        (recur (inc blanks))))))
   1.164 +
   1.165 +(defn walk-thru-grass
   1.166 +  [directions script]
   1.167 +  (reduce (fn [script direction]
   1.168 +            (move-thru-grass direction script))
   1.169 +          script directions))
   1.170 +
   1.171 +(defn slowly
   1.172 +  [delay moves script]
   1.173 +  (reduce
   1.174 +   (fn [script move]
   1.175 +     (->> script
   1.176 +          (do-nothing delay)
   1.177 +          (play-moves (vector move))))
   1.178 +   script moves))
   1.179 +
   1.180 +(defn multiple-times
   1.181 +  ([n command args script]
   1.182 +     (reduce (fn [script _]
   1.183 +               (apply command (concat args [script])))
   1.184 +             script
   1.185 +             (range n)))
   1.186 +  ([n command script]
   1.187 +     (multiple-times n command [] script)))