(ns com.aurellem.exp.item-bridge

   (:use (com.aurellem.gb saves util constants gb-driver vbm items assembly))

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

   ;;(:use (com.aurellem.exp pokemon))

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

 

 (defn corrupt-item-state []

   (second (destroy-item-end-of-list-marker)))

 

 (defn corrupt-item-state []

   (read-state "corrupt-items"))

 

 (defn view-memory-range

   ([start end]

      (view-memory-range

       @current-state start end))

   ([state start end]

      (dorun

       (map (fn [loc val]

              (println (format "%04X : %02X" loc val)))

            (range start end) (subvec (vec (memory state)) start end)))

      state))

 

 (defn almost-broken

   "if one more memory location is turned into 0x03, the game crashes."

   [n]

   (view-memory-range

    (set-inv-mem (mid-game)

                 (concat [0xFF] (repeat 64 0x03)

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

                                 (+ item-list-start 65)

                                 (+ item-list-start 65 n))

                         (repeat (- 255 65 n) 0x03)))

    item-list-start (+ item-list-start 255)))

 

 (defn actually-broken

   "if this memory location is turned into 0x03, the game crashes."

   []

   (set-memory (mid-game) 0xD35D 0x03))

 

 

 ;; (almost-broken 20) more or less works

 

 (defn capture-program-counter

   "records the program counter for each tick"

   [^SaveState state ticks]

   (let [i (atom 0)]

     (reduce (fn [[program-counters state] _]

               (println (swap! i inc))

                [(conj program-counters (PC state))

                 (tick state)])

               [[] state]

               (range ticks))))

 

 

 (defn capture-program-counter

   [^SaveState state ticks]

   (tick state)

   

   (loop [i 0

          pcs []]

     (if (= i ticks)

       (filter (partial < 0x2000)(sort (set pcs)))

       (do 

         (com.aurellem.gb.Gb/tick)

         (recur (inc i)

                (conj pcs (first (registers))))))))

 

 (defn loop-program []

   [0x00     ;0xD31D  ;; disable-interrupts

 

    0xC3     ;; loop forever

    0x1D

    0xD3])

 

 (def map-function-address-start 0xD36D)

 

 (defn test-loop []

   (continue!

    (-> (mid-game) 

        (set-memory-range 0xD31D (loop-program))

        (set-memory-range

         map-function-address-start

         [0xD3 0x1D]))))

        

 (defn-memo corrupt-moves []

   (concat

    (first

     (->>

      [[] (mid-game)]

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

      (advance [] [:d])

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

      scroll-text

      (play-moves

       ;; this section is copied from speedrun-2942

       ;; and corrupts the save so that the end-of-list marker

       ;; for the pokemon roster is destroyed, but the save is still

       ;; playable.

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

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

      (title)

      (advance [] [:start])

      (advance [] [:a])

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

    [[]]))

 

 (defn corrupt

   "enter the codes to destroy the

    pokemon list using save corruption"

   ([^SaveState state]

   (run-moves

    state

    (corrupt-moves)))

   ([] (corrupt @current-state)))

 

 (defn mid-game-corrupt []

   (read-state "corrupt-mid-game"))

 

 (defn gen-start-game-corrupt []

   (->> (second (intro))

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

        (play-moves (corrupt-moves))))

 

 (defn start-game-corrupt []

   (read-state "corrupt-start-game"))

 

 (defn test-memory-fun [n]

   (capture-program-counter

    (set-memory-range

     (tick (mid-game))

     0xD36D

     [0 0])

    n))

 

 ;;(def good (test-memory-fun 17000))

 

 ;;(def bad (test-memory-fun 18000))

 

 

 

 (defn menu-open-state []

   (read-state "menu-open"))

 

 (defn prepare-memory

   ([^SaveState state]

      (-> state

          (set-memory-range 0xD31D (loop-program))

          (set-memory-range 0xD36D [0x1D 0xD3])))

   ([] (prepare-memory @current-state)))

 

 (def memory-function-address-start 0xD36D)

 

 (defn read-map-function-address

   ([^SaveState state]

      (let [mem (memory state)]

        [(aget mem memory-function-address-start)

         (aget mem (inc memory-function-address-start))]))

   ([] (read-map-function-address @current-state)))

 

 (defn succesful-PC-capture

   "This function demonstrates successful PC capturing by

    setting 0xD36D to the value of the start location of

    a specially prepared program.

 

    You must run the function and then exit the open menu

    to see the effect."

   []

   (dorun

    (map #(println (Integer/toHexString %))

         (capture-program-counter 

          (prepare-memory (menu-open-state))

          9000000))))

 

 (defn trampoline-assembly [^SaveState state]

   (flatten

    [0x3E ;; 

     0x3E ;; load lemonade into A

     

     0xEA

     0x1D

     0xD3 ;; set first item to lemonade

     

     0xC3 ;; return control to the game via absolute jump.

     (read-map-function-address state)

     ]))

 

 (defn test-trampoline

   "Demonstrates item-program execution via the map-function that

    returns control to the main pokemon game after one loop."

   [assembly-fn state]

   (let [insertion-address 0xD33D

         insertion-address-bits [0x3D 0xD3]]

   (->

    state

    (set-memory-range

     insertion-address

     (assembly-fn state))

    (set-memory-range 

     memory-function-address-start

     insertion-address-bits))))

 

 (def lemonade-trampoline

   (partial test-trampoline

            trampoline-assembly

            (menu-open-state)))

 

 (defn trampoline-assembly-burn-heal [^SaveState state]

   (flatten

    [0x3E ;; 

     0x3E ;; load lemonade into A

     

     0xEA

     0x1D

     0xD3 ;; set first item to lemonade

     

     0xC3 ;; return control to the game via absolute jump

     0x0C ;; to Route 3's map-function

     0x55

     ]))

 

 

 

 (def pc-item-list-start 0xD539)

 (def pc-item-list-width 101)

 

 (def corrupted-items-width 512)

 

 (defn items-record

   ([^SaveState state]

      (subvec (vec (memory state))

              item-list-start

              (+ item-list-start corrupted-items-width)))

   ([] (items-record @current-state)))

 

 (defn pc-items-record

   ([^SaveState state]

      (subvec (vec (memory state))

              pc-item-list-start

              (+ pc-item-list-width pc-item-list-start)))

   ([] (pc-items-record @current-state)))

              

 (defn print-listing-items

   ([^SaveState state]

      (print-listing state item-list-start

                     (+ item-list-start corrupted-items-width))

      state)

   ([] (print-listing-items @current-state)))

 

 (defn print-listing-pc-items

   ([^SaveState state]

      (print-listing

       state

       pc-item-list-start

       (+ pc-item-list-width pc-item-list-start))

      state)

   ([] (print-listing-pc-items @current-state)))