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 (defn delayed-difference

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

    84   (loop [branch-point root

    85          actions moves]

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

    87           base-val

    88           (difference-metric

    89            (run-moves base-branch

    90                       (repeat delay base)))

    91           alt-branch (step branch-point alt)

    92           alt-val

    93           (difference-metric

    94            (run-moves alt-branch

    95                       (repeat delay base)))]

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

    97         [(conj actions alt) alt-branch]

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

    99 

   100 

   101             

   102 

   103 

   104 

   105   

   106 ;; (defn advance

   107 ;;   ([base alt difference-metric [commands state]]

   108 ;;      (let [[c s]

   109 ;;            (first-difference base alt difference-metric state)]

   110 ;;        [(concat commands c) s]))

   111 ;;   ([base alt [commands state]]

   112 ;;      (advance base alt AF [commands state]))

   113 ;;   ([alt [commands state]]

   114 ;;      (advance [] alt [commands state])))

   115 

   116 

   117 (def x-position-address 0xD361)

   118 (def y-position-address 0xD362)

   119 

   120 (defn x-position

   121   ([^SaveState state]

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

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

   124 

   125 (defn y-position

   126   ([^SaveState state]

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

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

   129 

   130 (defn move

   131   [dir script]

   132   (let [current-position-fn

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

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

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

   136   

   137 (defn walk 

   138   "Move the character along the given directions."

   139   [directions script]

   140   (reduce (fn [script dir]

   141             (move dir script)) script directions))

   142 

   143 (defn menu

   144   [directions script]

   145   (reduce (fn [script direction]

   146             (move direction script))

   147           script directions))

   148 

   149 

   150 (defn search-string

   151   [^SaveState state string]

   152   (let [codes

   153         (str->character-codes string)

   154         codes-length (count codes)

   155         mem (vec (memory state))

   156         mem-length (count mem)]

   157     (loop [idx 0]

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

   159         nil

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

   161                codes)

   162           idx

   163           (recur (inc idx)))))))

   164 

   165 (def text-address 0x9DC1)

   166 

   167 (defn displayed-text

   168   ([^SaveState state]

   169      (character-codes->str

   170       (subvec (vec (memory state))

   171               text-address

   172               (+ text-address 82))))

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

   174 

   175 ;; (defn scroll-text

   176 ;;   ([script]

   177 ;;      (first-difference [:b] [:a :b] AF script))

   178 ;;   ([n script]

   179 ;;      (reduce (fn [script _]

   180 ;;                (scroll-text script))

   181 ;;              script

   182 ;;              (range n))))

   183 

   184 (defn scroll-text

   185   ([script]

   186      (delayed-difference

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

   188   ([n script]

   189      (reduce (fn [script _]

   190                (scroll-text script))

   191              script

   192              (range n))))

   193 

   194 

   195 (defn end-text [script]

   196   (->> script

   197        (scroll-text)

   198        (play-moves [[] [:a]])))

   199 

   200 

   201 

   202 (memory-compare 

   203  (step (talk-to-oak) [:a])

   204  (step (talk-to-oak) [])

   205  (step (oak-battle) [])

   206  (step (oak-battle) [:a]))

   207 

   208  

   209 

   210 

   211 

   212 

   213 (defn do-nothing [n script]

   214   (->> script

   215        (play-moves

   216         (repeat n []))))

   217 

   218 

   219 (defn critical-hit

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

   221    determine the appropriate amount of blank frames to

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

   223    a critical hit."

   224   [script]

   225   (loop [blanks 6]

   226     (let [new-script

   227           (->> script

   228                (play-moves

   229                 (concat (repeat blanks [])

   230                         [[:a][]])))]

   231       (if (let [future-state

   232                 (run-moves (second new-script)

   233                            (repeat 400 []))

   234 

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

   236                                       "Critical")]

   237             (if result

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

   239             result) 

   240         new-script

   241         (recur (inc blanks))))))  

   242 

   243 (defn move-thru-grass

   244   [direction script]

   245   (loop [blanks 0]

   246     (let [new-script

   247           (->> script

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

   249                (move direction))

   250 

   251           future-state

   252           (run-moves (second new-script)

   253                      (repeat 600 []))

   254           

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

   256                                 "Wild")]

   257       (if (nil? result)

   258         (do

   259           (if (< 0 blanks)

   260             (do

   261               (println "avoided pokemon with"

   262                        blanks "blank frames")))

   263              new-script)

   264         (recur (inc blanks))))))

   265 

   266 (defn walk-thru-grass

   267   [directions script]

   268   (reduce (fn [script direction]

   269             (move-thru-grass direction script))

   270           script directions))

   271 

   272 (defn slowly

   273   [delay moves script]

   274   (reduce

   275    (fn [script move]

   276      (->> script

   277           (do-nothing delay)

   278           (play-moves (vector move))))

   279    script moves))

   280 

   281 (defn multiple-times

   282   ([n command args script]

   283      (reduce (fn [script _]

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

   285              script

   286              (range n)))

   287   ([n command script]

   288      (multiple-times n command [] script)))
author	Robert McIntyre <rlm@mit.edu>
date	Mon, 02 Apr 2012 21:20:54 -0500
parents	073600cba28a
children	3c5bf2221ea0