Mercurial > vba-clojure

     1 (ns com.aurellem.run.util

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

     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 

    23 (defn repeat-until-different

    24   [buttons metric [moves root]]

    25   (let [baseline (metric root)]

    26     (loop [actions (vec moves)

    27            state root]

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

    29             new-actions (conj actions buttons)]

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

    31           [new-actions new-state]

    32           (recur new-actions new-state))))))

    33 

    34 

    35 

    36 ;; (defn advance

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

    38 ;;      (let [[c s]

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

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

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

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

    43 ;;   ([alt [commands state]]

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

    45 

    46 

    47 (def x-position-address 0xD361)

    48 (def y-position-address 0xD362)

    49 

    50 (defn x-position

    51   ([^SaveState state]

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

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

    54 

    55 (defn y-position

    56   ([^SaveState state]

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

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

    59 

    60 (defn move

    61   [dir script]

    62   (let [current-position-fn

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

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

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

    66   

    67 (defn walk 

    68   "Move the character along the given directions."

    69   [directions script]

    70   (reduce (fn [script dir]

    71             (move dir script)) script directions))

    72 

    73 (defn scroll-text

    74   ([script]

    75      (advance [:b] [:a :b] script))

    76   ([n script]

    77      (reduce (fn [script _]

    78                (scroll-text script))

    79              script

    80              (range n))))

    81 

    82 (defn menu

    83   [directions script]

    84   (reduce (fn [script direction]

    85             (move direction script))

    86           script directions))

    87 

    88 (defn end-text [script]

    89   (->> script

    90        (scroll-text)

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

    92 

    93 (defn search-string

    94   [array string]

    95   (let [codes

    96         (str->character-codes string)

    97         codes-length (count codes)

    98         mem (vec array)

    99         mem-length (count mem)]

   100     (loop [idx 0]

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

   102         nil

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

   104                codes)

   105           idx

   106           (recur (inc idx)))))))

   107 

   108 

   109 (defn do-nothing [n script]

   110   (->> script

   111        (play-moves

   112         (repeat n []))))

   113 

   114 

   115 (defn critical-hit

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

   117    determine the appropriate amount of blank frames to

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

   119    a critical hit."

   120   [script]

   121   (loop [blanks 6]

   122     (let [new-script

   123           (->> script

   124                (play-moves

   125                 (concat (repeat blanks [])

   126                         [[:a][]])))]

   127       (if (let [future-state

   128                 (run-moves (second new-script)

   129                            (repeat 400 []))

   130 

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

   132                                       "Critical")]

   133             (if result

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

   135             result) 

   136         new-script

   137         (recur (inc blanks))))))  

   138 

   139 (defn move-thru-grass

   140   [direction script]

   141   (loop [blanks 0]

   142     (let [new-script

   143           (->> script

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

   145                (move direction))

   146 

   147           future-state

   148           (run-moves (second new-script)

   149                      (repeat 600 []))

   150           

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

   152                                 "Wild")]

   153       (if (nil? result)

   154         (do

   155           (if (< 0 blanks)

   156             (do

   157               (println "avoided pokemon with"

   158                        blanks "blank frames")))

   159              new-script)

   160         (recur (inc blanks))))))

   161 

   162 (defn walk-thru-grass

   163   [directions script]

   164   (reduce (fn [script direction]

   165             (move-thru-grass direction script))

   166           script directions))

   167 

   168 (defn slowly

   169   [delay moves script]

   170   (reduce

   171    (fn [script move]

   172      (->> script

   173           (do-nothing delay)

   174           (play-moves (vector move))))

   175    script moves))

   176 

   177 (defn multiple-times

   178   ([n command args script]

   179      (reduce (fn [script _]

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

   181              script

   182              (range n)))

   183   ([n command script]

   184      (multiple-times n command [] script)))
author	Robert McIntyre <rlm@mit.edu>
date	Mon, 02 Apr 2012 10:58:16 -0500
parents
children	073600cba28a