(ns com.aurellem.run.util

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

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

 

 (def ↑ [:u])

 (def ↓ [:d])

 (def ← [:l])

 (def → [:r])

 

 [↑ ↓ ← →]

 

 (defn do-nothing [n script]

   (->> script

        (play-moves

         (repeat n []))))

 

 (defn first-difference

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

   (loop [branch-point root

          actions moves]

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

           base-val (difference-metric base-branch)

           alt-branch (step branch-point alt)

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

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

         [(conj actions alt) alt-branch]

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

 

 (defn repeat-until-different

   [buttons metric [moves root :as script]]

   (let [baseline (metric root)]

     (loop [actions (vec moves)

            state root]

       (let [new-state (step state buttons)

             new-actions (conj actions buttons)]

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

           [new-actions new-state]

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

 

 (defn binary-search [metric]

   (let [baseline (metric 0)]

     (loop [low 1

            high 2]

       (let [low-val (metric low)

             high-val (metric high)]

         (println low high)

         (cond

           ;; base case

           (and (= low (dec high))

                (not= low-val high-val))

           high

           ;; exponential growth

           (= baseline high-val low-val)

           (recur high (* high 2))

 

           ;; binary search

           (and (= baseline low-val)

                (not= baseline high-val))

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

                 test-val (metric test)]

             (if (= test-val baseline)

               (recur test high)

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

 

 (defn delayed-difference

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

   (let [generator

         (memoize

          (fn [n]

            (run-moves

             root

             (repeat n base))))

         len

         (binary-search

          (fn [n]

            (= (difference-metric

                (run-moves

                 (generator n)

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

               (difference-metric

                (run-moves

                 (generator n)

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

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

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

     [new-moves new-state]))

 

 (def x-position-address 0xD361)

 (def y-position-address 0xD362)

 

 (defn x-position

   ([^SaveState state]

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

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

 

 (defn y-position

   ([^SaveState state]

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

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

 

 (defn move

   [dir script]

   (let [current-position-fn

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

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

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

   

 (defn walk 

   "Move the character along the given directions."

   [directions script]

   (reduce (fn [script dir]

             (move dir script)) script directions))

 

 (defn search-string

   ([^SaveState state string]

      (let [codes

            (str->character-codes string)

            codes-length (count codes)

            mem (vec (memory state))

            mem-length (count mem)]

        (loop [idx 0]

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

            nil

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

                   codes)

              idx

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

   ([string]

      (search-string @current-state string)))

 

 (def text-address 0x9DC1)

 

 (defn displayed-text

   ([^SaveState state]

      (character-codes->str

       (subvec (vec (memory state))

               text-address

               (+ text-address 82))))

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

 

 (defn scroll-text

   ([script]

      (delayed-difference

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

   ([n script]

      (reduce (fn [script _]

                (scroll-text script))

              script

              (range n))))

 

 (defn end-text

   ([script]

      (->>

       script

       (do-nothing 150)

       (play-moves [[:b]]))))

 

 (defn delayed-improbability-search

   "insert blank frames before calling script-fn until

    metric returns true."

   [delay metric script-fn script]

   (loop [blanks 0]

     (let [new-script

           (->> script

                (play-moves

                 (concat (repeat blanks [])))

                script-fn)

           future-state

           (run-moves (second new-script)

                      (repeat delay []))

           result (metric future-state)]

       (if result

         (do

           (println "improbability factor:" blanks)

           new-script)

         (recur (inc blanks))))))

 

 (defn critical-hit

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

    determine the appropriate amount of blank frames to

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

    a critical hit."

   [script]

   (delayed-improbability-search

    400

    #(search-string  % "Critical")

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

    script))

 

 (defn move-thru-grass

   [direction script]

   (delayed-improbability-search

    600

    #(nil? (search-string % "Wild"))

    (partial move direction)

    script))

 

 (defn walk-thru-grass

   [directions script]

   (reduce (fn [script direction]

             (move-thru-grass direction script))

           script directions))

 

 (defn slowly

   [delay moves script]

   (reduce

    (fn [script move]

      (->> script

           (do-nothing delay)

           (play-moves (vector move))))

    script moves))

 

 (defn multiple-times

   ([n command args script]

      (reduce (fn [script _]

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

              script

              (range n)))

   ([n command script]

      (multiple-times n command [] script)))