rlm@247: (ns com.aurellem.run.bootstrap-0
rlm@320:   (:use (com.aurellem.gb saves gb-driver util
rlm@320:                          items vbm characters money))
rlm@319:   (:use (com.aurellem.run util title save-corruption))
rlm@264:   (:use (com.aurellem.exp item-bridge))
rlm@264:   (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@247: 
rlm@250: (defn-memo boot-root []
rlm@255:   [ [] (root)])
rlm@247:   
rlm@255: (defn-memo to-rival-name
rlm@255:   ([] (to-rival-name (boot-root)))
rlm@255:   ([script]
rlm@319:      (->> script
rlm@255:          title
rlm@255:          oak
rlm@255:          name-entry-rlm
rlm@319:          (scroll-text 5))))
rlm@247: 
rlm@255: (defn-memo name-rival-bootstrap
rlm@255:   ([] (name-rival-bootstrap (to-rival-name)))
rlm@255:   ([script]
rlm@255:      (->> script
rlm@319:          (first-difference [] [:a] AF)
rlm@319:          (first-difference [] [:r] DE)
rlm@255:          (play-moves
rlm@255:           [[]
rlm@313:            [] [] [:r] [] [:d] [:a]           ;; L
rlm@313:            [:r] [] [:r] [] [:r] [] [:r] [] 
rlm@313:            [:r] [] [:d] [] [:d] [:a]         ;; [PK]
rlm@313:            [:u] [] [:l] [] [:l] []
rlm@313:            [:l] [] [:l] [] [:l] [:a]         ;; U
rlm@313:            [:r] [] [:r] [] [:r] []
rlm@313:            [:r] [] [:r] [] [:d] [:a]         ;; [PK]
rlm@313:            [] [:a]                           ;; [PK]
rlm@313:            [] [:a]                           ;; [PK]
rlm@313:            [:r] [] [:d] [:a]                 ;; END
rlm@255:            ]))))
rlm@255: 
rlm@255: (defn-memo leave-house
rlm@255:   ([] (leave-house (name-rival-bootstrap)))
rlm@255:   ([script]
rlm@255:      (->> script
rlm@255:           finish-title
rlm@255:           walk-to-stairs
rlm@255:           walk-to-door
rlm@255:           (walk [↓ ↓]))))
rlm@255: 
rlm@255: (defn-memo to-pallet-town-edge
rlm@255:   ([] (to-pallet-town-edge (leave-house)))
rlm@255:   ([script]
rlm@255:      (->> script
rlm@255:           (walk [→ → → → →
rlm@255:                  ↑ ↑ ↑ ↑ ↑ ↑]))))
rlm@255: 
rlm@257: (defn-memo start-pikachu-battle
rlm@257:   ([] (start-pikachu-battle
rlm@257:        (to-pallet-town-edge)))
rlm@257:   ([script]
rlm@257:      (->> script
rlm@319:           (first-difference [:b] [:b :a] DE)
rlm@319:           scroll-text
rlm@319:           (do-nothing 200)
rlm@319:           (play-moves [[:b]]))))
rlm@257: 
rlm@257: (defn-memo capture-pikachu
rlm@257:   ([] (capture-pikachu (start-pikachu-battle)))
rlm@257:   ([script]
rlm@257:      (->> script
rlm@319:           (scroll-text 3))))
rlm@257: 
rlm@257: (defn-memo go-to-lab
rlm@257:   ([] (go-to-lab (capture-pikachu)))
rlm@257:   ([script]
rlm@257:      (->> script
rlm@319:           end-text
rlm@257:           (scroll-text 5)
rlm@319:           end-text
rlm@319:           ;; oak walks you to his lab; no input required.
rlm@319:           (do-nothing 400))))
rlm@319: 
rlm@319: (defn-memo talk-to-oak-in-lab
rlm@319:   ([] (talk-to-oak-in-lab (go-to-lab)))
rlm@319:   ([script]
rlm@319:      (->> script
rlm@319:           (scroll-text 14)
rlm@319:           end-text)))
rlm@319: 
rlm@319: (defn-memo try-to-get-eevee
rlm@319:   ([] (try-to-get-eevee (talk-to-oak-in-lab)))
rlm@319:   ([script]
rlm@319:      (->> script
rlm@319:           ;; walk to pokeball
rlm@319:           (walk [↓ → →])
rlm@319:           ;; and try to grab it
rlm@319:           (play-moves
rlm@319:            (concat [↑ ↑ [:a]]
rlm@319:                    (repeat 100 [])))
rlm@319:           (scroll-text 10)
rlm@257:           (end-text))))
rlm@257: 
rlm@257: (defn-memo obtain-pikachu
rlm@319:   ([] (obtain-pikachu (try-to-get-eevee)))
rlm@257:   ([script]
rlm@257:      (->> script
rlm@319:           (scroll-text 6)
rlm@319:           (end-text))))
rlm@319:   
rlm@319:           
rlm@258: (defn-memo begin-battle-with-rival
rlm@258:   ([] (begin-battle-with-rival
rlm@258:         (obtain-pikachu)))
rlm@258:   ([script]
rlm@258:      (->> script
rlm@319:           (walk [↓ ↓ ↓])
rlm@260:           (scroll-text 3)
rlm@260:           (end-text)
rlm@260:           (scroll-text))))
rlm@260: 
rlm@319: (defn-memo defeat-eevee
rlm@319:   ([] (defeat-eevee
rlm@260:         (begin-battle-with-rival)))
rlm@260:   ([script]
rlm@260:      (->> script
rlm@313:           (do-nothing 400)
rlm@260:           (play-moves [[:a]])
rlm@260:           (critical-hit)
rlm@319:           (do-nothing 200)
rlm@319:           (scroll-text 2) ;; for eevee's tail-whip
rlm@319:           (do-nothing 10)
rlm@313:           (play-moves [[:a]])
rlm@260:           (critical-hit)
rlm@319:           (do-nothing 200)
rlm@319:           (scroll-text 2) ;; tail whip again
rlm@319:           (do-nothing 10)
rlm@313:           (play-moves [[:a]])
rlm@313:           (critical-hit)
rlm@319:           (do-nothing 200))))
rlm@260: 
rlm@260: (defn-memo finish-rival-text
rlm@260:   ([] (finish-rival-text
rlm@319:        (defeat-eevee)))
rlm@260:   ([script]
rlm@260:      (->> script
rlm@319:           (scroll-text 12)
rlm@260:           (end-text))))
rlm@260: 
rlm@262: (defn-memo pikachu-comes-out
rlm@262:   ([] (pikachu-comes-out
rlm@262:        (finish-rival-text)))
rlm@262:   ([script]
rlm@262:      (->> script
rlm@319:           (scroll-text 8)
rlm@262:           (end-text))))
rlm@260: 
rlm@262: (defn-memo leave-oaks-lab
rlm@262:   ([] (leave-oaks-lab
rlm@262:        (pikachu-comes-out)))
rlm@262:   ([script]
rlm@262:      (->> script 
rlm@319:           (walk [↓ ↓ ↓ ↓ ↓ ↓]))))
rlm@257: 
rlm@271: (defn-memo oaks-lab->pallet-town-edge
rlm@262:   ([] (oaks-lab->pallet-town-edge
rlm@262:        (leave-oaks-lab)))
rlm@262:   ([script]
rlm@262:      (->> script
rlm@319:           (walk [← ← ←
rlm@319:                  ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ →]))))
rlm@264: 
rlm@264: (defn-memo pallet-edge->viridian-mart
rlm@271:   ([] (pallet-edge->viridian-mart true
rlm@264:        (oaks-lab->pallet-town-edge)))
rlm@271:   ([dodge-stupid-guy? script]
rlm@271:      (let [dodge-1 (if dodge-stupid-guy?
rlm@271:                     [→ →]
rlm@271:                     [→])
rlm@271:            dodge-2 (if dodge-stupid-guy?
rlm@271:                      [↑ ↑ ←]
rlm@319:                      [↑ ↑])]
rlm@271:        
rlm@271:        (->> script
rlm@264:           ;; leave straight grass
rlm@264:           (walk-thru-grass
rlm@264:            [↑ ↑ ↑ ↑ ↑])
rlm@313: 
rlm@264:           (walk [↑ ↑ ↑ ↑])
rlm@313: 
rlm@264:           (walk-thru-grass
rlm@264:            [← ← ↑])
rlm@313: 
rlm@264:           (walk [↑ ↑ ↑ ↑ → → → ])
rlm@264: 
rlm@264:           (walk-thru-grass
rlm@264:            [→ ↑ ↑ ←])
rlm@264: 
rlm@264:           (walk
rlm@264:            [← ←
rlm@264:             ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
rlm@264:             → → → → ])
rlm@264: 
rlm@271:           ;; this part is dependent on that
rlm@266:           ;; stupid NPC in the grass patch
rlm@264:           (walk-thru-grass
rlm@271:            (concat dodge-1
rlm@271:                 [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ]))
rlm@271:           
rlm@264:           (walk
rlm@271:            (concat
rlm@271:             dodge-2
rlm@271:             [← ← ←
rlm@271:              ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
rlm@271:              ← ←
rlm@271:              ↑ ↑ ↑ ↑
rlm@271:              → → → → → → → → → →
rlm@271:              ↑ ↑ ↑ ↑ ↑ ↑ ↑])))))) 
rlm@264:             
rlm@266: (defn-memo get-oaks-parcel
rlm@266:   ([] (get-oaks-parcel
rlm@266:        (pallet-edge->viridian-mart)))
rlm@266:   ([script]
rlm@266:      (->> script
rlm@319:           (do-nothing 50)
rlm@266:           (end-text)
rlm@266:           (scroll-text 3)
rlm@266:           (do-nothing 197)
rlm@266:           (play-moves [[:a] []])
rlm@266:           (walk [↓ ↓ → ↓]))))
rlm@266: 
rlm@269: (defn-memo viridian-store->oaks-lab
rlm@269:   ([] (viridian-store->oaks-lab
rlm@269:        (get-oaks-parcel)))
rlm@269:   ([script]
rlm@269:      (->> script
rlm@269:           (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@319:                  ← ← ← ← ← ← ← ← ← 
rlm@269:                  ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269:                  ← ←
rlm@269:                  ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269:                  ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269:                  → → → → → → → →
rlm@319:                  ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@319:                  ← ← ← ← ←
rlm@269:                  ↓ ↓ ↓ ↓
rlm@319:                  ])
rlm@269:           (walk-thru-grass
rlm@269:            [↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@319:           (walk [↓ ↓ ← ↓ ↓ ↓ ←
rlm@319:                  ↓ ↓ ↓ ↓ ↓ ↓
rlm@319:                  → → → ↑])
rlm@319:                 
rlm@319:           (do-nothing 1))))
rlm@269: 
rlm@269:                  
rlm@269: (defn-memo viridian-store->oaks-lab-like-a-boss
rlm@269:   ([] (viridian-store->oaks-lab-like-a-boss
rlm@269:        (get-oaks-parcel)))
rlm@269:   ([script]
rlm@269:      (->> script
rlm@269:           (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@319:                  ← ← ← ← ← ← ← ← ← 
rlm@269:                  ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@269: 
rlm@269:           (walk-thru-grass
rlm@269:            [↓ ↓ ↓ ↓ ↓])
rlm@269: 
rlm@269:           (walk
rlm@269:            [↓ ↓ ← ↓
rlm@319:             ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@319:             → → → ↓])
rlm@269: 
rlm@269:           (walk-thru-grass
rlm@319:            [↓ ↓ ↓])
rlm@269: 
rlm@269:           (walk [↓ ← ← ↓ ↓ ↓ ↓ ↓ ↓])
rlm@269:           
rlm@269:           (walk-thru-grass
rlm@319:            [↓ ↓ ↓ ↓ ↓ ↓])
rlm@269:           
rlm@319:           (walk [↓ ↓ ↓ ← ↓ ↓ ↓ 
rlm@269:                  ↓ ↓ ↓ ↓ ↓
rlm@269:                  → → → ↑]))))
rlm@270: 
rlm@270: (defn-memo deliver-oaks-parcel
rlm@270:   ([] (deliver-oaks-parcel
rlm@270:        (viridian-store->oaks-lab-like-a-boss)))
rlm@270:   ([script]
rlm@270:      (->> script
rlm@270:           (walk [↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
rlm@319:           (play-moves [[] [:a]])
rlm@319:           (scroll-text 13)
rlm@270:           (end-text)
rlm@270:           (do-nothing 200)
rlm@319:           (scroll-text 2)
rlm@270:           (end-text)
rlm@270:           (scroll-text 2)
rlm@270:           (end-text)
rlm@319:           (scroll-text 8)
rlm@270:           (end-text)
rlm@270:           (scroll-text 9)
rlm@270:           (end-text)
rlm@270:           (scroll-text 7)
rlm@319:           (end-text)                    
rlm@319:           (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓]))))
rlm@271: 
rlm@271: (defn-memo return-to-viridian-mart
rlm@271:   ([] (return-to-viridian-mart
rlm@271:        (deliver-oaks-parcel)))
rlm@271:   ([script]
rlm@271:      (->> script
rlm@271:           oaks-lab->pallet-town-edge
rlm@274:           (pallet-edge->viridian-mart false))))
rlm@274: 
rlm@274: (defn-memo walk-to-counter
rlm@274:   ([] (walk-to-counter
rlm@274:        (return-to-viridian-mart)))
rlm@274:   ([script]
rlm@274:      (->> script 
rlm@319:           (walk [↑ ↑ ←]))))
rlm@275: 
rlm@320: 
rlm@320: 
rlm@320: ;; useful addresses
rlm@320: 52262 ;; --- current-cursor-offset
rlm@320: 52278 ;; --- current screen-offset
rlm@320: 
rlm@320: 
rlm@320: (defn exp-item-list []
rlm@320:   (clojure.pprint/pprint
rlm@320:    (apply harmonic-compare 
rlm@320:           (map read-state 
rlm@320:                ["up-1" "down-1"
rlm@320:                 "up-2" "down-2"
rlm@320:                 "up-3" "down-3"
rlm@320:                 "up-4" "down-4"
rlm@320:                 "up-5" "down-5"
rlm@320:                 "up-6"]))))
rlm@321: 
rlm@322: 
rlm@323: ;; turns out that these addresses are the cursor position
rlm@323: ;; for all lists in the game (start list, pokemon list, shop
rlm@323: ;; lists, inventory lists, battle list, basically
rlm@323: ;; everything!)
rlm@322: 
rlm@323: (def list-cursor-offset-address 52262)
rlm@323: (def list-screen-offset-address 52278)
rlm@321: 
rlm@323: (defn list-offset
rlm@321:   ([^SaveState state]
rlm@321:      (let [mem (memory state)]
rlm@321:        (+ (aget mem item-screen-offset-address)
rlm@321:           (aget mem item-cursor-offset-address))))
rlm@321:   ([] (item-offset @current-state)))
rlm@320: 
rlm@320: 
rlm@323: 
rlm@322: (defn exp-item-selection []
rlm@322:   (clojure.pprint/pprint
rlm@322:    (apply memory-compare
rlm@322:           (map read-state
rlm@322:                ["1-item" 
rlm@322:                 "2-items"
rlm@322:                 "3-items"
rlm@322:                 "4-items"
rlm@322:                 ]))))
rlm@322: 
rlm@322: (def item-quantity-selected-address 65432)
rlm@322: 
rlm@322: (defn item-quantity-selected
rlm@322:   ([^SaveState state]
rlm@322:      (aget (memory state) item-quantity-selected-address))
rlm@322:   ([] (item-quantity-selected @current-state)))
rlm@322: 
rlm@323: (defn set-cursor-relative
rlm@323:   "Assumes the arrow keys currently control the cursor.
rlm@323:    Moves the cursor n steps relative to its current
rlm@323:    position."
rlm@323:   [n script]
rlm@323:   (let [key (if (< 0 n) ↓ ↑)]
rlm@323:     (multiple-times
rlm@323:      n (partial repeat-until-different
rlm@323:                 key list-offset) script)))
rlm@322: 
rlm@323: (defn set-cursor
rlm@323:   "Assumes the arrow keys currently control the cursor. Sets
rlm@323:    the cursor to the desired position. Works for any menu
rlm@323:    that uses a cursor including the start menu, item menu,
rlm@323:    pokemon menu, and battle menu."
rlm@323:   [n [moves state :as script]]
rlm@323:   (let [current-position (list-offset state)
rlm@323:         difference (- n current-position)]
rlm@323:     (println difference)
rlm@323:     (set-cursor-relative difference script)))
rlm@323:   
rlm@275: (defn buy-item
rlm@275:   "Assumes that the main item-screen is up, and buys
rlm@275:    quantity of the nth item in the list, assuming that you
rlm@275:    have enough money."
rlm@275:   [n quantity script]
rlm@275:   (if (= 0  quantity)
rlm@275:     script
rlm@275:     (let [after-initial-pause
rlm@275:           (do-nothing 20  script)
rlm@275:           move-to-item
rlm@275:           (reduce (fn [script _]
rlm@275:                     (->> script
rlm@275:                          (play-moves [[:d]])
rlm@275:                          (do-nothing 3)))
rlm@275:                   after-initial-pause
rlm@275:                   (range n))
rlm@275:           select-item
rlm@275:           (play-moves [[:a]] move-to-item)
rlm@275:           request-items
rlm@275:           (reduce (fn [script _]
rlm@275:                     (->> script
rlm@275:                          (play-moves [[:u]])
rlm@275:                          (do-nothing 1)))
rlm@275:                   select-item
rlm@275:                   (range (dec quantity)))
rlm@275:           buy-items
rlm@275:           (->> request-items
rlm@284:                (do-nothing 10)
rlm@275:                (play-moves [[:a]])
rlm@275:                (scroll-text)
rlm@275:                (scroll-text)
rlm@284:                (do-nothing 10)
rlm@275:                (play-moves [[:a]])
rlm@275:                (scroll-text))]
rlm@275:       buy-items)))
rlm@275:      
rlm@275: 
rlm@275: (defn buy-items
rlm@275:   "Given a list of [item-no quantity], buys the quantity
rlm@275:    from the shop's list. Assumes that the item list is
rlm@275:    already up."
rlm@275:   [item-pairs script]
rlm@275:   (let [item-lookup (into {0 0 1 0 2 0 3 0 4 0} item-pairs)
rlm@275:         initial-purchase
rlm@275:         (->> script
rlm@275:              (buy-item 0 (item-lookup 0))
rlm@275:              (buy-item 1 (item-lookup 1))
rlm@275:              (buy-item 2 (item-lookup 2)))]
rlm@275:     (cond
rlm@275:       (and
rlm@275:        (not= 0 (item-lookup 3))
rlm@275:        (not= 0 (item-lookup 4)))
rlm@275:       (->> initial-purchase
rlm@275:            (do-nothing 20)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 3)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 3)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 10)
rlm@275:            (buy-item 0 (item-lookup 3))
rlm@275:            (do-nothing 20)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 3)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 3)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 10)
rlm@275:            (buy-item 0 (item-lookup 4)))
rlm@275:       (and (= 0 (item-lookup 3))
rlm@275:            (not= 0 (item-lookup 4)))
rlm@275:       (->> initial-purchase
rlm@275:            (do-nothing 20)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 3)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 3)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 10)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 10)
rlm@275:            (buy-item 0 (item-lookup 4)))
rlm@275:       (and (not= 0 (item-lookup 3))
rlm@275:            (= 0 (item-lookup 4)))
rlm@275:       (->> initial-purchase
rlm@275:            (do-nothing 20)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 3)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 3)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 10)
rlm@284:            (buy-item 0 (item-lookup 3)))
rlm@284:       (and (= 0 (item-lookup 3))
rlm@284:            (= 0 (item-lookup 4)))
rlm@284:       initial-purchase)))
rlm@275: 
rlm@275: 
rlm@275: (defn test-buy-items
rlm@277:   ([] (test-buy-items
rlm@274:        (walk-to-counter)))
rlm@274:   ([script]
rlm@275:      (->> [(first script) (set-money (second script)
rlm@275:                                      999999)]
rlm@274:           (play-moves
rlm@274:            [[] [:a] []])
rlm@274:           (scroll-text)
rlm@274:           (do-nothing 100)
rlm@274:           (play-moves [[:a]])
rlm@274:           (do-nothing 100)
rlm@275:           (buy-items
rlm@275:            [[0 1]
rlm@275:             [1 15]
rlm@275:             [2 1]
rlm@275:             [3 20]
rlm@275:             [4 95]
rlm@275:             ]))))
rlm@275: 
rlm@275: (defn-memo buy-initial-items
rlm@275:   ([] (buy-initial-items
rlm@275:        (walk-to-counter)))
rlm@275:   ([script]
rlm@275:      (->> script
rlm@275:           (play-moves
rlm@275:            [[] [:a] []])
rlm@274:           (scroll-text)
rlm@274:           (do-nothing 100)
rlm@274:           (play-moves [[:a]])
rlm@274:           (do-nothing 100)
rlm@275:           (buy-items
rlm@275:            [[0 1]
rlm@275:             [1 1]
rlm@275:             [2 1]
rlm@275:             [3 1]
rlm@279:             [4 1]])
rlm@279:           (do-nothing 100)
rlm@279:           (play-moves [[:b]])
rlm@279:           (do-nothing 100)
rlm@279:           (play-moves [[:b]])
rlm@279:           (do-nothing 100)
rlm@284:           (play-moves [[:b] []])
rlm@319:           (first-difference [:b] [:b :start] AF))))
rlm@274: 
rlm@274: 
rlm@280: (defn-memo do-save-corruption
rlm@279:   ([] (do-save-corruption
rlm@279:        (buy-initial-items)))
rlm@279:   ([script]
rlm@279:      (->> script
rlm@319:           (first-difference [] [:d] AF)
rlm@280:           (play-moves [[] [] [] [:d]
rlm@280:                        [] [] [] [:d]
rlm@280:                        [] [] [] [:d]
rlm@280:                        [] [] [:a]])
rlm@280:           scroll-text
rlm@280:           (play-moves
rlm@280:            ;; this section is copied from speedrun-2942 and corrupts
rlm@290:            ;; the save so that the total number of pokemon is set to
rlm@290:            ;; 0xFF, allowing manipulation of non-pokemon data in RAM
rlm@290:            ;; via the pokemon interface.
rlm@280:            [[] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] []
rlm@280:             [] [] [] [] [] [] [] [] [] [] [] [:select] [:restart]])
rlm@280:           (title)
rlm@319:           (first-difference [] [:start] AF)
rlm@319:           (first-difference [] [:a] AF)
rlm@319:           (first-difference [:a] [:a :start] AF))))
rlm@319: 
rlm@319: (def menu do-nothing )
rlm@280: 
rlm@284: (defn-memo corrupt-item-list
rlm@284:   ([] (corrupt-item-list
rlm@284:        (do-save-corruption)))
rlm@284:   ([script]
rlm@284:      (->> script
rlm@284:           (do-nothing 200)
rlm@284:           (menu [↓ [:a]])               ; select "POKEMON" from
rlm@284:                                         ; from main menu
rlm@284:           (menu [↓ ↓ ↓ ↓ ↓ ↓            ; go to 6th pokemon
rlm@284:                  [:a] ↓ [:a]            ; select "switch"
rlm@284:                  ↓ ↓ ↓ [:a]])           ; switch with 9th "pokemon"
rlm@284:                  
rlm@284:           (do-nothing 1))))
rlm@284:                      
rlm@284: (defn-memo get-burn-heals
rlm@284:   ([] (get-burn-heals
rlm@284:        (corrupt-item-list)))
rlm@284:   ([script]
rlm@284:      (->> script
rlm@284:           (menu [[:b] [:b]])
rlm@284:           (menu [[:a]])
rlm@284:           (do-nothing 100)
rlm@284:           (menu [↓ [:a]])
rlm@284:           (do-nothing 100)
rlm@284:           (menu [[:a] ↓ [:a]])
rlm@284:           (scroll-text)
rlm@284:           (menu [[:b][:b]])
rlm@284:           (menu [[:a]])
rlm@284: 
rlm@284:           (do-nothing 50)
rlm@284:           (buy-items [[0 1]])
rlm@284:           (do-nothing 60)
rlm@284:           (menu [[:a]])
rlm@284:           (scroll-text)
rlm@284:           
rlm@284:           (do-nothing 50)
rlm@284:           (buy-items [[0 1]])
rlm@284:           (do-nothing 60)
rlm@284:           ;;(menu [[:a]])
rlm@284:           ;;(scroll-text)
rlm@284:           
rlm@284:           ;;(do-nothing 300)
rlm@284:           ;;(menu [[:b] [:b]])
rlm@284:           ;;(do-nothing 300)
rlm@284: 
rlm@284:           (buy-items [[0 1]
rlm@284:                       [1 1]
rlm@284:                       [1 1]
rlm@284:                       [2 1]
rlm@284:                       [3 1]
rlm@284:                       [4 97]])
rlm@284:                       
rlm@284:           (do-nothing 10))))
rlm@284: 
rlm@284: (defn-memo corrupt-item-list-again
rlm@284:   ([] (corrupt-item-list-again (get-burn-heals)))
rlm@284:   ([script]
rlm@284:      (->> script
rlm@284:           (do-nothing 10)
rlm@284:           (play-moves [[:b]])
rlm@284:           (do-nothing 100)
rlm@284:           (play-moves [[:b]])
rlm@284:           (do-nothing 40)
rlm@284:           (play-moves [[:b]])
rlm@319:           (first-difference [:b] [:start :b] AF)
rlm@284:           (menu [[:a] ↑ ↑ ↑ ↑ ↑         ; get fifth pokemon
rlm@284:                  [:a] ↓ [:a]            ; and corrupt the
rlm@284:                  ↓ ↓ ↓ ↓ ↓ [:a]])       ; item list again by
rlm@284:                                         ; switching it to
rlm@284:           )))                           ; tenth place.
rlm@284:           
rlm@290: (defn-memo viridian-store->viridian-poke-center
rlm@290:   ([] (viridian-store->viridian-poke-center
rlm@290:        (corrupt-item-list-again)))
rlm@290:   ([script]
rlm@290:      (->> script
rlm@290:           (do-nothing 100)
rlm@290:           (play-moves [[:b]])
rlm@290:           (do-nothing 100)
rlm@290:           (play-moves [[:b]])
rlm@290:           (do-nothing 40)
rlm@290:           ;; leave store
rlm@290:           (walk [↓ ↓ 
rlm@290:                  → ↓ ↓])
rlm@290:           (walk [← ← ← ←
rlm@290:                  ↓ ↓ ↓ ↓ ↓ ↓
rlm@290:                  ← ← ← ↑]))))
rlm@290: 
rlm@291: (defn-memo to-poke-center-computer
rlm@290:   ([] (to-poke-center-computer
rlm@290:        (viridian-store->viridian-poke-center)))
rlm@290:   ([script]
rlm@290:      (->> script
rlm@290:           (walk [→ →
rlm@290:                  ↑ ↑ ↑
rlm@290:                  → → → → → → → → → ↑])
rlm@290:           (do-nothing 1))))
rlm@291: 
rlm@291: (defn-memo begin-deposits
rlm@291:   ([] (begin-deposits
rlm@291:        (to-poke-center-computer)))
rlm@291:   ([script]
rlm@291:      (->> script
rlm@291:           ;; access PC
rlm@291:           (scroll-text 2)
rlm@291: 
rlm@291:           ;; access item storage
rlm@291:           (menu [[:a] [:d] [:a]])
rlm@291:           (scroll-text 2)
rlm@291: 
rlm@291:           ;; begin deposit
rlm@291:           (menu [[:d] [:a]])
rlm@291:           (do-nothing 40))))
rlm@291: 
rlm@293: (defn deposit-n-items
rlm@293:   [n script]
rlm@293:   (->> script
rlm@293:        (do-nothing 100)
rlm@293:        (play-moves [[:a]])
rlm@293:        (do-nothing 80)
rlm@293:        (multiple-times
rlm@293:         (dec n)
rlm@293:         (fn [script]
rlm@293:           (->> script
rlm@293:                (play-moves [[:u]])
rlm@293:                (do-nothing 1))))
rlm@293:        (play-moves [[:a]])
rlm@293:        (scroll-text)))
rlm@296: 
rlm@296: (defn deposit-one-item
rlm@296:   [script]
rlm@296:   (->> script
rlm@296:        (do-nothing 100)
rlm@296:        (play-moves [[:a]])
rlm@296:        (do-nothing 80)
rlm@296:        (play-moves [[:a]])
rlm@296:        (scroll-text)))
rlm@293: 
rlm@293: (defn-memo create-header
rlm@291:   ([] (create-header (begin-deposits)))
rlm@291:   ([script]
rlm@291:      (->> script
rlm@293:           (multiple-times 33 deposit-one-item)
rlm@291:           (do-nothing 1))))
rlm@297: 
rlm@297: (defn bootstrap-init []
rlm@297:   [(read-moves "bootstrap-init")
rlm@297:    (read-state "bootstrap-init")])
rlm@296: 
rlm@296: (defn create-bootstrap-program
rlm@296:   ([] (create-bootstrap-program
rlm@296:        (create-header)))
rlm@296:   ([script]
rlm@296:      (->> script
rlm@296:           (do-nothing 120)
rlm@296:           (menu [↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@296:           ;;(deposit-n-items 33)
rlm@296: 
rlm@296:           (menu (repeat 17 ↓))
rlm@296:           
rlm@296: 
rlm@296: 
rlm@296:           (do-nothing 1))))
rlm@296:     
rlm@297: 
rlm@302: (defn test-pc-item-program []
rlm@302:   (-> (read-state "bootstrap-init")
rlm@302:       (set-memory pc-item-list-start 50)
rlm@302:       (set-memory-range
rlm@305:        map-function-address-start [0x8B 0xD5])
rlm@304:       (set-memory-range
rlm@302:        (inc pc-item-list-start)
rlm@302:        (flatten
rlm@304:         [(repeat
rlm@303:           28
rlm@302:           [0xFF 0x01])
rlm@303:          [;;  second part of item manipulation program
rlm@303:           0x00   ;; this starts at address 0xD56C
rlm@303:           0x2A   ;; save (HL)=(target) to A, increment HL
rlm@302: 
rlm@302:           0x00
rlm@303:           0x47   ;; save A to B					
rlm@302: 
rlm@302:           0x00
rlm@303:           0x3A   ;; save (target+1) to A, decrement HL		
rlm@302: 
rlm@302:           0x00
rlm@303:           0x22   ;; A -> target, increment HL [(target+1) -> target]
rlm@302: 
rlm@303:           0x00
rlm@303:           0x70   ;; load B into target+1 [(target) -> target+1]	
rlm@303: 
rlm@303:           0x00
rlm@303:           0xC3   ;; first part of absolute jump
rlm@303: 
rlm@303:           0x0C   ;; return control to pokemon kernel
rlm@302:           0x5F]
rlm@302:          (repeat
rlm@303:           5
rlm@302:           [0xFF 0x01])
rlm@302: 
rlm@303:          [;; first part of item manipulation program
rlm@303:           0x00
rlm@303:           0x21   ;; load target into HL
rlm@302: 
rlm@303:           0x94   ;; this is the target address
rlm@302:           0xD5
rlm@302: 
rlm@303:           0x00   ;; relative jump back to first part
rlm@303:           0x18   
rlm@302: 
rlm@303:           0xE1   ;; of program
rlm@302:           0x01
rlm@302: 
rlm@303:           0xFF   ;; spacer
rlm@302:           0x01
rlm@302:           
rlm@303:           0x04  ;; target ID        (pokeball)
rlm@303:           0x3E  ;; target Quantity  (lemonade)
rlm@302:           ]]))))