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

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

    35   (loop [branch-point root

    36          actions moves]

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

    38           base-val

    39           (difference-metric

    40            (run-moves base-branch

    41                       (repeat delay base)))

    42           alt-branch (step branch-point alt)

    43           alt-val

    44           (difference-metric

    45            (run-moves alt-branch

    46                       (repeat delay base)))]

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

    48         [(conj actions alt) alt-branch]

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

    50 

    51 

    52   

    53 ;; (defn advance

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

    55 ;;      (let [[c s]

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

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

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

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

    60 ;;   ([alt [commands state]]

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

    62 

    63 

    64 (def x-position-address 0xD361)

    65 (def y-position-address 0xD362)

    66 

    67 (defn x-position

    68   ([^SaveState state]

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

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

    71 

    72 (defn y-position

    73   ([^SaveState state]

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

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

    76 

    77 (defn move

    78   [dir script]

    79   (let [current-position-fn

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

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

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

    83   

    84 (defn walk 

    85   "Move the character along the given directions."

    86   [directions script]

    87   (reduce (fn [script dir]

    88             (move dir script)) script directions))

    89 

    90 (defn menu

    91   [directions script]

    92   (reduce (fn [script direction]

    93             (move direction script))

    94           script directions))

    95 

    96 

    97 (defn search-string

    98   [^SaveState state string]

    99   (let [codes

   100         (str->character-codes string)

   101         codes-length (count codes)

   102         mem (vec (memory state))

   103         mem-length (count mem)]

   104     (loop [idx 0]

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

   106         nil

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

   108                codes)

   109           idx

   110           (recur (inc idx)))))))

   111 

   112 (def text-address 0x9DC1)

   113 

   114 (defn displayed-text

   115   ([^SaveState state]

   116      (character-codes->str

   117       (subvec (vec (memory state))

   118               text-address

   119               (+ text-address 82))))

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

   121 

   122 ;; (defn scroll-text

   123 ;;   ([script]

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

   125 ;;   ([n script]

   126 ;;      (reduce (fn [script _]

   127 ;;                (scroll-text script))

   128 ;;              script

   129 ;;              (range n))))

   130 

   131 (defn scroll-text

   132   ([script]

   133      (delayed-difference

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

   135   ([n script]

   136      (reduce (fn [script _]

   137                (scroll-text script))

   138              script

   139              (range n))))

   140 

   141 

   142 (defn end-text [script]

   143   (->> script

   144        (scroll-text)

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

   146 

   147 

   148 

   149 (common-differences

   150  (vec (memory (step (talk-to-oak) [:a])))

   151  (vec (memory (step (talk-to-oak) []))))

   152  

   153 

   154 

   155 

   156 

   157 (defn do-nothing [n script]

   158   (->> script

   159        (play-moves

   160         (repeat n []))))

   161 

   162 

   163 (defn critical-hit

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

   165    determine the appropriate amount of blank frames to

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

   167    a critical hit."

   168   [script]

   169   (loop [blanks 6]

   170     (let [new-script

   171           (->> script

   172                (play-moves

   173                 (concat (repeat blanks [])

   174                         [[:a][]])))]

   175       (if (let [future-state

   176                 (run-moves (second new-script)

   177                            (repeat 400 []))

   178 

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

   180                                       "Critical")]

   181             (if result

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

   183             result) 

   184         new-script

   185         (recur (inc blanks))))))  

   186 

   187 (defn move-thru-grass

   188   [direction script]

   189   (loop [blanks 0]

   190     (let [new-script

   191           (->> script

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

   193                (move direction))

   194 

   195           future-state

   196           (run-moves (second new-script)

   197                      (repeat 600 []))

   198           

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

   200                                 "Wild")]

   201       (if (nil? result)

   202         (do

   203           (if (< 0 blanks)

   204             (do

   205               (println "avoided pokemon with"

   206                        blanks "blank frames")))

   207              new-script)

   208         (recur (inc blanks))))))

   209 

   210 (defn walk-thru-grass

   211   [directions script]

   212   (reduce (fn [script direction]

   213             (move-thru-grass direction script))

   214           script directions))

   215 

   216 (defn slowly

   217   [delay moves script]

   218   (reduce

   219    (fn [script move]

   220      (->> script

   221           (do-nothing delay)

   222           (play-moves (vector move))))

   223    script moves))

   224 

   225 (defn multiple-times

   226   ([n command args script]

   227      (reduce (fn [script _]

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

   229              script

   230              (range n)))

   231   ([n command script]

   232      (multiple-times n command [] script)))
author	Robert McIntyre <rlm@mit.edu>
date	Mon, 02 Apr 2012 20:30:02 -0500
parents	8e63b0bb8ea3
children	d263df762c59