rlm@313: (ns com.aurellem.run.util
rlm@314:   (:use (com.aurellem.gb util gb-driver vbm characters saves))
rlm@313:   (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@313: 
rlm@313: (def ↑ [:u])
rlm@313: (def ↓ [:d])
rlm@313: (def ← [:l])
rlm@313: (def → [:r])
rlm@313: 
rlm@318: [↑ ↓ ← →]
rlm@318: 
rlm@327: (defn do-nothing [n script]
rlm@327:   (->> script
rlm@327:        (play-moves
rlm@327:         (repeat n []))))
rlm@327: 
rlm@313: (defn first-difference
rlm@313:   [base alt difference-metric [moves root :as script]]
rlm@313:   (loop [branch-point root
rlm@335:          actions (vec moves)]
rlm@313:     (let [base-branch (step branch-point base)
rlm@313:           base-val (difference-metric base-branch)
rlm@313:           alt-branch (step branch-point alt)
rlm@313:           alt-val (difference-metric alt-branch)]
rlm@313:       (if (not= base-val alt-val)
rlm@313:         [(conj actions alt) alt-branch]
rlm@313:         (recur base-branch (conj actions base))))))
rlm@313: 
rlm@313: (defn repeat-until-different
rlm@314:   [buttons metric [moves root :as script]]
rlm@313:   (let [baseline (metric root)]
rlm@313:     (loop [actions (vec moves)
rlm@313:            state root]
rlm@313:       (let [new-state (step state buttons)
rlm@313:             new-actions (conj actions buttons)]
rlm@313:         (if (not= (metric new-state) baseline)
rlm@313:           [new-actions new-state]
rlm@313:           (recur new-actions new-state))))))
rlm@313: 
rlm@316: (defn binary-search [metric]
rlm@329:   (loop [low 0
rlm@329:          high 1]
rlm@329:     (let [low-val (metric low)
rlm@329:           high-val (metric high)]
rlm@329:       (println "(" low high ")")
rlm@329:       (cond
rlm@329:        ;; base case
rlm@329:        (and (= low (dec high))
rlm@329:             (not= low-val high-val))
rlm@329:        high
rlm@329:        ;; exponential growth
rlm@329:        (= high-val low-val)
rlm@329:        (recur high (* high 2))
rlm@329:        
rlm@329:        ;; binary search
rlm@329:        (not= low-val high-val)
rlm@329:        (let [test (int (/ (+ low high) 2))
rlm@329:              test-val (metric test)]
rlm@329:          (if (= test-val low-val)
rlm@329:            (recur test high)
rlm@329:            (recur low test)))))))
rlm@316: 
rlm@328: 
rlm@316: (defn delayed-difference
rlm@329:   "determine the shortest sequence of the form:
rlm@329: 
rlm@329:    sequence = (concat (repeat n base) alt)
rlm@329:     which will cause difference-metric
rlm@329:    to yield a different value between.
rlm@329: 
rlm@329:    (concat sequence (repeat delay base))
rlm@329:    and
rlm@329:    (repeat (+ n 1 delay base))
rlm@329: 
rlm@329:    This search function is good for finding the optimum keypresses
rlm@329:    whose effect on the game is not revealed until several frames after
rlm@329:    those keys have been pressed (such as scrolling text)."
rlm@316:   [base alt delay difference-metric [moves root :as script]]
rlm@329:   (let [states-cache (atom {})
rlm@329:         generator 
rlm@329:         ;; (memoize  ;; 32947 msecs
rlm@329:         ;;  (fn gen [n] 
rlm@329:         ;;    (run-moves
rlm@329:         ;;     root
rlm@329:         ;;     (repeat n base))))
rlm@329: 
rlm@329:         (fn gen [n]  ;; 21150 msecs
rlm@329:           (if (= 0 n)
rlm@316:             root
rlm@329:             (if-let [cached (@states-cache n)]
rlm@329:               cached
rlm@329:               (do (swap!
rlm@329:                    states-cache
rlm@329:                    #(assoc % n
rlm@329:                            (run-moves
rlm@329:                             (gen (dec n))
rlm@329:                             [base])))
rlm@329:                   (gen n)))))
rlm@329:             
rlm@316:         len
rlm@316:         (binary-search
rlm@329:          (memoize
rlm@329:           (fn [n]
rlm@329:             (if (= n 0) true
rlm@329:                 (=(difference-metric
rlm@329:                    (run-moves
rlm@329:                     (generator n)
rlm@329:                     (concat [alt] (repeat delay base))))
rlm@329:                   (difference-metric
rlm@329:                     (generator (+ n 1 delay))))))))
rlm@316:         new-moves (concat moves (repeat len base) [alt])
rlm@316:         new-state (run-moves (generator len) [alt])]
rlm@316:     [new-moves new-state]))
rlm@316: 
rlm@313: (def x-position-address 0xD361)
rlm@313: (def y-position-address 0xD362)
rlm@313: 
rlm@313: (defn x-position
rlm@313:   ([^SaveState state]
rlm@313:      (aget (memory state) x-position-address))
rlm@313:   ([] (x-position @current-state)))
rlm@313: 
rlm@313: (defn y-position
rlm@313:   ([^SaveState state]
rlm@313:      (aget (memory state) y-position-address))
rlm@313:   ([] (y-position @current-state)))
rlm@313: 
rlm@313: (defn move
rlm@313:   [dir script]
rlm@313:   (let [current-position-fn
rlm@313:         (cond (#{← →} dir) x-position
rlm@313:               (#{↑ ↓} dir) y-position)]
rlm@313:     (repeat-until-different dir current-position-fn script)))
rlm@313:   
rlm@313: (defn walk 
rlm@313:   "Move the character along the given directions."
rlm@313:   [directions script]
rlm@313:   (reduce (fn [script dir]
rlm@313:             (move dir script)) script directions))
rlm@313: 
rlm@313: (defn search-string
rlm@320:   ([^SaveState state string]
rlm@320:      (let [codes
rlm@320:            (str->character-codes string)
rlm@320:            codes-length (count codes)
rlm@320:            mem (vec (memory state))
rlm@320:            mem-length (count mem)]
rlm@320:        (loop [idx 0]
rlm@320:          (if (< (- mem-length idx) codes-length)
rlm@320:            nil
rlm@320:            (if (= (subvec mem idx (+ idx codes-length))
rlm@320:                   codes)
rlm@320:              idx
rlm@320:              (recur (inc idx)))))))
rlm@320:   ([string]
rlm@320:      (search-string @current-state string)))
rlm@313: 
rlm@314: (def text-address 0x9DC1)
rlm@314: 
rlm@314: (defn displayed-text
rlm@314:   ([^SaveState state]
rlm@314:      (character-codes->str
rlm@314:       (subvec (vec (memory state))
rlm@329:               (+ text-address 0)
rlm@329:               (+ text-address  90))))
rlm@314:   ([] (displayed-text @current-state)))
rlm@314: 
rlm@314: (defn scroll-text
rlm@314:   ([script]
rlm@314:      (delayed-difference
rlm@314:       [:b] [:a :b] 25 displayed-text script))
rlm@314:   ([n script]
rlm@314:      (reduce (fn [script _]
rlm@314:                (scroll-text script))
rlm@314:              script
rlm@314:              (range n))))
rlm@314: 
rlm@319: (defn end-text
rlm@319:   ([script]
rlm@320:      (->>
rlm@320:       script
rlm@320:       (do-nothing 150)
rlm@320:       (play-moves [[:b]]))))
rlm@319: 
rlm@318: (defn delayed-improbability-search
rlm@318:   "insert blank frames before calling script-fn until
rlm@318:    metric returns true."
rlm@318:   [delay metric script-fn script]
rlm@318:   (loop [blanks 0]
rlm@318:     (let [new-script
rlm@318:           (->> script
rlm@318:                (play-moves
rlm@318:                 (concat (repeat blanks [])))
rlm@318:                script-fn)
rlm@318:           future-state
rlm@318:           (run-moves (second new-script)
rlm@318:                      (repeat delay []))
rlm@318:           result (metric future-state)]
rlm@318:       (if result
rlm@318:         (do
rlm@318:           (println "improbability factor:" blanks)
rlm@318:           new-script)
rlm@318:         (recur (inc blanks))))))
rlm@313: 
rlm@313: (defn critical-hit
rlm@313:   "Put the cursor over the desired attack. This program will
rlm@313:    determine the appropriate amount of blank frames to
rlm@313:    insert before pressing [:a] to ensure that the attack is
rlm@313:    a critical hit."
rlm@313:   [script]
rlm@318:   (delayed-improbability-search
rlm@318:    400
rlm@318:    #(search-string  % "Critical")
rlm@318:    (partial play-moves [[:a][]])
rlm@318:    script))
rlm@313: 
rlm@313: (defn move-thru-grass
rlm@313:   [direction script]
rlm@318:   (delayed-improbability-search
rlm@318:    600
rlm@318:    #(nil? (search-string % "Wild"))
rlm@318:    (partial move direction)
rlm@318:    script))
rlm@313: 
rlm@313: (defn walk-thru-grass
rlm@313:   [directions script]
rlm@313:   (reduce (fn [script direction]
rlm@313:             (move-thru-grass direction script))
rlm@313:           script directions))
rlm@313: 
rlm@313: (defn slowly
rlm@313:   [delay moves script]
rlm@313:   (reduce
rlm@313:    (fn [script move]
rlm@313:      (->> script
rlm@313:           (do-nothing delay)
rlm@313:           (play-moves (vector move))))
rlm@313:    script moves))
rlm@313: 
rlm@313: (defn multiple-times
rlm@313:   ([n command args script]
rlm@313:      (reduce (fn [script _]
rlm@313:                (apply command (concat args [script])))
rlm@313:              script
rlm@313:              (range n)))
rlm@313:   ([n command script]
rlm@313:      (multiple-times n command [] script)))