(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] [] [:d] [:a]           ;; L

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

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

            [:u] [] [:l] [] [:l] []

            [:l] [] [:l] [] [:l] [:a]         ;; U

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

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

            [] [:a]                           ;; [PK]

            [] [:a]                           ;; [PK]

            [:r] [] [:d] [:a]                 ;; END

            ]))))

 

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

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

 

 (defn-memo begin-battle-with-rival

   ([] (begin-battle-with-rival

         (obtain-pikachu)))

   ([script]

      (->> script

           (walk [↓ ↓ ↓ ↓])

           (scroll-text 3)

           (end-text)

           (scroll-text))))

 

 (defn-memo battle-with-rival

   ([] (battle-with-rival

         (begin-battle-with-rival)))

   ([script]

      (->> script

           (do-nothing 400)

           (play-moves [[:a]])

           (critical-hit)

           (do-nothing 100)

           (scroll-text)

           (do-nothing 275)

           (play-moves [[:a]])

           (critical-hit)

           (do-nothing 100)

           (scroll-text)

           (do-nothing 270)

           (play-moves [[:a]])

           (critical-hit)

           (do-nothing 100)

           (scroll-text))))

 

 (defn-memo finish-rival-text

   ([] (finish-rival-text

        (battle-with-rival)))

   ([script]

      (->> script

           (scroll-text 2)

           (end-text)

           (scroll-text 9)

           (end-text))))

 

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

 

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

           ]]))))