(ns com.aurellem.run.bootstrap-0

   (:use (com.aurellem.gb gb-driver util items 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 10)

                (play-moves [[:a]])

                (scroll-text)

                (scroll-text)

                (do-nothing 10)

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

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

            (= 0 (item-lookup 4)))

       initial-purchase)))

 

 

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

           (advance [:b] [:b :start]))))

 

 

 (defn-memo do-save-corruption

   ([] (do-save-corruption

        (buy-initial-items)))

   ([script]

      (->> script

           (advance [] [:d])

           (play-moves [[] [] [] [:d]

                        [] [] [] [:d]

                        [] [] [] [:d]

                        [] [] [:a]])

           scroll-text

           (play-moves

            ;; this section is copied from speedrun-2942 and corrupts

            ;; the save so that the total number of pokemon is set to

            ;; 0xFF, allowing manipulation of non-pokemon data in RAM

            ;; via the pokemon interface.

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

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

           (title)

           (advance [] [:start])

           (advance [] [:a])

           (advance [:a] [:a :start]))))

 

 (def menu walk)

 

 (defn-memo corrupt-item-list

   ([] (corrupt-item-list

        (do-save-corruption)))

   ([script]

      (->> script

           (do-nothing 200)

           (menu [↓ [:a]])               ; select "POKEMON" from

                                         ; from main menu

           (menu [↓ ↓ ↓ ↓ ↓ ↓            ; go to 6th pokemon

                  [:a] ↓ [:a]            ; select "switch"

                  ↓ ↓ ↓ [:a]])           ; switch with 9th "pokemon"

                  

           (do-nothing 1))))

 

 

 (defn slowly

   [delay moves script]

   (reduce

    (fn [script move]

      (->> script

           (do-nothing delay)

           (play-moves (vector move))))

    script moves))

                      

 (defn-memo get-burn-heals

   ([] (get-burn-heals

        (corrupt-item-list)))

   ([script]

      (->> script

           (menu [[:b] [:b]])

           (menu [[:a]])

           (do-nothing 100)

           (menu [↓ [:a]])

           (do-nothing 100)

           (menu [[:a] ↓ [:a]])

           (scroll-text)

           (menu [[:b][:b]])

           (menu [[:a]])

 

           (do-nothing 50)

           (buy-items [[0 1]])

           (do-nothing 60)

           (menu [[:a]])

           (scroll-text)

           

           (do-nothing 50)

           (buy-items [[0 1]])

           (do-nothing 60)

           ;;(menu [[:a]])

           ;;(scroll-text)

           

           ;;(do-nothing 300)

           ;;(menu [[:b] [:b]])

           ;;(do-nothing 300)

 

           (buy-items [[0 1]

                       [1 1]

                       [1 1]

                       [2 1]

                       [3 1]

                       [4 97]])

                       

           (do-nothing 10))))

 

 (defn save-game-properly

   [number-down script]

   (->> 

    (reduce (fn [script _]

              (->> script

                   (advance [] [:d])))

            script

            (range number-down))

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

    (scroll-text)

    (do-nothing 300)))

 

 (defn-memo corrupt-item-list-again

   ([] (corrupt-item-list-again (get-burn-heals)))

   ([script]

      (->> script

           (do-nothing 10)

           (play-moves [[:b]])

           (do-nothing 100)

           (play-moves [[:b]])

           (do-nothing 40)

           (play-moves [[:b]])

           (advance [:b] [:start :b])

           (menu [[:a] ↑ ↑ ↑ ↑ ↑         ; get fifth pokemon

                  [:a] ↓ [:a]            ; and corrupt the

                  ↓ ↓ ↓ ↓ ↓ [:a]])       ; item list again by

                                         ; switching it to

           )))                           ; tenth place.

           

           

 

 (defn-memo viridian-store->viridian-poke-center

   ([] (viridian-store->viridian-poke-center

        (corrupt-item-list-again)))

   ([script]

      (->> script

           (do-nothing 100)

           (play-moves [[:b]])

           (do-nothing 100)

           (play-moves [[:b]])

           (do-nothing 40)

           ;; leave store

           (walk [↓ ↓ 

                  → ↓ ↓])

           (walk [← ← ← ←

                  ↓ ↓ ↓ ↓ ↓ ↓

                  ← ← ← ↑]))))

 

 (defn-memo to-poke-center-computer

   ([] (to-poke-center-computer

        (viridian-store->viridian-poke-center)))

   ([script]

      (->> script

           (walk [→ →

                  ↑ ↑ ↑

                  → → → → → → → → → ↑])

           (do-nothing 1))))

 

 (defn-memo begin-deposits

   ([] (begin-deposits

        (to-poke-center-computer)))

   ([script]

      (->> script

           ;; access PC

           (scroll-text 2)

 

           ;; access item storage

           (menu [[:a] [:d] [:a]])

           (scroll-text 2)

 

           ;; begin deposit

           (menu [[:d] [:a]])

           (do-nothing 40))))

 

 

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

 

 (defn deposit-n-items

   [n script]

   (->> script

        (do-nothing 100)

        (play-moves [[:a]])

        (do-nothing 80)

        (multiple-times

         (dec n)

         (fn [script]

           (->> script

                (play-moves [[:u]])

                (do-nothing 1))))

        (play-moves [[:a]])

        (scroll-text)))

 

 (defn deposit-one-item

   [script]

   (->> script

        (do-nothing 100)

        (play-moves [[:a]])

        (do-nothing 80)

        (play-moves [[:a]])

        (scroll-text)))

 

 (defn-memo create-header

   ([] (create-header (begin-deposits)))

   ([script]

      (->> script

           (multiple-times 33 deposit-one-item)

           (do-nothing 1))))

 

 (defn bootstrap-init []

   [(read-moves "bootstrap-init")

    (read-state "bootstrap-init")])

 

 (defn create-bootstrap-program

   ([] (create-bootstrap-program

        (create-header)))

   ([script]

      (->> script

           (do-nothing 120)

           (menu [↓ ↓ ↓ ↓ ↓ ↓ ↓])

           ;;(deposit-n-items 33)

 

           (menu (repeat 17 ↓))

           

 

 

           (do-nothing 1))))

     

 

 (defn test-pc-item-program []

   (-> (read-state "bootstrap-init")

       (set-memory pc-item-list-start 50)

       (set-memory-range

        map-function-address-start

        [0x8B 0xD5])

       (set-memory-range

        (inc pc-item-list-start)

        (flatten

         [(repeat

           28

           [0xFF 0x01])

          [;;  second part of item manipulation program

           0x00   ;; this starts at address 0xD56C

           0x2A   ;; save (HL)=(target) to A, increment HL

 

           0x00

           0x47   ;; save A to B					

 

           0x00

           0x3A   ;; save (target+1) to A, decrement HL		

 

           0x00

           0x22   ;; A -> target, increment HL [(target+1) -> target]

 

           0x00

           0x70   ;; load B into target+1 [(target) -> target+1]	

 

           0x00

           0xC3   ;; first part of absolute jump

 

           0x0C   ;; return control to pokemon kernel

           0x5F]

          (repeat

           5

           [0xFF 0x01])

 

          [;; first part of item manipulation program

           0x00

           0x21   ;; load target into HL

 

           0x94   ;; this is the target address

           0xD5

 

           0x00   ;; relative jump back to first part

           0x18   

 

           0xE1   ;; of program

           0x01

 

           0xFF   ;; spacer

           0x01

           

           0x04  ;; target ID        (pokeball)

           0x3E  ;; target Quantity  (lemonade)

           ]]))))