(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 list-screen-offset-address)

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

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

      (println "items:" (aget (memory state) item-quantity-selected-address))

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

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

 

 (defn wait-until

   ([script-fn default-key script]

      (let [wait-time

            (- (dec (count (first (script-fn script))))

               (count (first script)))]

        (println "wait-time" wait-time)

        (play-moves (repeat wait-time default-key) script)))

   ([script-fn script]

      (wait-until script-fn [] script)))

 

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

   [n [moves state :as script]]

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

         difference (- n current-position)]

     (set-cursor-relative difference 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]]

   (->> script

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

        (set-cursor* n)))

 

 (defn first-character [state]

   (aget (memory state) text-address))

 

 (defn first-20-characters [state]

   (subvec (vec (memory state)) text-address (+ 20 text-address)))

 

 (defn set-quantity*

   "Set the quantity of an item to buy or sell to the desired value

   using the fewest possible button presses."

   [total-quantity desired-quantity [moves state :as script]]

      (cond (= desired-quantity 1) (do (println "1 of 1") script)

            (= total-quantity desired-quantity)

            (do (println "get everything!")

                (delayed-difference [] ↓ 5 item-quantity-selected

                                    script))

            true

            (let [current-quantity (item-quantity-selected state)

                  loop-point (if (= 0 total-quantity) 0x100 total-quantity)

                  distance (- desired-quantity current-quantity)

                  loop-distance (int(* -1 (Math/signum (float distance))

                                       (- loop-point (Math/abs distance))))

                  best-path (first (sort-by #(Math/abs %)

                                            [distance loop-distance]))

                  direction (if (< 0 best-path) ↑ ↓)]

              (println "best-path" best-path)

              (println "current-quantity" current-quantity)

              (println "desired-quantity" desired-quantity)

              (println "options" [distance loop-distance])

              (reduce

               (fn [script _]

                 (delayed-difference [] direction 5 item-quantity-selected

                                     script))

               script

               (range (Math/abs best-path))))))

 

 (defn set-quantity

   ([total-quantity desired-quantity [moves state :as script]]

      (->> script (wait-until (partial delayed-difference [] [:a] 100

                                       first-20-characters))

           (set-quantity* total-quantity desired-quantity)))

   ([desired-quantity [moves state :as script]]

      (set-quantity 99 desired-quantity script)))

 

 

 (defn activate-start-menu [script]

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

 

 (defn select-menu-entry

   ([test-direction [moves state :as script]]

      (->> script

           (wait-until (partial set-cursor-relative test-direction))

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

   ([[moves state :as script]]

      (select-menu-entry

       1 script)))

          

 (defn restart

   "The two button presses after a restart event are converted to

    blanks. Due to weirdness with the VBM format. To compensate, ensure

    that the two button presses after restart are both blanks."

   [script]

   (play-moves [[:restart] [] []] script))

     

 (defn-memo do-save-corruption

   ([] (do-save-corruption

        (walk-to-counter)))

   ([script] (do-save-corruption 4 script))

   ([n script]

      (->> script

           activate-start-menu

           (set-cursor n)

           select-menu-entry

           select-menu-entry

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

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

             [] [] [] [] [] [] [] [] [] [] [] []])

           (restart)

           (title)

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

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

           

 (defn gen-corrupted-checkpoint! []

   (let [[cor-moves cor-save] (do-save-corruption)]

     (write-moves! cor-moves "cor-checkpoint")

     (write-state! cor-save "cor-checkpoint")))

 

 (defn corrupted-checkpoint []

   [(read-moves "cor-checkpoint")

    (read-state "cor-checkpoint")])

 

 (def menu do-nothing )

 

 

 (defn investivate-close-menu []

   (clojure.pprint/pprint

    (apply harmonic-compare

           (map read-state

                ["start-up-1"

                 "start-down-1"

                 ;;"start-up-2"

                 ;;"start-down-2"

                 ;;"start-up-3"

                 ;;"start-down-3"

                 ;;"computer-up-1"

                 ;;"computer-down-2"

                 "computer-up-2"

                 "computer-down-2"

                 "pokemon-up-1"

                 "pokemon-down-1"

                 "pokemon-up-2"

                 "pokemon-down-2"

                 "item-up-1"

                 "item-down-1"

                 "save-up-1"

                 "save-down-1"

                 "item-nest-up-1"

                 "item-nest-down-1"]))))

 

 (def list-nesting-depth-address 50339)

 

 (defn current-depth

   ([^SaveState state] (aget (memory state) list-nesting-depth-address))

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

   

 

 (defn close-menu [script]

   (delayed-difference

    [] [:b] 50

    current-depth

    script))

                                         

 

 (defn purchase-item

   "Assumes that the cursor is over the desired item, and purchases

    quantity of that item."

   [n script]

   (->> script

        select-menu-entry

        (set-quantity n)

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

        scroll-text

        select-menu-entry

        scroll-text))

 

 (defn-memo corrupt-item-list

   "Corrupt the num-of-items variable by switching a corrupted pokemon

    into out-of-bounds memory."

   ([] (corrupt-item-list

        ;;(corrupted-checkpoint)

        (do-save-corruption)

        ))

   ([script] (corrupt-item-list 1))

   ([n script]

      (->> script

           activate-start-menu

           (set-cursor n)        ; select "POKEMON"

           select-menu-entry     ; from main menu.

           (set-cursor 5)        ; select 6th pokemon

           select-menu-entry

           (set-cursor 1)

           select-menu-entry     

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

           (set-cursor 9)

           select-menu-entry     ; switch 6th with 10th

           close-menu

           close-menu)))

 

 (defn-memo get-lots-of-money

   "Sell 0xFE cancel buttons to make a tremendous amount of money."

   ([] (get-lots-of-money (corrupt-item-list)))

   ([script]

      (->> script

           (first-difference [] [:a] AF) ; talk to shopkeep

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

           (set-cursor 1)

           select-menu-entry

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

           select-menu-entry

           (set-quantity 0xFF 0xF7)

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

           select-menu-entry

           close-menu)))

 

 (defn note [str script]

   (println str) script)

 

 (defn-memo buy-bootstrapping-items

   "Buy items that will become part of the bootstrapping

    program."

   ([] (buy-bootstrapping-items (get-lots-of-money)))

   ([script]

      (->> script

           close-menu

           select-menu-entry

           (purchase-item 1)        ; buying a pokeball overflows

                                    ; the item-counter from 0xFF to 0x00

                                    ; repairing the item-list.

           (set-cursor 1)   

           (purchase-item 1)        ; these other items are here to 

                                    ; protect the burn heals when the 

           (set-cursor 2)           ; item list is corrupted again.

           (purchase-item 1)

 

           (set-cursor 3)

           (purchase-item 1)

 

           (set-cursor 4)           ; 95 burn-heals spells out the

           (purchase-item 96)       ; return address to the pokemon

                                    ; kernel. 96 so that they can be

                                    ; deposited without causing a shift.

 

           close-menu               ; stop talking to shopkeep

           (wait-until select-menu-entry)

           (play-moves [[:b]])

           end-text)))

 

 (defn-memo corrupt-item-list-again

   ([] (corrupt-item-list-again (buy-bootstrapping-items)))

   ([script]

      (->> script

           activate-start-menu             

           (set-cursor-relative 0)                   

           select-menu-entry               

 

           ;; repair list-offset for pokemon-list

           (set-cursor-relative -1)

 

           (set-cursor 4)                  ; switching it to    

           select-menu-entry               ; tenth place.       

           (set-cursor 1)

           select-menu-entry               ; select "switch" on 5th

 

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

           (set-cursor 9)                  ; goto 10th pokemon

           select-menu-entry               ; do switch

           close-menu

           close-menu)))

 

 (defn-memo leave-viridian-store

   ([] (leave-viridian-store (corrupt-item-list-again)))

   ([script]

      (->> script

           ;; leave store

           (walk [↓ ↓ → ↓]))))

 

 (defn force-encounter [direction script]

   (delayed-improbability-search

    600

    #(search-string % "Wild")

    (partial move direction) script))

                                 

 (defn-memo fight-wild-pokemon

   ([] (fight-wild-pokemon (leave-viridian-store)))

   ([script]

      (->> script

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

                  ← ← ← ← ← ← ← ←  

                  ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])

           (force-encounter →))))

 

 (defn-memo run-from-pokemon

   ([] (run-from-pokemon (fight-wild-pokemon)))

   ([script]

      (->> script

           (scroll-text)

           (play-moves [[:a]])

           (wait-until select-menu-entry)

           (set-cursor 1)

           (first-difference [] → AF)

           (scroll-text)

           (scroll-text))))

 

 (defn-memo to-poke-center-computer

   ([] (to-poke-center-computer

        (run-from-pokemon)))

   ([script]

      (->> script

           (walk-thru-grass [→ → ↑])

           (walk [↑ ← ← ←

                  ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑

                  ← ←

                  ↑ ↑ ↑ ↑

                  → → → → ↑])

           (walk [→ → 

                  ↑ ↑ ↑

                  → → → → → → → → →])

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

           

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

           ]]))))

 

 

 

 

 

 (defn basic-writer [target-address limit return-address]

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

         [return-high return-low] (disect-bytes-2 return-address)]

     (flatten

      [0xF3 ;; disable interrupts

 

       0x1E  ;; load limit into E

       limit

 

       0x21 ;; load target into HL

       target-low

       target-high

 

       ;; load 1 into C.

       0x0E   ;; C == 1 means input-first nybble

       0x01   ;; C == 0 means input-second nybble

       

       ;; Input Section

 

       0x3E ;; load 0x20 into A, to measure dpad

       0x20 

 

       0xE0 ;; load A into [FF00]

       0x00

 

       0xF0 ;; load 0xFF00 into A to get

       0x00 ;; d-pad presses

 

       0xE6

       0x0F ;; select bottom four bits of A

 

       0xB8 ;; see if input is different (CP A B)

 

       0x28 ;; repeat above steps if input is not different

            ;; (jump relative backwards if B != A)

       0xF5 ;; (literal -11) 

 

       0x47 ;; load A into B

       

       0x0D ;; dec C

       ;; branch based on C:

       0x20 ;; JR NZ

       0x07 ;; skip "input first nybble" below

 

       

       ;; input first nybble

      

       0xCB

       0x37  ;; swap nybbles on A

 

       0x57  ;; A -> D

 

       0x18

       0xEC  ;; literal -20 -- go back to input section

 

       ;; input second nybble

 

       0x0C ;; inc C

       

       0xE6 ;; select bottom bits

       0x0F

 

       0xB2 ;; (OR A D) -> A

 

       0x22 ;; (do (A -> (HL)) (INC HL))

 

       0x1D ;; (DEC E)

 

       0x20 ;; jump back to input section if not done

       0xE4 ;; literal -28

 

       0xFB ;; re-enable interrupts

       

       0xC3

       return-low

       return-high ])))

 

 

 (defn test-basic-writer []

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

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

       (set-memory-range

        map-function-address-start

        (reverse (disect-bytes-2 (inc pc-item-list-start))))

       (set-memory-range

        (inc pc-item-list-start)

        (basic-writer 0xD162 10 0x5F0C))))

 

 (defn debug-basic-writer []

   (PC! (test-basic-writer) (inc pc-item-list-start)))

 

 (defn d-ticks [state n]

   (reduce (fn [state _] (d-tick state))

           state (range n)))

 

 (defn d-print [state message]

   (println message) state)

 

 (defn dddd

   []

   (-> (debug-basic-writer)

       (d-ticks 20)

       (set-memory 0xFF00 0xFF)

       (d-print "============== second cycle")

       (d-ticks 14)

       (d-print "============== end")

       (d-ticks 20)))

 

 ;;TMs at celadon store ---

 ;;01 (any-number) mega punch

 ;;02 (any-number) razor wind

 ;;05 (any-number) mega kick 

 ;;07 (any-number) hyper beam

 ;;09 (any-number) take down

 ;;13 (only 1)     ice beam

 ;;17 (any-number) submission

 ;;18 (only 1)     counter

 ;;32 (any-number) double team

 ;;33 (any-number) reflect

 ;;37 (any-number) egg bomb

 ;;48 (only 1)     rock slide

 ;;49 (only 1)     tri attack

 

 

 ;; no-ops

 ;; 0x00

 ;; 0xB8 - 0xBF (compares) :garbage

 ;; 0x3F clear carry flag :s.s.ticket

 ;; 0x37 set carry flag :guard-spec       [!]

 ;; 0x33 increment SP :poke-doll          [!]

 ;; 0x3B decrement SP :coin

 

 ;;0x7F A->A :garbage

 ;;0x40 B->B :gold-teeth

 ;;0x49 C->C :poke-flute

 ;;0x52 D->D :elixer

 ;;0x5B E->E :garbage

 ;;0x6D L->L :garbage

 ;;0x64 H->H :garbage

 

 

 ;;0xC5 push BC :HM02

 ;;0xD5 push DE :TM13 (ice-beam)

 ;;0xE5 push HL :TM29 (psychic)

 ;;0xF5 push AF :TM45 (thunder-wave)

 

 ;; 0xA7 (AND A A) :garbage

 ;; 0xB7 (OR  A A) :garbage

 

 ;; 0x2F (CPL A) :leaf-stone

 

 

 (defn item-writer

   "This is the basic writer, optimized to be made of valid

    item-quantity pairs."

   [target-address limit return-address]

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

         [return-high return-low] (disect-bytes-2 return-address)]

     (flatten

      [

       ;;0xC5 ;; push junk onto stack

       ;;0xD5

       ;;0xE5

       ;;0xF5

       0x33  ;; (item-hack) set increment stack pointer no-op

       0x1E  ;; load limit into E

       limit

       0x3F  ;; (item-hack) set carry flag no-op

 

       ;; load 2 into C.

       0x0E   ;; C == 1 means input-first nybble

       0x04   ;; C == 0 means input-second nybble

 

       0x21 ;; load target into HL

       target-low

       target-high

       0x37 ;; (item-hack) set carry flag no-op

 

       0x2F ;; (item-hack) cpl A

       0x2F ;; (item-hack) cpl A --together a spacer no-op

       

       0x00 ;; (item-hack) no-op

       0xF3 ;; disable interrupts

       ;; Input Section

 

       0x3E ;; load 0x20 into A, to measure buttons

       0x10 

 

       0x00 ;; (item-hack) no-op

       0xE0 ;; load A into [FF00]

       0x00

 

       0xF0 ;; load 0xFF00 into A to get

       0x00 ;; button presses

       

       0xE6

       0x0F ;; select bottom four bits of A

       0x37 ;; (item-hack) set carry flag no-op

 

       0x00 ;; (item-hack) no-op

       0xB8 ;; see if input is different (CP A B)

 

       0x00 ;; (item-hack) (INC SP)

       0x28 ;; repeat above steps if input is not different

            ;; (jump relative backwards if B != A)

       0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)

 

       0x47 ;; load A into B

       

       0x0D ;; dec C

       0x37 ;; (item-hack) set-carry flag

       ;; branch based on C:

       0x20 ;; JR NZ

       23 ;; skip "input second nybble" and "jump to target" below

       

       ;; input second nybble

 

       0x0C ;; inc C

       0x0C ;; inc C

 

       0x00 ;; (item-hack) no-op

       0xE6 ;; select bottom bits

       0x0F

       0x37 ;; (item-hack) set-carry flag no-op

 

       0x00 ;; (item-hack) no-op

       0xB2 ;; (OR A D) -> A

 

       0x22 ;; (do (A -> (HL)) (INC HL))

 

       0x1D ;; (DEC E)

 

       0x00 ;; (item-hack) 

       0x20 ;; jump back to input section if not done

       0xDA ;; literal -36 == TM 18 (counter)

       0x01 ;; (item-hack) set BC to literal (no-op)

 

       ;; jump to target

       0x00  ;; (item-hack) these two bytes can be anything.

       0x01 

 

       0x00   ;; (item-hack) no-op

       0xBF   ;; (CP A A) ensures Z

       

       0xCA   ;; (item-hack) jump if Z

       return-low

       return-high

       0x01   ;; (item-hack) will never be reached.

      

 

       

       ;; input first nybble

       0x00

       0xCB

       0x37  ;; swap nybbles on A

 

       0x57  ;; A -> D

 

       0x37  ;; (item-hack) set carry flag no-op

       0x18  ;; relative jump backwards

       0xCD  ;; literal -51 == TM05; go back to input section

       0x01  ;; (item-hack) will never reach this instruction

 

        ])))

 

 (defn test-item-writer []

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

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

       (set-memory-range

        map-function-address-start

        (reverse (disect-bytes-2 (inc pc-item-list-start))))

       (set-memory-range

        (inc pc-item-list-start)

        (item-writer 0xD162 201 0xD162))))

 

 (defn item-writer-state []

   (read-state "item-writer"))

 

 (defn test-item-writer-2 []

   (let [orig (item-writer-state)]

     (-> orig

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

     (run-moves (reduce concat

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

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

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