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@333:            [:u] [] [:l] [] [:l] []
rlm@333:            [:l] [] [:l] [] [:l] [:a]         ;; U
rlm@333:            [:r] [] [:r] [] [:r] []
rlm@333:            [: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@333:            [↓ ↓ ↓])
rlm@269: 
rlm@333:           (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@327:        (+ (aget mem list-screen-offset-address)
rlm@327:           (aget mem list-cursor-offset-address))))
rlm@327:   ([] (list-offset @current-state)))
rlm@320: 
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@329:      (println "items:" (aget (memory state) item-quantity-selected-address))
rlm@322:      (aget (memory state) item-quantity-selected-address))
rlm@322:   ([] (item-quantity-selected @current-state)))
rlm@322: 
rlm@368: (defn wait-until
rlm@368:   ([script-fn default-key script]
rlm@368:      (let [wait-time
rlm@368:            (- (dec (count (first (script-fn script))))
rlm@368:               (count (first script)))]
rlm@368:        (println "wait-time" wait-time)
rlm@368:        (play-moves (repeat wait-time default-key) script)))
rlm@368:   ([script-fn script]
rlm@368:      (wait-until script-fn [] script)))
rlm@368: 
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@324:      (Math/abs n)
rlm@325:      (partial first-difference 
rlm@325:       [] key list-offset)
rlm@324:      script)))
rlm@322: 
rlm@368: (defn set-cursor*
rlm@368:   [n [moves state :as script]]
rlm@368:   (let [current-position (list-offset state)
rlm@368:         difference (- n current-position)]
rlm@368:     (set-cursor-relative difference script)))
rlm@368: 
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@368:   (->> script
rlm@368:        (wait-until (partial set-cursor-relative 1))
rlm@368:        (set-cursor* n)))
rlm@329: 
rlm@368: (defn first-character [state]
rlm@368:   (aget (memory state) text-address))
rlm@368: 
rlm@369: (defn first-20-characters [state]
rlm@369:   (subvec (vec (memory state)) text-address (+ 20 text-address)))
rlm@369: 
rlm@368: (defn set-quantity*
rlm@329:   "Set the quantity of an item to buy or sell to the desired value
rlm@329:   using the fewest possible button presses."
rlm@368:   [total-quantity desired-quantity [moves state :as script]]
rlm@345:      (cond (= desired-quantity 1) (do (println "1 of 1") script)
rlm@345:            (= total-quantity desired-quantity)
rlm@345:            (do (println "get everything!")
rlm@345:                (delayed-difference [] ↓ 5 item-quantity-selected
rlm@345:                                    script))
rlm@345:            true
rlm@345:            (let [current-quantity (item-quantity-selected state)
rlm@345:                  loop-point (if (= 0 total-quantity) 0x100 total-quantity)
rlm@345:                  distance (- desired-quantity current-quantity)
rlm@345:                  loop-distance (int(* -1 (Math/signum (float distance))
rlm@345:                                       (- loop-point (Math/abs distance))))
rlm@345:                  best-path (first (sort-by #(Math/abs %)
rlm@345:                                            [distance loop-distance]))
rlm@345:                  direction (if (< 0 best-path) ↑ ↓)]
rlm@345:              (println "best-path" best-path)
rlm@345:              (println "current-quantity" current-quantity)
rlm@345:              (println "desired-quantity" desired-quantity)
rlm@345:              (println "options" [distance loop-distance])
rlm@345:              (reduce
rlm@345:               (fn [script _]
rlm@345:                 (delayed-difference [] direction 5 item-quantity-selected
rlm@345:                                     script))
rlm@345:               script
rlm@345:               (range (Math/abs best-path))))))
rlm@368: 
rlm@368: (defn set-quantity
rlm@368:   ([total-quantity desired-quantity [moves state :as script]]
rlm@369:      (->> script (wait-until (partial delayed-difference [] [:a] 100
rlm@369:                                       first-20-characters))
rlm@369:           (set-quantity* total-quantity desired-quantity)))
rlm@330:   ([desired-quantity [moves state :as script]]
rlm@330:      (set-quantity 99 desired-quantity script)))
rlm@275: 
rlm@368: 
rlm@331: (defn activate-start-menu [script]
rlm@331:   (first-difference [:b] [:b :start] AF script))
rlm@331: 
rlm@345: (defn select-menu-entry
rlm@345:   ([test-direction [moves state :as script]]
rlm@345:      (->> script
rlm@345:           (wait-until (partial set-cursor-relative test-direction))
rlm@345:           (play-moves [[] [:a] []])))
rlm@345:   ([[moves state :as script]]
rlm@345:      (select-menu-entry
rlm@345:       1 script)))
rlm@345:          
rlm@336: (defn restart
rlm@336:   "The two button presses after a restart event are converted to
rlm@336:    blanks. Due to weirdness with the VBM format. To compensate, ensure
rlm@336:    that the two button presses after restart are both blanks."
rlm@336:   [script]
rlm@336:   (play-moves [[:restart] [] []] script))
rlm@336:     
rlm@593: (defn do-save-corruption
rlm@329:   ([] (do-save-corruption
rlm@275:        (walk-to-counter)))
rlm@345:   ([script] (do-save-corruption 4 script))
rlm@345:   ([n script]
rlm@275:      (->> script
rlm@331:           activate-start-menu
rlm@345:           (set-cursor n)
rlm@331:           select-menu-entry
rlm@593: 
rlm@593:           ;; say yes to save game
rlm@593:           ;; first-difference is faster than select-menu-entry
rlm@593:           ;; for this special case
rlm@593:           ;;select-menu-entry 
rlm@593:           (first-difference [:b] [:a] AF)
rlm@593: 
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@336:             [] [] [] [] [] [] [] [] [] [] [] []])
rlm@336:           (restart)
rlm@280:           (title)
rlm@319:           (first-difference [] [:start] AF)
rlm@329:           (first-difference [] [:a] AF))))
rlm@329:           
rlm@329: (defn gen-corrupted-checkpoint! []
rlm@329:   (let [[cor-moves cor-save] (do-save-corruption)]
rlm@329:     (write-moves! cor-moves "cor-checkpoint")
rlm@329:     (write-state! cor-save "cor-checkpoint")))
rlm@329: 
rlm@329: (defn corrupted-checkpoint []
rlm@329:   [(read-moves "cor-checkpoint")
rlm@329:    (read-state "cor-checkpoint")])
rlm@319: 
rlm@319: (def menu do-nothing )
rlm@280: 
rlm@345: 
rlm@345: (defn investivate-close-menu []
rlm@345:   (clojure.pprint/pprint
rlm@345:    (apply harmonic-compare
rlm@345:           (map read-state
rlm@345:                ["start-up-1"
rlm@345:                 "start-down-1"
rlm@345:                 ;;"start-up-2"
rlm@345:                 ;;"start-down-2"
rlm@345:                 ;;"start-up-3"
rlm@345:                 ;;"start-down-3"
rlm@345:                 ;;"computer-up-1"
rlm@345:                 ;;"computer-down-2"
rlm@345:                 "computer-up-2"
rlm@345:                 "computer-down-2"
rlm@345:                 "pokemon-up-1"
rlm@345:                 "pokemon-down-1"
rlm@345:                 "pokemon-up-2"
rlm@345:                 "pokemon-down-2"
rlm@345:                 "item-up-1"
rlm@345:                 "item-down-1"
rlm@345:                 "save-up-1"
rlm@345:                 "save-down-1"
rlm@345:                 "item-nest-up-1"
rlm@345:                 "item-nest-down-1"]))))
rlm@345: 
rlm@345: (def list-nesting-depth-address 50339)
rlm@345: 
rlm@345: (defn current-depth
rlm@345:   ([^SaveState state] (aget (memory state) list-nesting-depth-address))
rlm@345:   ([] (current-depth @current-state)))
rlm@345:   
rlm@345: 
rlm@330: (defn close-menu [script]
rlm@345:   (delayed-difference
rlm@345:    [] [:b] 50
rlm@345:    current-depth
rlm@345:    script))
rlm@345:                                         
rlm@330: 
rlm@330: (defn purchase-item
rlm@330:   "Assumes that the cursor is over the desired item, and purchases
rlm@330:    quantity of that item."
rlm@330:   [n script]
rlm@330:   (->> script
rlm@330:        select-menu-entry
rlm@330:        (set-quantity n)
rlm@330:        (first-difference [] [:a] AF)
rlm@330:        scroll-text
rlm@330:        select-menu-entry
rlm@330:        scroll-text))
rlm@330: 
rlm@337: (defn-memo corrupt-item-list
rlm@329:   "Corrupt the num-of-items variable by switching a corrupted pokemon
rlm@329:    into out-of-bounds memory."
rlm@284:   ([] (corrupt-item-list
rlm@336:        ;;(corrupted-checkpoint)
rlm@336:        (do-save-corruption)
rlm@331:        ))
rlm@345:   ([script] (corrupt-item-list 1))
rlm@345:   ([n script]
rlm@284:      (->> script
rlm@330:           activate-start-menu
rlm@345:           (set-cursor n)        ; select "POKEMON"
rlm@330:           select-menu-entry     ; from main menu.
rlm@330:           (set-cursor 5)        ; select 6th pokemon
rlm@330:           select-menu-entry
rlm@329:           (set-cursor 1)
rlm@330:           select-menu-entry     
rlm@329:           (repeat-until-different [] list-offset) 
rlm@329:           (set-cursor 9)
rlm@330:           select-menu-entry     ; switch 6th with 10th
rlm@330:           close-menu
rlm@333:           close-menu)))
rlm@329: 
rlm@337: (defn-memo get-lots-of-money
rlm@329:   "Sell 0xFE cancel buttons to make a tremendous amount of money."
rlm@329:   ([] (get-lots-of-money (corrupt-item-list)))
rlm@329:   ([script]
rlm@329:      (->> script
rlm@330:           (first-difference [] [:a] AF) ; talk to shopkeep
rlm@329:           (repeat-until-different [] list-offset)
rlm@329:           (set-cursor 1)
rlm@330:           select-menu-entry
rlm@329:           (repeat-until-different [] list-offset)
rlm@330:           select-menu-entry
rlm@332:           (set-quantity 0xFF 0xF7)
rlm@332:           (first-difference [] [:a] AF)
rlm@332:           select-menu-entry
rlm@333:           close-menu)))
rlm@329: 
rlm@330: (defn note [str script]
rlm@330:   (println str) script)
rlm@329: 
rlm@337: (defn-memo buy-bootstrapping-items
rlm@330:   "Buy items that will become part of the bootstrapping
rlm@330:    program."
rlm@330:   ([] (buy-bootstrapping-items (get-lots-of-money)))
rlm@284:   ([script]
rlm@284:      (->> script
rlm@330:           close-menu
rlm@330:           select-menu-entry
rlm@330:           (purchase-item 1)        ; buying a pokeball overflows
rlm@330:                                    ; the item-counter from 0xFF to 0x00
rlm@330:                                    ; repairing the item-list.
rlm@330:           (set-cursor 1)   
rlm@330:           (purchase-item 1)        ; these other items are here to 
rlm@330:                                    ; protect the burn heals when the 
rlm@330:           (set-cursor 2)           ; item list is corrupted again.
rlm@330:           (purchase-item 1)
rlm@284: 
rlm@330:           (set-cursor 3)
rlm@330:           (purchase-item 1)
rlm@284: 
rlm@330:           (set-cursor 4)           ; 95 burn-heals spells out the
rlm@330:           (purchase-item 96)       ; return address to the pokemon
rlm@330:                                    ; kernel. 96 so that they can be
rlm@330:                                    ; deposited without causing a shift.
rlm@284: 
rlm@330:           close-menu               ; stop talking to shopkeep
rlm@330:           (wait-until select-menu-entry)
rlm@330:           (play-moves [[:b]])
rlm@330:           end-text)))
rlm@330: 
rlm@337: (defn-memo corrupt-item-list-again
rlm@330:   ([] (corrupt-item-list-again (buy-bootstrapping-items)))
rlm@284:   ([script]
rlm@284:      (->> script
rlm@330:           activate-start-menu             
rlm@330:           (set-cursor-relative 0)                   
rlm@330:           select-menu-entry               
rlm@330: 
rlm@330:           ;; repair list-offset for pokemon-list
rlm@330:           (set-cursor-relative -1)
rlm@330: 
rlm@330:           (set-cursor 4)                  ; switching it to    
rlm@330:           select-menu-entry               ; tenth place.       
rlm@330:           (set-cursor 1)
rlm@330:           select-menu-entry               ; select "switch" on 5th
rlm@330: 
rlm@330:           (repeat-until-different [] list-offset)
rlm@330:           (set-cursor 9)                  ; goto 10th pokemon
rlm@330:           select-menu-entry               ; do switch
rlm@330:           close-menu
rlm@331:           close-menu)))
rlm@333: 
rlm@337: (defn-memo leave-viridian-store
rlm@333:   ([] (leave-viridian-store (corrupt-item-list-again)))
rlm@290:   ([script]
rlm@290:      (->> script
rlm@290:           ;; leave store
rlm@336:           (walk [↓ ↓ → ↓]))))
rlm@333: 
rlm@333: (defn force-encounter [direction script]
rlm@333:   (delayed-improbability-search
rlm@333:    600
rlm@333:    #(search-string % "Wild")
rlm@333:    (partial move direction) script))
rlm@333:                                 
rlm@337: (defn-memo fight-wild-pokemon
rlm@333:   ([] (fight-wild-pokemon (leave-viridian-store)))
rlm@333:   ([script]
rlm@333:      (->> script
rlm@333:           (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@333:                  ← ← ← ← ← ← ← ←  
rlm@333:                  ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@333:           (force-encounter →))))
rlm@333: 
rlm@337: (defn-memo run-from-pokemon
rlm@333:   ([] (run-from-pokemon (fight-wild-pokemon)))
rlm@333:   ([script]
rlm@333:      (->> script
rlm@333:           (scroll-text)
rlm@336:           (play-moves [[:a]])
rlm@333:           (wait-until select-menu-entry)
rlm@333:           (set-cursor 1)
rlm@333:           (first-difference [] → AF)
rlm@333:           (scroll-text)
rlm@333:           (scroll-text))))
rlm@290: 
rlm@337: (defn-memo to-poke-center-computer
rlm@290:   ([] (to-poke-center-computer
rlm@333:        (run-from-pokemon)))
rlm@290:   ([script]
rlm@290:      (->> script
rlm@336:           (walk-thru-grass [→ → ↑])
rlm@333:           (walk [↑ ← ← ←
rlm@333:                  ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
rlm@333:                  ← ←
rlm@333:                  ↑ ↑ ↑ ↑
rlm@333:                  → → → → ↑])
rlm@333:           (walk [→ → 
rlm@290:                  ↑ ↑ ↑
rlm@334:                  → → → → → → → → →])
rlm@334:           (first-difference [] ↑ AF))))
rlm@333:           
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@333:           0x21   ;; load target into HL
rlm@302: 
rlm@333:           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:           ]]))))
rlm@338: 
rlm@338: 
rlm@338: 
rlm@338: 
rlm@338: 
rlm@338: (defn basic-writer [target-address limit return-address]
rlm@338:   (let [[target-high target-low] (disect-bytes-2 target-address)
rlm@338:         [return-high return-low] (disect-bytes-2 return-address)]
rlm@338:     (flatten
rlm@338:      [0xF3 ;; disable interrupts
rlm@340: 
rlm@338:       0x1E  ;; load limit into E
rlm@338:       limit
rlm@338: 
rlm@338:       0x21 ;; load target into HL
rlm@338:       target-low
rlm@338:       target-high
rlm@338: 
rlm@338:       ;; load 1 into C.
rlm@338:       0x0E   ;; C == 1 means input-first nybble
rlm@338:       0x01   ;; C == 0 means input-second nybble
rlm@338:       
rlm@338:       ;; Input Section
rlm@338: 
rlm@338:       0x3E ;; load 0x20 into A, to measure dpad
rlm@338:       0x20 
rlm@338: 
rlm@338:       0xE0 ;; load A into [FF00]
rlm@338:       0x00
rlm@338: 
rlm@338:       0xF0 ;; load 0xFF00 into A to get
rlm@338:       0x00 ;; d-pad presses
rlm@338: 
rlm@338:       0xE6
rlm@338:       0x0F ;; select bottom four bits of A
rlm@338: 
rlm@338:       0xB8 ;; see if input is different (CP A B)
rlm@338: 
rlm@338:       0x28 ;; repeat above steps if input is not different
rlm@338:            ;; (jump relative backwards if B != A)
rlm@338:       0xF5 ;; (literal -11) 
rlm@338: 
rlm@338:       0x47 ;; load A into B
rlm@338:       
rlm@338:       0x0D ;; dec C
rlm@338:       ;; branch based on C:
rlm@338:       0x20 ;; JR NZ
rlm@338:       0x07 ;; skip "input first nybble" below
rlm@338: 
rlm@338:       
rlm@338:       ;; input first nybble
rlm@338:      
rlm@338:       0xCB
rlm@338:       0x37  ;; swap nybbles on A
rlm@338: 
rlm@338:       0x57  ;; A -> D
rlm@338: 
rlm@338:       0x18
rlm@338:       0xEC  ;; literal -20 -- go back to input section
rlm@338: 
rlm@338:       ;; input second nybble
rlm@338: 
rlm@338:       0x0C ;; inc C
rlm@338:       
rlm@338:       0xE6 ;; select bottom bits
rlm@338:       0x0F
rlm@338: 
rlm@338:       0xB2 ;; (OR A D) -> A
rlm@338: 
rlm@338:       0x22 ;; (do (A -> (HL)) (INC HL))
rlm@338: 
rlm@338:       0x1D ;; (DEC E)
rlm@338: 
rlm@338:       0x20 ;; jump back to input section if not done
rlm@338:       0xE4 ;; literal -28
rlm@338: 
rlm@338:       0xFB ;; re-enable interrupts
rlm@338:       
rlm@338:       0xC3
rlm@338:       return-low
rlm@338:       return-high ])))
rlm@338: 
rlm@338: 
rlm@338: (defn test-basic-writer []
rlm@338:   (-> (read-state "bootstrap-init")
rlm@338:       (set-memory pc-item-list-start 50)
rlm@338:       (set-memory-range
rlm@338:        map-function-address-start
rlm@338:        (reverse (disect-bytes-2 (inc pc-item-list-start))))
rlm@338:       (set-memory-range
rlm@338:        (inc pc-item-list-start)
rlm@338:        (basic-writer 0xD162 10 0x5F0C))))
rlm@338: 
rlm@338: (defn debug-basic-writer []
rlm@338:   (PC! (test-basic-writer) (inc pc-item-list-start)))
rlm@338: 
rlm@338: (defn d-ticks [state n]
rlm@338:   (reduce (fn [state _] (d-tick state))
rlm@338:           state (range n)))
rlm@338: 
rlm@338: (defn d-print [state message]
rlm@338:   (println message) state)
rlm@338: 
rlm@338: (defn dddd
rlm@338:   []
rlm@338:   (-> (debug-basic-writer)
rlm@338:       (d-ticks 20)
rlm@338:       (set-memory 0xFF00 0xFF)
rlm@338:       (d-print "============== second cycle")
rlm@338:       (d-ticks 14)
rlm@338:       (d-print "============== end")
rlm@338:       (d-ticks 20)))
rlm@338: 
rlm@339: ;;TMs at celadon store ---
rlm@339: ;;01 (any-number) mega punch
rlm@339: ;;02 (any-number) razor wind
rlm@339: ;;05 (any-number) mega kick 
rlm@339: ;;07 (any-number) hyper beam
rlm@339: ;;09 (any-number) take down
rlm@339: ;;13 (only 1)     ice beam
rlm@339: ;;17 (any-number) submission
rlm@339: ;;18 (only 1)     counter
rlm@339: ;;32 (any-number) double team
rlm@339: ;;33 (any-number) reflect
rlm@339: ;;37 (any-number) egg bomb
rlm@339: ;;48 (only 1)     rock slide
rlm@339: ;;49 (only 1)     tri attack
rlm@339: 
rlm@339: 
rlm@339: ;; no-ops
rlm@339: ;; 0x00
rlm@339: ;; 0xB8 - 0xBF (compares) :garbage
rlm@339: ;; 0x3F clear carry flag :s.s.ticket
rlm@339: ;; 0x37 set carry flag :guard-spec       [!]
rlm@339: ;; 0x33 increment SP :poke-doll          [!]
rlm@339: ;; 0x3B decrement SP :coin
rlm@339: 
rlm@339: ;;0x7F A->A :garbage
rlm@339: ;;0x40 B->B :gold-teeth
rlm@339: ;;0x49 C->C :poke-flute
rlm@339: ;;0x52 D->D :elixer
rlm@339: ;;0x5B E->E :garbage
rlm@339: ;;0x6D L->L :garbage
rlm@339: ;;0x64 H->H :garbage
rlm@339: 
rlm@339: 
rlm@339: ;;0xC5 push BC :HM02
rlm@339: ;;0xD5 push DE :TM13 (ice-beam)
rlm@339: ;;0xE5 push HL :TM29 (psychic)
rlm@339: ;;0xF5 push AF :TM45 (thunder-wave)
rlm@339: 
rlm@339: ;; 0xA7 (AND A A) :garbage
rlm@339: ;; 0xB7 (OR  A A) :garbage
rlm@339: 
rlm@339: ;; 0x2F (CPL A) :leaf-stone
rlm@339: 
rlm@339: 
rlm@339: (defn item-writer
rlm@339:   "This is the basic writer, optimized to be made of valid
rlm@339:    item-quantity pairs."
rlm@339:   [target-address limit return-address]
rlm@339:   (let [[target-high target-low] (disect-bytes-2 target-address)
rlm@339:         [return-high return-low] (disect-bytes-2 return-address)]
rlm@339:     (flatten
rlm@339:      [
rlm@339:       ;;0xC5 ;; push junk onto stack
rlm@339:       ;;0xD5
rlm@339:       ;;0xE5
rlm@339:       ;;0xF5
rlm@341:       0x33  ;; (item-hack) set increment stack pointer no-op
rlm@339:       0x1E  ;; load limit into E
rlm@339:       limit
rlm@339:       0x3F  ;; (item-hack) set carry flag no-op
rlm@339: 
rlm@341:       ;; load 2 into C.
rlm@341:       0x0E   ;; C == 1 means input-first nybble
rlm@341:       0x04   ;; C == 0 means input-second nybble
rlm@340: 
rlm@339:       0x21 ;; load target into HL
rlm@339:       target-low
rlm@339:       target-high
rlm@339:       0x37 ;; (item-hack) set carry flag no-op
rlm@339: 
rlm@339:       0x2F ;; (item-hack) cpl A
rlm@339:       0x2F ;; (item-hack) cpl A --together a spacer no-op
rlm@339:       
rlm@339:       0x00 ;; (item-hack) no-op
rlm@339:       0xF3 ;; disable interrupts
rlm@339:       ;; Input Section
rlm@339: 
rlm@339:       0x3E ;; load 0x20 into A, to measure buttons
rlm@339:       0x10 
rlm@339: 
rlm@339:       0x00 ;; (item-hack) no-op
rlm@339:       0xE0 ;; load A into [FF00]
rlm@339:       0x00
rlm@339: 
rlm@339:       0xF0 ;; load 0xFF00 into A to get
rlm@339:       0x00 ;; button presses
rlm@339:       
rlm@339:       0xE6
rlm@339:       0x0F ;; select bottom four bits of A
rlm@339:       0x37 ;; (item-hack) set carry flag no-op
rlm@339: 
rlm@339:       0x00 ;; (item-hack) no-op
rlm@339:       0xB8 ;; see if input is different (CP A B)
rlm@339: 
rlm@341:       0x00 ;; (item-hack) (INC SP)
rlm@339:       0x28 ;; repeat above steps if input is not different
rlm@339:            ;; (jump relative backwards if B != A)
rlm@339:       0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)
rlm@339: 
rlm@339:       0x47 ;; load A into B
rlm@339:       
rlm@339:       0x0D ;; dec C
rlm@340:       0x37 ;; (item-hack) set-carry flag
rlm@339:       ;; branch based on C:
rlm@339:       0x20 ;; JR NZ
rlm@341:       23 ;; skip "input second nybble" and "jump to target" below
rlm@339:       
rlm@339:       ;; input second nybble
rlm@339: 
rlm@339:       0x0C ;; inc C
rlm@342:       0x0C ;; inc C
rlm@340: 
rlm@340:       0x00 ;; (item-hack) no-op
rlm@339:       0xE6 ;; select bottom bits
rlm@339:       0x0F
rlm@340:       0x37 ;; (item-hack) set-carry flag no-op
rlm@339: 
rlm@340:       0x00 ;; (item-hack) no-op
rlm@339:       0xB2 ;; (OR A D) -> A
rlm@339: 
rlm@339:       0x22 ;; (do (A -> (HL)) (INC HL))
rlm@339: 
rlm@339:       0x1D ;; (DEC E)
rlm@339: 
rlm@340:       0x00 ;; (item-hack) 
rlm@339:       0x20 ;; jump back to input section if not done
rlm@340:       0xDA ;; literal -36 == TM 18 (counter)
rlm@341:       0x01 ;; (item-hack) set BC to literal (no-op)
rlm@339: 
rlm@341:       ;; jump to target
rlm@341:       0x00  ;; (item-hack) these two bytes can be anything.
rlm@341:       0x01 
rlm@341: 
rlm@341:       0x00   ;; (item-hack) no-op
rlm@341:       0xBF   ;; (CP A A) ensures Z
rlm@341:       
rlm@341:       0xCA   ;; (item-hack) jump if Z
rlm@341:       return-low
rlm@341:       return-high
rlm@341:       0x01   ;; (item-hack) will never be reached.
rlm@341:      
rlm@341: 
rlm@341:       
rlm@340:       ;; input first nybble
rlm@340:       0x00
rlm@340:       0xCB
rlm@340:       0x37  ;; swap nybbles on A
rlm@340: 
rlm@340:       0x57  ;; A -> D
rlm@340: 
rlm@341:       0x37  ;; (item-hack) set carry flag no-op
rlm@341:       0x18  ;; relative jump backwards
rlm@341:       0xCD  ;; literal -51 == TM05; go back to input section
rlm@341:       0x01  ;; (item-hack) will never reach this instruction
rlm@340: 
rlm@341:        ])))
rlm@340: 
rlm@341: (defn test-item-writer []
rlm@341:   (-> (read-state "bootstrap-init")
rlm@341:       (set-memory pc-item-list-start 50)
rlm@341:       (set-memory-range
rlm@341:        map-function-address-start
rlm@341:        (reverse (disect-bytes-2 (inc pc-item-list-start))))
rlm@341:       (set-memory-range
rlm@341:        (inc pc-item-list-start)
rlm@341:        (item-writer 0xD162 201 0xD162))))
rlm@342: 
rlm@342: (defn item-writer-state []
rlm@342:   (read-state "item-writer"))
rlm@342: 
rlm@342: (defn test-item-writer-2 []
rlm@342:   (let [orig (item-writer-state)]
rlm@342:     (-> orig
rlm@342:     (print-listing 0xD162 (+ 0xD162 20))
rlm@343:     (run-moves (reduce concat
rlm@343:                 (repeat 10 [[:a :b :start :select] []])))
rlm@342:     ((fn [_] (println "===========") _))
rlm@342:     (print-listing 0xD162 (+ 0xD162 20)))))
rlm@343: