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@313: (defn first-difference
rlm@313:   [base alt difference-metric [moves root :as script]]
rlm@313:   (loop [branch-point root
rlm@313:          actions 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@314: (defn delayed-difference
rlm@314:   [base alt delay difference-metric [moves root :as script]]
rlm@314:   (loop [branch-point root
rlm@314:          actions moves]
rlm@314:     (let [base-branch (step branch-point base)
rlm@314:           base-val
rlm@314:           (difference-metric
rlm@314:            (run-moves base-branch
rlm@314:                       (repeat delay base)))
rlm@314:           alt-branch (step branch-point alt)
rlm@314:           alt-val
rlm@314:           (difference-metric
rlm@314:            (run-moves alt-branch
rlm@314:                       (repeat delay base)))]
rlm@314:       (if (not= base-val alt-val)
rlm@314:         [(conj actions alt) alt-branch]
rlm@314:         (recur base-branch (conj actions base))))))
rlm@313: 
rlm@313: 
rlm@314:   
rlm@313: ;; (defn advance
rlm@313: ;;   ([base alt difference-metric [commands state]]
rlm@313: ;;      (let [[c s]
rlm@313: ;;            (first-difference base alt difference-metric state)]
rlm@313: ;;        [(concat commands c) s]))
rlm@313: ;;   ([base alt [commands state]]
rlm@313: ;;      (advance base alt AF [commands state]))
rlm@313: ;;   ([alt [commands state]]
rlm@313: ;;      (advance [] alt [commands state])))
rlm@313: 
rlm@313: 
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 menu
rlm@313:   [directions script]
rlm@313:   (reduce (fn [script direction]
rlm@313:             (move direction script))
rlm@313:           script directions))
rlm@313: 
rlm@313: 
rlm@313: (defn search-string
rlm@314:   [^SaveState state string]
rlm@313:   (let [codes
rlm@313:         (str->character-codes string)
rlm@313:         codes-length (count codes)
rlm@314:         mem (vec (memory state))
rlm@313:         mem-length (count mem)]
rlm@313:     (loop [idx 0]
rlm@313:       (if (< (- mem-length idx) codes-length)
rlm@313:         nil
rlm@313:         (if (= (subvec mem idx (+ idx codes-length))
rlm@313:                codes)
rlm@313:           idx
rlm@313:           (recur (inc idx)))))))
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@314:               text-address
rlm@314:               (+ text-address 82))))
rlm@314:   ([] (displayed-text @current-state)))
rlm@314: 
rlm@314: ;; (defn scroll-text
rlm@314: ;;   ([script]
rlm@314: ;;      (first-difference [:b] [:a :b] AF 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@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@314: 
rlm@314: (defn end-text [script]
rlm@314:   (->> script
rlm@314:        (scroll-text)
rlm@314:        (play-moves [[] [:a]])))
rlm@314: 
rlm@314: 
rlm@314: 
rlm@314: (common-differences
rlm@314:  (vec (memory (step (talk-to-oak) [:a])))
rlm@314:  (vec (memory (step (talk-to-oak) []))))
rlm@314:  
rlm@314: 
rlm@314: 
rlm@314: 
rlm@313: 
rlm@313: (defn do-nothing [n script]
rlm@313:   (->> script
rlm@313:        (play-moves
rlm@313:         (repeat n []))))
rlm@313: 
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@313:   (loop [blanks 6]
rlm@313:     (let [new-script
rlm@313:           (->> script
rlm@313:                (play-moves
rlm@313:                 (concat (repeat blanks [])
rlm@313:                         [[:a][]])))]
rlm@313:       (if (let [future-state
rlm@313:                 (run-moves (second new-script)
rlm@313:                            (repeat 400 []))
rlm@313: 
rlm@313:                 result (search-string (memory future-state)
rlm@313:                                       "Critical")]
rlm@313:             (if result
rlm@313:               (println "critical hit with" blanks "blank frames"))
rlm@313:             result) 
rlm@313:         new-script
rlm@313:         (recur (inc blanks))))))  
rlm@313: 
rlm@313: (defn move-thru-grass
rlm@313:   [direction script]
rlm@313:   (loop [blanks 0]
rlm@313:     (let [new-script
rlm@313:           (->> script
rlm@313:                (play-moves (repeat blanks []))
rlm@313:                (move direction))
rlm@313: 
rlm@313:           future-state
rlm@313:           (run-moves (second new-script)
rlm@313:                      (repeat 600 []))
rlm@313:           
rlm@313:           result (search-string (memory future-state)
rlm@313:                                 "Wild")]
rlm@313:       (if (nil? result)
rlm@313:         (do
rlm@313:           (if (< 0 blanks)
rlm@313:             (do
rlm@313:               (println "avoided pokemon with"
rlm@313:                        blanks "blank frames")))
rlm@313:              new-script)
rlm@313:         (recur (inc blanks))))))
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)))