(ns com.aurellem.run.bootstrap-0

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

   (:use (com.aurellem.run title save-corruption))

   (:use (com.aurellem.exp item-bridge))

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

 

 (defn-memo boot-root []

   [ [] (root)])

   

 (defn-memo to-rival-name

   ([] (to-rival-name (boot-root)))

   ([script]

      (-> script

          title

          oak

          name-entry-rlm

          scroll-text

          scroll-text

          scroll-text

          scroll-text

          scroll-text)))

 

 (defn-memo name-rival-bootstrap

   ([] (name-rival-bootstrap (to-rival-name)))

   ([script]

      (->> script

          (advance [] [:a])

          (advance [] [:r] DE)

          (play-moves

           [[]

            [:r] [] [:r] [] [:r] [] [:r] []

            [:r] [] [:r] [] [:r] [] [:d] []

            [:d] [:a]                         ;; space

            [:l] [] [:d] [:a]                 ;; [PK]

            [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G

            [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]

            [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G

            [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]

 

            [:d] [] [:r] [:a]                 ;; finish

            ]))))

 

 (defn walk

   "Move the character along the given directions."

   [directions script]

   (reduce (fn [script direction]

             (move direction script))

           script directions))

 

 (def ↑ [:u])

 (def ↓ [:d])

 (def ← [:l])

 (def → [:r])

 

 (defn-memo leave-house

   ([] (leave-house (name-rival-bootstrap)))

   ([script]

      (->> script

           finish-title

           start-walking

           walk-to-stairs

           walk-to-door

           (walk [↓ ↓]))))

 

 (defn-memo to-pallet-town-edge

   ([] (to-pallet-town-edge (leave-house)))

   ([script]

      (->> script

           start-walking

           (walk [→ → → → →

                  ↑ ↑ ↑ ↑ ↑ ↑]))))

 

 (defn end-text [script]

   (->> script

        (scroll-text)

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

 

 (defn-memo start-pikachu-battle

   ([] (start-pikachu-battle

        (to-pallet-town-edge)))

   ([script]

      (->> script

           (advance [:b] [:b :a] DE)

           (scroll-text)

           (play-moves [[:b]])

           (scroll-text)

           (end-text) ;; battle begins

           (scroll-text))))

 

 (defn-memo capture-pikachu

   ([] (capture-pikachu (start-pikachu-battle)))

   ([script]

      (->> script

           (scroll-text 2)

           (end-text))))

 

 (defn-memo go-to-lab

   ([] (go-to-lab (capture-pikachu)))

   ([script]

      (->> script

           (scroll-text 5)

           (end-text)

           (scroll-text)

           (end-text)

           (scroll-text 8)

           (end-text)

           (scroll-text)

           (end-text))))

 

 (defn-memo obtain-pikachu

   ([] (obtain-pikachu (go-to-lab)))

   ([script]

      (->> script

           (scroll-text)

           (play-moves

            (concat 

             (repeat 51 [])

             [[:a] []]))

           (walk [↓ ↓ → → ↑])

           (play-moves

            (concat [[] [:a]]

                    (repeat 100 [])))

           (scroll-text 9)

           (end-text)

           (scroll-text 7)

 

           (play-moves

            (concat

             (repeat 42 [])

                    [[:b] [:b] [:b] [:b]])))))

 

 (defn-memo begin-battle-with-rival

   ([] (begin-battle-with-rival

         (obtain-pikachu)))

   ([script]

      (->> script

           (walk [↓ ↓ ↓ ↓])

           (scroll-text 3)

           (end-text)

           (scroll-text))))

 

 (defn search-string

   [array string]

   (let [codes

         (str->character-codes string)

         codes-length (count codes)

         mem (vec array)

         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)))))))

         

 (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]

   (loop [blanks 6]

     (let [new-script

           (->> script

                (play-moves

                 (concat (repeat blanks [])

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

       (if (let [future-state

                 (run-moves (second new-script)

                            (repeat 400 []))

 

                 result (search-string (memory future-state)

                                       "Critical")]

             (if result

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

             result) 

         new-script

         (recur (inc blanks))))))  

 

 (defn-memo battle-with-rival

   ([] (battle-with-rival

         (begin-battle-with-rival)))

   ([script]

      (->> script

           (play-moves (repeat 381 []))

           (play-moves [[:a]])

           (critical-hit)

           (play-moves (repeat 100 []))

           (scroll-text)

           (play-moves

            (concat (repeat 275 []) [[:a]]))

           (critical-hit)

           (play-moves (repeat 100 []))

           (scroll-text)

           (play-moves

            (concat (repeat 270 []) [[:a]]))

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

 

 (defn-memo finish-rival-text

   ([] (finish-rival-text

        (battle-with-rival)))

   ([script]

      (->> script

           (scroll-text 2)

           (end-text)

           (scroll-text 9)

           (end-text))))

 

 (defn do-nothing [n script]

   (->> script

        (play-moves

         (repeat n []))))

 

 (defn-memo pikachu-comes-out

   ([] (pikachu-comes-out

        (finish-rival-text)))

   ([script]

      (->> script

           (do-nothing 177)

           (end-text)

           (scroll-text 7)

           (end-text))))

 

 (defn-memo leave-oaks-lab

   ([] (leave-oaks-lab

        (pikachu-comes-out)))

   ([script]

      (->> script 

           (walk [← ← ↓ ↓ ↓ ↓ ↓ ↓]))))

 

 (defn-memo oaks-lab->pallet-town-edge

   ([] (oaks-lab->pallet-town-edge

        (leave-oaks-lab)))

   ([script]

      (->> script

           (walk [← ← ← ←

                  ↑ ↑ ↑ ↑

                  ↑ ↑ ↑ ↑ ↑ ↑

                  → ↑]))))

 

 (defn move-thru-grass

   [direction script]

   (loop [blanks 0]

     (let [new-script

           (->> script

                (play-moves (repeat blanks []))

                (move direction))

 

           future-state

           (run-moves (second new-script)

                      (repeat 600 []))

           

           result (search-string (memory future-state)

                                 "Wild")]

       (if (nil? result)

         (do

           (if (< 0 blanks)

             (do(println "avoided pokemon with" blanks "blank frames")))

              new-script)

         (recur (inc blanks))))))

 

 (defn walk-thru-grass

   [directions script]

   (reduce (fn [script direction]

             (move-thru-grass direction script))

           script directions))

 

 (defn-memo pallet-edge->viridian-mart

   ([] (pallet-edge->viridian-mart true

        (oaks-lab->pallet-town-edge)))

   ([dodge-stupid-guy? script]

      (let [dodge-1 (if dodge-stupid-guy?

                     [→ →]

                     [→])

            dodge-2 (if dodge-stupid-guy?

                      [↑ ↑ ←]

                      [↑ ↑ ←])]

        

        (->> script

           ;; leave straight grass

           (walk-thru-grass

            [↑ ↑ ↑ ↑ ↑])

           

           (walk [↑ ↑ ↑ ↑])

           

           (walk-thru-grass

            [← ← ↑])

           (walk [↑ ↑ ↑ ↑ → → → ])

 

           (walk-thru-grass

            [→ ↑ ↑ ←])

 

           (walk

            [← ←

             ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑

             → → → → ])

 

           ;; this part is dependent on that

           ;; stupid NPC in the grass patch

           (walk-thru-grass

            (concat dodge-1

                 [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ]))

           

           (walk

            (concat

             dodge-2

             [← ← ←

              ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑

              ← ←

              ↑ ↑ ↑ ↑

              → → → → → → → → → →

              ↑ ↑ ↑ ↑ ↑ ↑ ↑])))))) 

             

 (defn-memo get-oaks-parcel

   ([] (get-oaks-parcel

        (pallet-edge->viridian-mart)))

   ([script]

      (->> script

           (end-text)

           (scroll-text 3)

           (do-nothing 197)

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

           (walk [↓ ↓ → ↓]))))

 

 (defn-memo viridian-store->oaks-lab

   ([] (viridian-store->oaks-lab

        (get-oaks-parcel)))

   ([script]

      (->> script

           (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓

                  ← ← ← ← ← ← ← ← ← ← 

                  ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓

                  ← ←

                  ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓

                  ↓ ↓ ↓ ↓ ↓ ↓ ↓

                  → → → → → → → →

                  ↓ ↓ ↓ ↓

                  ← ← ← ← ←

                  ↓ ↓ ↓ ↓])

 

           (walk-thru-grass

            [↓ ↓ ↓ ↓ ↓ ↓ ↓])

 

           (walk [↓ ↓ ← ↓ ↓ ↓ ←

                  ↓ ↓ ↓ ↓ ↓

                  → → → ↑]))))

                  

 (defn-memo viridian-store->oaks-lab-like-a-boss

   ([] (viridian-store->oaks-lab-like-a-boss

        (get-oaks-parcel)))

   ([script]

      (->> script

           (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓

                  ← ← ← ← ← ← ← ← ← ← 

                  ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])

 

           (walk-thru-grass

            [↓ ↓ ↓ ↓ ↓])

 

           (walk

            [↓ ↓ ← ↓

             ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓

             → →])

 

           (walk-thru-grass

            [→ ↓ ↓ ↓])

 

           (walk [↓ ← ← ↓ ↓ ↓ ↓ ↓ ↓])

           

           (walk-thru-grass

            [↓ ↓ ↓ ↓ ↓ ↓ ↓])

           

           (walk [↓ ↓ ← ↓ ↓ ↓ ←

                  ↓ ↓ ↓ ↓ ↓

                  → → → ↑]))))

 

 (defn-memo deliver-oaks-parcel

   ([] (deliver-oaks-parcel

        (viridian-store->oaks-lab-like-a-boss)))

   ([script]

      (->> script

           (walk [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])

           (play-moves [[:a]])

           (scroll-text 11)

           (end-text)

           (end-text)

           (do-nothing 200)

           (end-text)

           (scroll-text 3)

           (end-text)

           (scroll-text 2)

           (end-text)

           (scroll-text 5)

           (end-text)

           (scroll-text 2)

           (end-text)

           (scroll-text 9)

           (end-text)

           (scroll-text 7)

           (end-text)

           (walk [← ← ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓]))))

 

 (defn-memo return-to-viridian-mart

   ([] (return-to-viridian-mart

        (deliver-oaks-parcel)))

   ([script]

      (->> script

           oaks-lab->pallet-town-edge

           (pallet-edge->viridian-mart false))))

 

 (defn-memo walk-to-counter

   ([] (walk-to-counter

        (return-to-viridian-mart)))

   ([script]

      (->> script 

           (walk [↑ ↑ ← ←]))))

 

 (defn buy-item

   "Assumes that the main item-screen is up, and buys

    quantity of the nth item in the list, assuming that you

    have enough money."

   [n quantity script]

   (if (= 0  quantity)

     script

     (let [after-initial-pause

           (do-nothing 20  script)

           move-to-item

           (reduce (fn [script _]

                     (->> script

                          (play-moves [[:d]])

                          (do-nothing 3)))

                   after-initial-pause

                   (range n))

           select-item

           (play-moves [[:a]] move-to-item)

           request-items

           (reduce (fn [script _]

                     (->> script

                          (play-moves [[:u]])

                          (do-nothing 1)))

                   select-item

                   (range (dec quantity)))

           buy-items

           (->> request-items

                (do-nothing 3)

                (play-moves [[:a]])

                (scroll-text)

                (scroll-text)

                (play-moves [[:a]])

                (scroll-text))]

       buy-items)))

      

 

 (defn buy-items

   "Given a list of [item-no quantity], buys the quantity

    from the shop's list. Assumes that the item list is

    already up."

   [item-pairs script]

   (let [item-lookup (into {0 0 1 0 2 0 3 0 4 0} item-pairs)

         initial-purchase

         (->> script

              (buy-item 0 (item-lookup 0))

              (buy-item 1 (item-lookup 1))

              (buy-item 2 (item-lookup 2)))]

     (cond

       (and

        (not= 0 (item-lookup 3))

        (not= 0 (item-lookup 4)))

       (->> initial-purchase

            (do-nothing 20)

            (play-moves [[:d]])

            (do-nothing 3)

            (play-moves [[:d]])

            (do-nothing 3)

            (play-moves [[:d]])

            (do-nothing 10)

            (buy-item 0 (item-lookup 3))

            (do-nothing 20)

            (play-moves [[:d]])

            (do-nothing 3)

            (play-moves [[:d]])

            (do-nothing 3)

            (play-moves [[:d]])

            (do-nothing 10)

            (buy-item 0 (item-lookup 4)))

       (and (= 0 (item-lookup 3))

            (not= 0 (item-lookup 4)))

       (->> initial-purchase

            (do-nothing 20)

            (play-moves [[:d]])

            (do-nothing 3)

            (play-moves [[:d]])

            (do-nothing 3)

            (play-moves [[:d]])

            (do-nothing 10)

            (play-moves [[:d]])

            (do-nothing 10)

            (buy-item 0 (item-lookup 4)))

       (and (not= 0 (item-lookup 3))

            (= 0 (item-lookup 4)))

       (->> initial-purchase

            (do-nothing 20)

            (play-moves [[:d]])

            (do-nothing 3)

            (play-moves [[:d]])

            (do-nothing 3)

            (play-moves [[:d]])

            (do-nothing 10)

            (buy-item 0 (item-lookup 3))))))

 

 

 (defn test-buy-items

   ([] (test-buy-items

        (walk-to-counter)))

   ([script]

      (->> [(first script) (set-money (second script)

                                      999999)]

           (play-moves

            [[] [:a] []])

           (scroll-text)

           (do-nothing 100)

           (play-moves [[:a]])

           (do-nothing 100)

           (buy-items

            [[0 1]

             [1 15]

             [2 1]

             [3 20]

             [4 95]

             ]))))

 

 (defn-memo buy-initial-items

   ([] (buy-initial-items

        (walk-to-counter)))

   ([script]

      (->> script

           (play-moves

            [[] [:a] []])

           (scroll-text)

           (do-nothing 100)

           (play-moves [[:a]])

           (do-nothing 100)

           (buy-items

            [[0 1]

             [1 1]

             [2 1]

             [3 1]

             [4 1]])

           (do-nothing 100)

           (play-moves [[:b]])

           (do-nothing 100)

           (play-moves [[:b]])

           (do-nothing 100)

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

 

 

 (defn do-save-corruption

   ([] (do-save-corruption

        (buy-initial-items)))

   ([script]

      (->> script

           (do-nothing 100)

           

           (play-moves

            [[:start]])

           (do-nothing 500)

           (play-moves [[:d]])

           (do-nothing 100)

 

           (play-moves

            [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [][] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [:d] [] [] [] [:d] [] [] [] [:d]

            [] [] [:a] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b]

            [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b]

            [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b]

            [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b]

            [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b]

            [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b]

            [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b] [:b]

            [:a :b] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [:select] [:restart]

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [:a] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [:start] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [:a] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [:start] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []

            [] [] [] [] [] [] [] [] [] [] [] [] [] [:start] [:a] [:a]

            [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a]

            [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a]

            [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a]

            [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a] [:a]

            [:a] [:a :start] []]))))