(ns com.aurellem.run.bootstrap-0

   (:use (com.aurellem.gb saves gb-driver util

                          items vbm characters money))

   (:use (com.aurellem.run util 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 5))))

 

 (defn-memo name-rival-bootstrap

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

   ([script]

      (->> script

          (first-difference [] [:a] AF)

          (first-difference [] [: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

           walk-to-stairs

           walk-to-door

           (walk [↓ ↓]))))

 

 (defn-memo to-pallet-town-edge

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

   ([script]

      (->> script

           (walk [→ → → → →

                  ↑ ↑ ↑ ↑ ↑ ↑]))))

 

 (defn-memo start-pikachu-battle

   ([] (start-pikachu-battle

        (to-pallet-town-edge)))

   ([script]

      (->> script

           (first-difference [:b] [:b :a] DE)

           scroll-text

           (do-nothing 200)

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

 

 (defn-memo capture-pikachu

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

   ([script]

      (->> script

           (scroll-text 3))))

 

 (defn-memo go-to-lab

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

   ([script]

      (->> script

           end-text

           (scroll-text 5)

           end-text

           ;; oak walks you to his lab; no input required.

           (do-nothing 400))))

 

 (defn-memo talk-to-oak-in-lab

   ([] (talk-to-oak-in-lab (go-to-lab)))

   ([script]

      (->> script

           (scroll-text 14)

           end-text)))

 

 (defn-memo try-to-get-eevee

   ([] (try-to-get-eevee (talk-to-oak-in-lab)))

   ([script]

      (->> script

           ;; walk to pokeball

           (walk [↓ → →])

           ;; and try to grab it

           (play-moves

            (concat [↑ ↑ [:a]]

                    (repeat 100 [])))

           (scroll-text 10)

           (end-text))))

 

 (defn-memo obtain-pikachu

   ([] (obtain-pikachu (try-to-get-eevee)))

   ([script]

      (->> script

           (scroll-text 6)

           (end-text))))

   

           

 (defn-memo begin-battle-with-rival

   ([] (begin-battle-with-rival

         (obtain-pikachu)))

   ([script]

      (->> script

           (walk [↓ ↓ ↓])

           (scroll-text 3)

           (end-text)

           (scroll-text))))

 

 (defn-memo defeat-eevee

   ([] (defeat-eevee

         (begin-battle-with-rival)))

   ([script]

      (->> script

           (do-nothing 400)

           (play-moves [[:a]])

           (critical-hit)

           (do-nothing 200)

           (scroll-text 2) ;; for eevee's tail-whip

           (do-nothing 10)

           (play-moves [[:a]])

           (critical-hit)

           (do-nothing 200)

           (scroll-text 2) ;; tail whip again

           (do-nothing 10)

           (play-moves [[:a]])

           (critical-hit)

           (do-nothing 200))))

 

 (defn-memo finish-rival-text

   ([] (finish-rival-text

        (defeat-eevee)))

   ([script]

      (->> script

           (scroll-text 12)

           (end-text))))

 

 (defn-memo pikachu-comes-out

   ([] (pikachu-comes-out

        (finish-rival-text)))

   ([script]

      (->> script

           (scroll-text 8)

           (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

           (do-nothing 50)

           (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 [↓ ↓ ← ↓ ↓ ↓ ←

                  ↓ ↓ ↓ ↓ ↓ ↓

                  → → → ↑])

                 

           (do-nothing 1))))

 

                  

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

           (end-text)

           (do-nothing 200)

           (scroll-text 2)

           (end-text)

           (scroll-text 2)

           (end-text)

           (scroll-text 8)

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

 

 

 

 ;; useful addresses

 52262 ;; --- current-cursor-offset

 52278 ;; --- current screen-offset

 

 

 (defn exp-item-list []

   (clojure.pprint/pprint

    (apply harmonic-compare 

           (map read-state 

                ["up-1" "down-1"

                 "up-2" "down-2"

                 "up-3" "down-3"

                 "up-4" "down-4"

                 "up-5" "down-5"

                 "up-6"]))))

 

 

 ;; turns out that these addresses are the cursor position

 ;; for all lists in the game (start list, pokemon list, shop

 ;; lists, inventory lists, battle list, basically

 ;; everything!)

 

 (def list-cursor-offset-address 52262)

 (def list-screen-offset-address 52278)

 

 (defn list-offset

   ([^SaveState state]

      (let [mem (memory state)]

        (+ (aget mem item-screen-offset-address)

           (aget mem item-cursor-offset-address))))

   ([] (item-offset @current-state)))

 

 

 

 (defn exp-item-selection []

   (clojure.pprint/pprint

    (apply memory-compare

           (map read-state

                ["1-item" 

                 "2-items"

                 "3-items"

                 "4-items"

                 ]))))

 

 (def item-quantity-selected-address 65432)

 

 (defn item-quantity-selected

   ([^SaveState state]

      (aget (memory state) item-quantity-selected-address))

   ([] (item-quantity-selected @current-state)))

 

 (defn set-cursor-relative

   "Assumes the arrow keys currently control the cursor.

    Moves the cursor n steps relative to its current

    position."

   [n script]

   (let [key (if (< 0 n) ↓ ↑)]

     (multiple-times

      (Math/abs n)

      (partial first-difference 

       [] key list-offset)

      script)))

 

 (defn set-cursor

   "Assumes the arrow keys currently control the cursor. Sets

    the cursor to the desired position. Works for any menu

    that uses a cursor including the start menu, item menu,

    pokemon menu, and battle menu."

   [n [moves state :as script]]

   (let [current-position (list-offset state)

         difference (- n current-position)]

     (println difference)

     (set-cursor-relative difference script)))

   

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

           (first-difference [:b] [:b :start] AF))))

 

 

 (defn-memo do-save-corruption

   ([] (do-save-corruption

        (buy-initial-items)))

   ([script]

      (->> script

           (first-difference [] [:d] AF)

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

           (first-difference [] [:start] AF)

           (first-difference [] [:a] AF)

           (first-difference [:a] [:a :start] AF))))

 

 (def menu do-nothing )

 

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

           (first-difference [:b] [:start :b] AF)

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

           ]]))))