Mercurial > vba-clojure

     1 (ns com.aurellem.run.util

     2   (:use (com.aurellem.gb util gb-driver vbm characters saves))

     3   (:import [com.aurellem.gb.gb_driver SaveState]))

     4 

     5 (def ↑ [:u])

     6 (def ↓ [:d])

     7 (def ← [:l])

     8 (def → [:r])

     9 

    10 (defn first-difference

    11   [base alt difference-metric [moves root :as script]]

    12   (loop [branch-point root

    13          actions moves]

    14     (let [base-branch (step branch-point base)

    15           base-val (difference-metric base-branch)

    16           alt-branch (step branch-point alt)

    17           alt-val (difference-metric alt-branch)]

    18       (if (not= base-val alt-val)

    19         [(conj actions alt) alt-branch]

    20         (recur base-branch (conj actions base))))))

    21 

    22 (defn repeat-until-different

    23   [buttons metric [moves root :as script]]

    24   (let [baseline (metric root)]

    25     (loop [actions (vec moves)

    26            state root]

    27       (let [new-state (step state buttons)

    28             new-actions (conj actions buttons)]

    29         (if (not= (metric new-state) baseline)

    30           [new-actions new-state]

    31           (recur new-actions new-state))))))

    32 

    33 

    34 (defn binary-search [metric]

    35   (let [baseline (metric 0)]

    36     (loop [low 1

    37            high 2]

    38       (let [low-val (metric low)

    39             high-val (metric high)]

    40         (println low high)

    41         (cond

    42           ;; base case

    43           (and (= low (dec high))

    44                (not= low-val high-val))

    45           high

    46           ;; exponential growth

    47           (= baseline high-val low-val)

    48           (recur high (* high 2))

    49 

    50           ;; binary search

    51           (and (= baseline low-val)

    52                (not= baseline high-val))

    53           (let [test (int (/ (+ low high) 2))

    54                 test-val (metric test)]

    55             (if (= test-val baseline)

    56               (recur test high)

    57               (recur low test))))))))

    58 

    59 (defn delayed-difference

    60   [base alt delay difference-metric [moves root :as script]]

    61   (let [generator

    62         (memoize

    63          (fn [n]

    64            (run-moves

    65             root

    66             (repeat n base))))

    67         len

    68         (binary-search

    69          (fn [n]

    70            (= (difference-metric

    71                (run-moves

    72                 (generator n)

    73                 (concat [alt] (repeat delay base))))

    74               (difference-metric

    75                (run-moves

    76                 (generator n)

    77                 (repeat (inc delay) base))))))

    78         new-moves (concat moves (repeat len base) [alt])

    79         new-state (run-moves (generator len) [alt])]

    80     [new-moves new-state]))

    81 

    82 (def x-position-address 0xD361)

    83 (def y-position-address 0xD362)

    84 

    85 (defn x-position

    86   ([^SaveState state]

    87      (aget (memory state) x-position-address))

    88   ([] (x-position @current-state)))

    89 

    90 (defn y-position

    91   ([^SaveState state]

    92      (aget (memory state) y-position-address))

    93   ([] (y-position @current-state)))

    94 

    95 (defn move

    96   [dir script]

    97   (let [current-position-fn

    98         (cond (#{← →} dir) x-position

    99               (#{↑ ↓} dir) y-position)]

   100     (repeat-until-different dir current-position-fn script)))

   101   

   102 (defn walk 

   103   "Move the character along the given directions."

   104   [directions script]

   105   (reduce (fn [script dir]

   106             (move dir script)) script directions))

   107 

   108 (defn search-string

   109   [^SaveState state string]

   110   (let [codes

   111         (str->character-codes string)

   112         codes-length (count codes)

   113         mem (vec (memory state))

   114         mem-length (count mem)]

   115     (loop [idx 0]

   116       (if (< (- mem-length idx) codes-length)

   117         nil

   118         (if (= (subvec mem idx (+ idx codes-length))

   119                codes)

   120           idx

   121           (recur (inc idx)))))))

   122 

   123 (def text-address 0x9DC1)

   124 

   125 (defn displayed-text

   126   ([^SaveState state]

   127      (character-codes->str

   128       (subvec (vec (memory state))

   129               text-address

   130               (+ text-address 82))))

   131   ([] (displayed-text @current-state)))

   132 

   133 (defn scroll-text

   134   ([script]

   135      (delayed-difference

   136       [:b] [:a :b] 25 displayed-text script))

   137   ([n script]

   138      (reduce (fn [script _]

   139                (scroll-text script))

   140              script

   141              (range n))))

   142 

   143 (defn do-nothing [n script]

   144   (->> script

   145        (play-moves

   146         (repeat n []))))

   147 

   148 

   149 (defn critical-hit

   150   "Put the cursor over the desired attack. This program will

   151    determine the appropriate amount of blank frames to

   152    insert before pressing [:a] to ensure that the attack is

   153    a critical hit."

   154   [script]

   155   (loop [blanks 6]

   156     (let [new-script

   157           (->> script

   158                (play-moves

   159                 (concat (repeat blanks [])

   160                         [[:a][]])))]

   161       (if (let [future-state

   162                 (run-moves (second new-script)

   163                            (repeat 400 []))

   164 

   165                 result (search-string (memory future-state)

   166                                       "Critical")]

   167             (if result

   168               (println "critical hit with" blanks "blank frames"))

   169             result) 

   170         new-script

   171         (recur (inc blanks))))))  

   172 

   173 (defn move-thru-grass

   174   [direction script]

   175   (loop [blanks 0]

   176     (let [new-script

   177           (->> script

   178                (play-moves (repeat blanks []))

   179                (move direction))

   180 

   181           future-state

   182           (run-moves (second new-script)

   183                      (repeat 600 []))

   184           

   185           result (search-string (memory future-state)

   186                                 "Wild")]

   187       (if (nil? result)

   188         (do

   189           (if (< 0 blanks)

   190             (do

   191               (println "avoided pokemon with"

   192                        blanks "blank frames")))

   193              new-script)

   194         (recur (inc blanks))))))

   195 

   196 (defn walk-thru-grass

   197   [directions script]

   198   (reduce (fn [script direction]

   199             (move-thru-grass direction script))

   200           script directions))

   201 

   202 (defn slowly

   203   [delay moves script]

   204   (reduce

   205    (fn [script move]

   206      (->> script

   207           (do-nothing delay)

   208           (play-moves (vector move))))

   209    script moves))

   210 

   211 (defn multiple-times

   212   ([n command args script]

   213      (reduce (fn [script _]

   214                (apply command (concat args [script])))

   215              script

   216              (range n)))

   217   ([n command script]

   218      (multiple-times n command [] script)))
author	Robert McIntyre <rlm@mit.edu>
date	Mon, 02 Apr 2012 21:25:24 -0500
parents	d263df762c59
children	9a4d3f801c89