(ns com.aurellem.run.bootstrap-1

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

                          items vbm characters money

                          rlm-assembly))

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

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

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

 

 (def hex #(printf "0x%02X\n" %))

 

 (defn print-desired-item-layout []

   (clojure.pprint/pprint

    (raw-inventory->inventory (pc-item-writer-program))))

 

 (defn pc-item-writer-state []

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

        (pc-item-writer-program))))

 

 (defn test-pc-item-writer []

   (let [orig (read-state "pc-item-writer")]

     (-> orig

     (print-listing 0xD162 (+ 0xD162 20))

     (run-moves (reduce concat

                 (repeat 10 [[:a :b :start :select] []])))

     ((fn [_] (println "===========") _))

     (print-listing 0xD162 (+ 0xD162 20)))))

 

 (defn close-all-menus [[moves state :as script]]

   (loop [s script]

     (let [depth (current-depth (second (do-nothing 50 s)))]

       (println "depth" depth)

       (if (= depth 1)

         s

         (recur (close-menu s))))))

 

 (defn-memo name-rival

   ([] (name-rival (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]

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

             ]))))

 

 (defn-memo to-room-pc

   ([] (to-room-pc (name-rival)))

   ([script]

      (->> script

           finish-title

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

 

 ;; (defn wait-for-quantity

 ;;   [[moves state :as script]]

 ;;   (if (not= (item-quantity-selected state) 1)

 ;;     (repeat-until-different [] item-quantity-selected script)

 ;;     script))

 

 ;; TODO use this:

 ;;(wait-until (partial set-cursor-relative 1))

 

 ;; (defn wait-for-cursor

 ;;   [[moves state :as script]]

 ;;   (if (not= (list-offset state) 0)

 ;;     (repeat-until-different [] list-offset script)

 ;;     script))

 

 (defn deposit-held-item [n quantity [moves state :as script]]

   (let [total-quantity (second (nth-item state n))]

     (println "total-quantity" total-quantity)

     (->> script

          (set-cursor n)

          (select-menu-entry 1)

          ;;(wait-for-quantity)

          (set-quantity total-quantity quantity)

          (delayed-difference [] [:a] 100 #(search-string % "stored"))

          (scroll-text))))

 

 (defn sell-held-item [n quantity [moves state :as script]]

   (let [total-quantity (second (nth-item state n))]

     (->> script

          ;;(wait-for-cursor)  ;; when selling, the cursor always

          (set-cursor n)     ;; returns to the top of the list.

          (select-menu-entry 1)

          ;;(wait-for-quantity)

          (set-quantity total-quantity quantity)

          (delayed-difference [] [:a] 100 current-depth)

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

          (delayed-difference [] [:a] 100 #(search-string % "What"))

          )))

 

 (defn widthdraw-pc-item [n quantity [moves state :as script]]

   (let [total-quantity (second (nth-pc-item state n))]

     (->> script

          (set-cursor n)

          (select-menu-entry 1)

          ;;(wait-for-quantity)

          (set-quantity total-quantity quantity)

          (delayed-difference [] [:a] 100 #(search-string % "Withdrew"))

          (scroll-text))))

 

 (defn toss-held-item [n quantity [moves state :as script]]

   (let [total-quantity (second (nth-item state n))]

     (->> script

          (set-cursor n)

          (select-menu-entry 1)

          (set-cursor-relative 1)

          (select-menu-entry -1)

          ;;(wait-for-quantity)

          (set-quantity total-quantity quantity)

          (play-moves [[:a]])

          (scroll-text)

          (delayed-difference [] [:a] 100 #(search-string % "Threw"))

          (scroll-text)

          )))

 

 (defn buy-item [n quantity [moves state :as script]]

   (->> script

        (set-cursor n)

        (purchase-item quantity)))

 

 (defn switch-items [item-fn idx-1 idx-2 script]

   (->> script

        (wait-until select-menu-entry)

        (set-cursor idx-1)

        (wait-until select-menu-entry)

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

        (set-cursor idx-2)

        (delayed-difference [] [:select] 100

                            #(item-fn % (list-offset %)))))

 

 (def switch-pc-items (partial switch-items nth-pc-item))

 (def switch-held-items (partial switch-items nth-item))

 

 (defn combine-pc-items [idx-1 script]

   (->> script

        (switch-pc-items idx-1 (inc idx-1))))

 

 (def desired-zero-quantities

   (map second (filter (comp (partial = 0) first)

                       (partition 2 (pc-item-writer-program)))))

 

 (defn bootstrap-corrupt-save

   ([] (bootstrap-corrupt-save (to-room-pc)))

   ([script]

    (->> script

         (do-save-corruption 3)

         (corrupt-item-list 0)

         close-all-menus)))

 

 (defn-memo prepare-celadon-warp

   ([] (prepare-celadon-warp (bootstrap-corrupt-save)))

   ([script]

      (->> script

           (activate-start-menu)

           (set-cursor-relative 1)

           (select-menu-entry)

           ;; vastly increase text speed while we're here.

           (switch-held-items 21 27)

           (toss-held-item 35 0xFA)

           (close-all-menus))))

 

 (defn-memo begin-initial-deposits

   ([] (begin-initial-deposits

        (prepare-celadon-warp)))

   ([script]

      (->> script

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

           (scroll-text)

           (set-cursor 1)

           select-menu-entry)))

 

 (defn-memo initial-deposits

   ([] (initial-deposits (begin-initial-deposits)))

   ([script]

      (->> script

           (deposit-held-item 0 0x1)

           ((fn [script]

              (reduce 

               (fn [script item] (deposit-held-item item 0xFF script))

               script

               (range 3 (+ 13 3)))))

           close-all-menus)))

 

 

 ;;0 -- 256

 ;;1 -- 254

 ;;2 -- 254

 ;;3 -- 255

 

 (defn activate-home-pc

   [script]

   (->> script

        (delayed-difference [] [:a]

                            200 first-character)

        (scroll-text)))

 

 (defn-memo restore-items

   ([] (restore-items (initial-deposits)))

   ([script]

      (->> script

           activate-home-pc

           (select-menu-entry)

           (widthdraw-pc-item 0 1)

           ;;(widthdraw-pc-item 0 99)

           ;;(widthdraw-pc-item 1 1)

           (widthdraw-pc-item 13 255)

           (close-all-menus))))

 

 (defn-memo to-celadon

   ([] (to-celadon (restore-items)))

   ([script]

      (->> script

           (walk [→ → → → → → → ↑

                  ↓ ↓ ↓ ↓ ↓ ← ← ← ←

                  ↓ ↓]))))

 

 

 ;; celadon store inventory

 

 ;; Floor 2

 ;;=====================================

 ;; Great Ball        TM32 (double-team)

 ;; Super Potion      TM33 (reflect)

 ;; Revive            TM02 (razor-wind)

 ;; Super Repel       TM07 (horn-drill)

 ;; Antidote          TM37 (egg-bomb)

 ;; Burn Heal         TM01 (mega-punch)

 ;; Ice Heal          TM05 (mega-kick)

 ;; Awakening         TM09 (take-down)

 ;; Parlyz Heal       TM17 (submission)

 

 

 ;; Floor 3

 ;;=====================================       

 ;; TM18 (counter)

 

 

 ;; Floor 4

 ;;=====================================

 ;; Poke Doll

 ;; Fire Stone

 ;; Thunder Stone

 ;; Water Stone

 ;; Leaf Stone

 

 ;; Floor 5

 ;;=====================================

 ;; X Accuracy         HP UP

 ;; Guard Spec.        Protein

 ;; Dire Hit           Iron

 ;; X Attack           Carbos

 ;; X Defend           Calcium

 ;; X Speed            

 ;; X Special

 

 ;; Roof

 ;;=====================================

 ;; Fresh Water        TM13 (ice-beam)

 ;; Soda Pop           TM48 (rock-slide)

 ;; Lemonade :)        TM49 (tri-attack)

 

 

 (defn-memo go-to-floor-two

   ([] (go-to-floor-two (to-celadon)))

   ([script]

      (->> script

           (walk [→ → ↑

                  ↑ ↑ ↑ ↑

                  ← ← ← ←

                  ↑ ↑ 

                  ← ← ← ← 

                  ↓ ↓ ↓

                  ← ←])

           (first-difference [] ↑ AF))))

 

 (defn talk

   "Assumes that you are facing something that initiates text and

    causes it to do so."

   [script]

   (->> script

        (delayed-difference [] [:a] 100

                            first-character)))

 

 (defn-memo get-money-floor-two

   ([] (get-money-floor-two (go-to-floor-two)))

   ([script]

      (->> script

           talk

           (set-cursor 1)

           (select-menu-entry)

 

           ;; These glitch items have to be sold one at a time

           ;; because the game will only award up to 500000 at

           ;; a time for selling them.

           (sell-held-item 0 1)

           (sell-held-item 0 1)

 

           (close-menu))))

 

 (defn-memo floor-two-TMs

   ([] (floor-two-TMs (get-money-floor-two)))

   ([script]

      (->> script

           (set-cursor 0)

           (select-menu-entry)

           (buy-item 2 98)  ;; TM02 (razor-wind)

           (buy-item 4 71)  ;; TM37 (doubleteam)

           (buy-item 5 63)  ;; TM01 (mega-punch)

           (buy-item 6 1)   ;; TM05 (mega-kick)

           (buy-item 7 56)  ;; TM09 (take-down)

           (close-menu))))

 

 (defn end-shop-conversation

   [script]

   (->> script

        (wait-until scroll-text [:b])

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

        close-menu))

 

 (defn-memo floor-two-more-money

   ([] (floor-two-more-money (floor-two-TMs)))

   ([script]

      (->> script

           (set-cursor 1)

           (select-menu-entry)

           (sell-held-item 0 1)

           (sell-held-item 0 1)

           close-menu

           end-shop-conversation)))

 

 (defn turn [direction script]

   (->> script

        (first-difference [] direction AF)))

 

 (defn-memo floor-two-items

   ([] (floor-two-items (floor-two-more-money)))

   ([script]

      (->> script

           (walk [←])

           (turn ↑)

           talk

           select-menu-entry

           (buy-item 5 12)  ;; burn heal

           (buy-item 6 55)  ;; ice heal

           (buy-item 7 4)   ;; awakening

           (buy-item 8 99)  ;; parlyz heal

           (buy-item 8 55)  ;; parlyz heal

           close-menu

           end-shop-conversation)))

 

 (defn-memo go-to-floor-three

   ([] (go-to-floor-three (floor-two-items)))

   ([script]

      (->> script

           (walk [→ → → → → → → → → → ↑ ↑ ↑

                    → ↑]))))

 (defn-memo get-TM18

   ([] (get-TM18 (go-to-floor-three)))

   ([script]

      (->> script

           (walk [↓ ↓])

           talk

           (scroll-text 3)

           end-text)))

 

 (defn-memo go-to-floor-four

   ([] (go-to-floor-four (get-TM18)))

   ([script]

      (->> script

           (walk [← ← ← ← ↑ ↑

                  ↓ ← ← ↓ ↓ ↓

                  ← ← ← ← ←])

           (turn ↓))))

 

 (defn-memo floor-four-items

   ([] (floor-four-items (go-to-floor-four)))

   ([script]

      (->> script

           talk

           select-menu-entry

           (buy-item 1 23)  ;; Fire Stone

           (buy-item 2 98)  ;; Thunder Stone

           (buy-item 3 29)  ;; Water Stone

           close-menu

           end-shop-conversation)))

 

 (defn-memo go-to-floor-five

   ([] (go-to-floor-five (floor-four-items)))

   ([script]

      (->> script

           (walk [→ → → → → →

                  ↑ ↑ ↑

                  → → → → → ↑ ;; leave floor four

                  ↓ ← ← ← ← ← ← ← ←

                  ↓ ↓ ↓ ← ← ← ]);; go to five's clerk

           (turn ↑))))

                 

 (defn-memo floor-five-items

   ([] (floor-five-items (go-to-floor-five)))

   ([script]

      (->> script

           talk

           select-menu-entry

           (buy-item 0 58)   ;; X-Accuracy

           (buy-item 1 99)   ;; Guard Spec.

           (buy-item 1 24)   ;; Guard Spec.

           close-menu

           end-shop-conversation)))

 

 (defn-memo go-to-roof

   ([] (go-to-roof (floor-five-items)))

   ([script]

      (->> script

           (walk [→ → → → ↑ ↑ ↑ → → → ↑ ;; leave floor five

                  ↓ ← ← ←]) ;; walk to vending machine

           (turn ↑))))

 

 (defn buy-drink

   "Assumes you're in front of the vending machine. Buys the indicated

    drink."

   [n script]

   (->> script

        (do-nothing 20)

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

        scroll-text

        (set-cursor n)

        select-menu-entry

        close-menu))

 

 (defn-memo roof-drinks

   ([] (roof-drinks (go-to-roof)))

   ([script]

      (->> script

           (buy-drink 0) ;; fresh water (for TM13)

           ;; buy 16 lemonades

           ;; LEMONADE is the best item <3  :)

           (multiple-times 16 (partial buy-drink 2)))))

 

 (defn-memo get-TM13

   ([] (get-TM13 (roof-drinks)))

   ([script]

      (->> script

           ;; alternate route depending on girl's motions

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

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

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

           (scroll-text 3)

           select-menu-entry

           select-menu-entry

           (scroll-text 6)

           close-menu)))

 

 (defn-memo to-celadon-poke-center

   ([] (to-celadon-poke-center (get-TM13)))

   ([script]

      (->> script

           ;; alternate route depending on girl's motions

           ;;(walk [↑ → → → → → → → → → ↑])       ; leave roof

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

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

                  ↑ ↑ ↑ ← ← ↑])                 ; to elevator

                  

           (walk [→ → ↑ ↑])                     ; to controls

           talk

           select-menu-entry                    ; to floor 1

           (walk [↓ ↓ ←])

           (walk [↓ → ↓ ↓ ↓ ↓ ↓ ↓])             ; leave store

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

           (walk (repeat 23 →))

           (walk [↑ ↑ ↑ ↑])                     ; enter poke center

           (walk [↑ ↑ ↑ → → → → → → → → → →])   ; to computer

           (turn ↑))))

 

 (defn activate-rlm-pc [script]

   (->> script

        talk

        scroll-text

        ;;wait-for-cursor

        (set-cursor 1)

        select-menu-entry

        (scroll-text 2)))

 

 (defn begin-deposit [script]

   (->> script

        (set-cursor 1)

        select-menu-entry))

 

 (defn begin-withdraw [script]

   (->> script

        (set-cursor 0)

        (select-menu-entry)))

 

 (defn deposit-held-item-named

   [item-name quantity [moves state :as script]]

   (let [index (count

                (take-while

                 (fn [[name quant]]

                   (or (not= name item-name)

                       (< quant quantity)))

                   (inventory state)))]

     (println "index" index)

     (deposit-held-item index quantity script)))

 

 (defn open-held-items

   [script]

   (->> script

        select-menu-entry))

 

 (defn to-held-items

   [script]

   (->> script

        close-menu

        close-menu

        end-text;;; grr

        

        activate-start-menu

        open-held-items))

 

 (defn toss-pc-item [n quantity  [moves state :as script]]

   (let [total-quantity (second (nth-pc-item state n))]

     (->> script

          (set-cursor n)

          (select-menu-entry 1)

          (set-quantity total-quantity quantity)

          (delayed-difference [] [:a] 100 #(search-string % "Is"))

          (scroll-text)

          select-menu-entry

          (scroll-text))))

 

 (defn-memo hacking-1

   ([] (hacking-1 (to-celadon-poke-center)))

   ([script]

      (->> script

           activate-rlm-pc

           begin-deposit

           (deposit-held-item-named 0x00           30)

           (deposit-held-item-named :TM01          63)

           (deposit-held-item-named :awakening      4)

           (deposit-held-item-named :thunderstone  98)

           (deposit-held-item-named :TM09          55)

           (deposit-held-item-named 0x00           55))))

 

 (defn-memo hacking-2

   ([] (hacking-2 (hacking-1)))

   ([script]

      (->> script

           (to-held-items)

           (toss-held-item 0 166) ;; discard cruft

           close-menu

           close-menu)))

 

 (defn-memo hacking-3

   ([] (hacking-3 (hacking-2)))

   ([script]

      (->> script

           activate-rlm-pc

           begin-withdraw

           (widthdraw-pc-item 0 99)

           (widthdraw-pc-item 0 1)

           (widthdraw-pc-item 2 0xFE)

           (widthdraw-pc-item 3 0xFE)

           close-menu)))

           

 (defn-memo hacking-4

   ([] (hacking-4 (hacking-3)))

   ([script]

      (->> script

           begin-deposit

           (deposit-held-item 19 243)

           (deposit-held-item-named :lemonade 16)

           (deposit-held-item 18 224))))

           

 (defn-memo hacking-5

   "clean out the held-item list again"

   ([] (hacking-5 (hacking-4)))

   ([script]

      (->> script

           (to-held-items)

           (toss-held-item 18 30)

           (toss-held-item 17 1)

           close-menu

           close-menu)))

 

 (defn-memo hacking-6

   ([] (hacking-6 (hacking-5)))

   ([script]

      (->> script

           activate-rlm-pc

           begin-withdraw

           (widthdraw-pc-item 4 0xFE)

           (widthdraw-pc-item 5 0xFE)

           (widthdraw-pc-item 6 0xFE)

           close-menu)))

 

 (defn-memo hacking-7

   ([] (hacking-7 (hacking-6)))

   ([script]

      (->> script

           begin-deposit

           (deposit-held-item 19 240)

           (deposit-held-item 18 230)

           (deposit-held-item-named :parlyz-heal 55)

           (deposit-held-item 17 184)

           (deposit-held-item 17 40)

           (deposit-held-item-named :TM37 71)

           (deposit-held-item-named :ice-heal 55)

           (deposit-held-item-named :fire-stone 23)

           (deposit-held-item-named :burn-heal 12)

           ;; as a special case, /don't/ close the menu.

           )))

 

 (defn-memo hacking-8

   "Clear cruft away from held item list."

   ([] (hacking-8 (hacking-7)))

   ([script]

      (->> script

           to-held-items

           (toss-held-item 15 1)

           (toss-held-item 14 1)

           (toss-held-item 13 1)

           close-menu

           close-menu)))

 

 (defn-memo hacking-9

   ([] (hacking-9 (hacking-8)))

   ([script]

      (->> script

           activate-rlm-pc

           begin-withdraw

           (widthdraw-pc-item 7 0xFE)

           (widthdraw-pc-item 8 0xFC)

           (widthdraw-pc-item 8 1)

           (widthdraw-pc-item 8 1)

           (widthdraw-pc-item 9 0xFE)

           (multiple-times

            7

            (partial combine-pc-items 2))

           close-menu)))

           

 (defn-memo hacking-10

   ([] (hacking-10 (hacking-9)))

   ([script]

      (->> script

           begin-deposit

           (deposit-held-item 17 230)

           (deposit-held-item-named :parlyz-heal 55)

           (deposit-held-item 14 178)

           (deposit-held-item-named :water-stone 29)

           (deposit-held-item 14 32)

           (deposit-held-item-named :TM18 1)

           (deposit-held-item 13 1)

           (deposit-held-item 13 191)

           (deposit-held-item-named :TM02 98)

           (deposit-held-item-named :TM09 1)

           close-menu)))

 

 (defn-memo hacking-11

   ([] (hacking-11 (hacking-10)))

   ([script]

      (->> script

           begin-withdraw

           (widthdraw-pc-item 3 0xFE)

           (widthdraw-pc-item 4 0xFE)

           (widthdraw-pc-item 5 1)

           (widthdraw-pc-item 5 1)

           (widthdraw-pc-item 5 1)

           (widthdraw-pc-item 5 0xFB)

           (multiple-times

            3

            (partial combine-pc-items 2))

           close-menu)))

 

 (defn-memo hacking-12

   ([] (hacking-12 (hacking-11)))

   ([script]

      (->> script

           begin-deposit

           (deposit-held-item 18 203)

           (deposit-held-item-named :guard-spec 87)

           (deposit-held-item-named :guard-spec 24)

           (deposit-held-item-named :TM05 1)

           (multiple-times

            8

            (partial deposit-held-item 14 1))

           (deposit-held-item 14 55)

           (deposit-held-item-named :x-accuracy 58)

           (deposit-held-item 14 38)

           (deposit-held-item-named :TM13 1)

           (deposit-held-item 13 1)

           (deposit-held-item 13 233)

           close-menu)))

        

 (defn-memo hacking-13

   ([] (hacking-13 (hacking-12)))

   ([script]

      (->> script

           (set-cursor-relative 1)

           (select-menu-entry)

           (toss-pc-item 1 1)

           (toss-pc-item 0 156)

           (toss-pc-item 0 11))))

 

 (defn confirm-pattern []

   (let [start-address (inc pc-item-list-start)

         target-pattern (pc-item-writer-program)

         actual-pattern

         (subvec (vec (memory (second (hacking-13))))

                 start-address

                 (+ start-address (count target-pattern)))]

     (println target-pattern)

     (println actual-pattern)

     (= target-pattern actual-pattern)))

 

 (defn-memo go-to-mansion-for-the-lulz

   ([] (go-to-mansion-for-the-lulz (hacking-13)))

   ([script]

      (->> script

           close-menu

           close-menu

           end-text ;;grr

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

           (walk (repeat 17 ←))

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

           (walk [↓ ← ↑])

           (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓

                  ← ← ← ← ↑ ↑ ↑ ← ↑])

           (talk)

           (scroll-text 2)

           (do-nothing 100)

           close-menu)))

 

 (defn-memo launch-bootstrap-program

   ([] (launch-bootstrap-program

        (go-to-mansion-for-the-lulz)))

   ([script]

      (->> script

           ;; must corrupt item list again by switching pokemon

           activate-start-menu    ;; \

           (set-cursor 0)         ;; |

           select-menu-entry      ;; |

           select-menu-entry      ;; |

           (set-cursor 1)         ;; | -- switch 9th pokemon

           select-menu-entry      ;; |    with 4th pokemon

           (set-cursor 3)         ;; |

           select-menu-entry      ;; |

           close-menu             ;; /

           ;; now, open items and set map-function to

           ;; the program inside the item-computer.

           (set-cursor 1)

           (select-menu-entry)

           (toss-held-item 22 12)

           (switch-held-items 22 40)

           close-all-menus)))

 

 (defn regen-control-checkpoint!

   [] (write-script! (launch-bootstrap-program) "control-checkpoint"))

                     

 (defn control-checkpoint []

   (read-script "control-checkpoint"))

 

 (def increasing-pattern [0x01 0x23 0x45 0x67 0x89 0xAB 0xCD 0xEF])

 

 (defn test-pattern-writing

   ([] (test-pattern-writing increasing-pattern))

   ([pattern]

      (let [moves (bootstrap-pattern pattern)

            pattern-insertion

            (->> (launch-bootstrap-program)

                 (play-moves

                  (take 100 moves)))]

        (println "Input Pattern:")

        (apply println  (map #(format "0x%02X" %) pattern))

        (println "\nMemory Listing:")

        (print-listing (second pattern-insertion)

                       0xD162 (+ 0xD162 (count pattern)))

        (= (subvec (vec (memory (second pattern-insertion)))

                        0xD162 (+ 0xD162 (count pattern)))

           pattern))))

 

 (defn-memo launch-main-bootstrap-program

   ([] (launch-main-bootstrap-program

        (control-checkpoint)

        ;;(launch-bootstrap-program)

        ))

   ([script]

        (->> script

             (play-moves

              (bootstrap-pattern (main-bootstrap-program)))

             (play-moves

              (take 253 (interleave (repeat 1000 [:b])

                                    (repeat 1000 [])))))))

 (def bootstrap-start pokemon-list-start)

 

 (defn test-main-bootstrap-integrety

   []

   (assert

    (= (main-bootstrap-program)

       (subvec

        (vec (memory (second (launch-main-bootstrap-program))))

        pokemon-list-start

        (+ pokemon-list-start (count (main-bootstrap-program)))))))

    

 (defn set-target-address

   "Assumes that the game is under control of the main-bootstrap

    program in MODE-SELECT mode, and sets the target address to which

    jumps/writes will occur."

   [target-address script]

   (let [[target-high target-low] (disect-bytes-2 target-address)]

     (->> script

          (play-moves

           (map buttons

                [set-H-mode target-high 0x00

                 set-L-mode target-low  0x00])))))

 

 (defn write-RAM-segment

   "Assumes that the game is under control of the main-bootstrap

    program in MODE-SELECT mode and that target-address has been

    appropriately set, and writes 255 bytes or less to RAM."

   [segment script]

   (->> script

        (play-moves

         (map buttons

              [write-mode (count segment)]))

        (play-moves (map buttons segment))

        (play-moves [[]])))

 

 (defn write-RAM

   "Assumes that the game is under control of the main-bootstrap

    program in MODE-SELECT mode, and rewrites RAM starting at

    'start-address with 'new-ram."

   [start-address new-ram script]

   (loop [s (set-target-address start-address script)

          to-write new-ram]

     (if (< (count to-write) 0x100)

       (write-RAM-segment to-write s)

       (recur

        (write-RAM-segment (take 0xFF to-write) s)

        (drop 0xFF to-write)))))

           

 (defn transfer-control

   "Assumes that the game is under control of the main-bootstrap

    program in MODE-SELECT mode, and jumps to the target-address."

   [target-address script]

   (->> script

        (set-target-address target-address)

        (play-moves [(buttons jump-mode)])))

 

 

 (def relocated-bootstrap-start

   (+ 90 pokemon-box-1-address))

 

 (defn-memo relocate-main-bootstrap

   ([] (relocate-main-bootstrap (launch-main-bootstrap-program)))

   ([script]

      (->> script

           (do-nothing 2)

           (write-RAM

            relocated-bootstrap-start

            (main-bootstrap-program

             relocated-bootstrap-start))

           (do-nothing 1)

           (transfer-control relocated-bootstrap-start)

           (do-nothing 1))))

 

 (defn gen-new-kernel-checkpoint! []

   (write-script! (do-nothing 10 (relocate-main-bootstrap))

                  "new-kernel"))

 

 (defn new-kernel [] (read-script "new-kernel"))

 

 (def mid-game-data

   (subvec (vec (memory (mid-game)))

           pokemon-list-start

           (+ pokemon-list-start 697)))

 

 (def mid-game-map-address 0x46BC)

 

 (defn-memo set-mid-game-data

   ([] (set-mid-game-data (relocate-main-bootstrap)))

   ([script]

      (->> script

           (do-nothing 10)

           (write-RAM pokemon-list-start

                      mid-game-data))))

 (defn test-set-data

   ([] (test-set-data (relocate-main-bootstrap)))

   ([script]

      (->> script

           (do-nothing 10)

           (write-RAM pokemon-list-start

                      (repeat 500 0xCC)))))

       

 (defn test-mid-game-transfer []

   (= (subvec (vec (memory (second (set-mid-game-data))))

              pokemon-list-start

              (+ pokemon-list-start 500))

      (subvec (vec (memory (mid-game)))

              pokemon-list-start

              (+ pokemon-list-start 500))))

 

 (defn-memo return-to-pokemon-kernel

   ([] (return-to-pokemon-kernel (set-mid-game-data)))

   ([script]

      (let [scratch (+ 200 pokemon-box-1-address)

            return-program

            (flatten

             [0xFB

              0xC3

              (reverse (disect-bytes-2 mid-game-map-address))])]

        (->> script

             (write-RAM scratch return-program)

             (transfer-control scratch)

             (do-nothing 1)))))