rlm@345: (ns com.aurellem.run.bootstrap-1
rlm@377:   (:use (com.aurellem.gb saves gb-driver util constants
rlm@414:                          items vbm characters money
rlm@414:                          rlm-assembly))
rlm@345:   (:use (com.aurellem.run util title save-corruption bootstrap-0))
rlm@345:   (:use (com.aurellem.exp item-bridge))
rlm@345:   (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@345: 
rlm@415: (def hex #(printf "0x%02X\n" %))
rlm@345: 
rlm@367: (defn print-desired-item-layout []
rlm@345:   (clojure.pprint/pprint
rlm@345:    (raw-inventory->inventory (pc-item-writer-program))))
rlm@345: 
rlm@345: (defn pc-item-writer-state []
rlm@345:     (-> (read-state "bootstrap-init")
rlm@345:       (set-memory pc-item-list-start 50)
rlm@345:       (set-memory-range
rlm@345:        map-function-address-start
rlm@345:        [0x8B 0xD5])
rlm@345:       (set-memory-range
rlm@345:        (inc pc-item-list-start)
rlm@345:        (pc-item-writer-program))))
rlm@345: 
rlm@345: (defn test-pc-item-writer []
rlm@345:   (let [orig (read-state "pc-item-writer")]
rlm@345:     (-> orig
rlm@345:     (print-listing 0xD162 (+ 0xD162 20))
rlm@345:     (run-moves (reduce concat
rlm@345:                 (repeat 10 [[:a :b :start :select] []])))
rlm@345:     ((fn [_] (println "===========") _))
rlm@345:     (print-listing 0xD162 (+ 0xD162 20)))))
rlm@345: 
rlm@345: (defn close-all-menus [[moves state :as script]]
rlm@345:   (loop [s script]
rlm@345:     (let [depth (current-depth (second (do-nothing 50 s)))]
rlm@345:       (println "depth" depth)
rlm@345:       (if (= depth 1)
rlm@345:         s
rlm@345:         (recur (close-menu s))))))
rlm@345: 
rlm@345: (defn-memo name-rival
rlm@345:   ([] (name-rival (to-rival-name)))
rlm@345:   ([script]
rlm@345:      (->> script
rlm@345:           (first-difference [] [:a] AF)
rlm@345:           (first-difference [] [:r] DE)
rlm@345:           (play-moves
rlm@345:            [[]
rlm@345:             [] [] [:r] [] [:d] [:a]           ;; L
rlm@345:             [:r] [] [:r] [] [:r] [] [:r] [] 
rlm@345:             [:r] [] [:d] [] [:d] [:a]         ;; [PK]
rlm@345:             [:d] [] [:r] [:a]
rlm@345:             ]))))
rlm@345: 
rlm@345: (defn-memo to-room-pc
rlm@345:   ([] (to-room-pc (name-rival)))
rlm@345:   ([script]
rlm@345:      (->> script
rlm@345:           finish-title
rlm@345:           (walk [← ← ↑ ← ↑ ↑ ↑]))))
rlm@345: 
rlm@369: ;; (defn wait-for-quantity
rlm@369: ;;   [[moves state :as script]]
rlm@369: ;;   (if (not= (item-quantity-selected state) 1)
rlm@369: ;;     (repeat-until-different [] item-quantity-selected script)
rlm@369: ;;     script))
rlm@353: 
rlm@368: ;; TODO use this:
rlm@368: ;;(wait-until (partial set-cursor-relative 1))
rlm@368: 
rlm@369: ;; (defn wait-for-cursor
rlm@369: ;;   [[moves state :as script]]
rlm@369: ;;   (if (not= (list-offset state) 0)
rlm@369: ;;     (repeat-until-different [] list-offset script)
rlm@369: ;;     script))
rlm@353: 
rlm@345: (defn deposit-held-item [n quantity [moves state :as script]]
rlm@345:   (let [total-quantity (second (nth-item state n))]
rlm@345:     (println "total-quantity" total-quantity)
rlm@345:     (->> script
rlm@345:          (set-cursor n)
rlm@345:          (select-menu-entry 1)
rlm@369:          ;;(wait-for-quantity)
rlm@345:          (set-quantity total-quantity quantity)
rlm@345:          (delayed-difference [] [:a] 100 #(search-string % "stored"))
rlm@345:          (scroll-text))))
rlm@345: 
rlm@353: (defn sell-held-item [n quantity [moves state :as script]]
rlm@353:   (let [total-quantity (second (nth-item state n))]
rlm@353:     (->> script
rlm@369:          ;;(wait-for-cursor)  ;; when selling, the cursor always
rlm@353:          (set-cursor n)     ;; returns to the top of the list.
rlm@353:          (select-menu-entry 1)
rlm@369:          ;;(wait-for-quantity)
rlm@353:          (set-quantity total-quantity quantity)
rlm@353:          (delayed-difference [] [:a] 100 current-depth)
rlm@353:          (play-moves (repeat 20 [:b]))
rlm@353:          (delayed-difference [] [:a] 100 #(search-string % "What"))
rlm@353:          )))
rlm@353: 
rlm@345: (defn widthdraw-pc-item [n quantity [moves state :as script]]
rlm@345:   (let [total-quantity (second (nth-pc-item state n))]
rlm@345:     (->> script
rlm@345:          (set-cursor n)
rlm@345:          (select-menu-entry 1)
rlm@369:          ;;(wait-for-quantity)
rlm@345:          (set-quantity total-quantity quantity)
rlm@345:          (delayed-difference [] [:a] 100 #(search-string % "Withdrew"))
rlm@345:          (scroll-text))))
rlm@345: 
rlm@345: (defn toss-held-item [n quantity [moves state :as script]]
rlm@353:   (let [total-quantity (second (nth-item state n))]
rlm@345:     (->> script
rlm@345:          (set-cursor n)
rlm@345:          (select-menu-entry 1)
rlm@345:          (set-cursor-relative 1)
rlm@345:          (select-menu-entry -1)
rlm@369:          ;;(wait-for-quantity)
rlm@345:          (set-quantity total-quantity quantity)
rlm@345:          (play-moves [[:a]])
rlm@345:          (scroll-text)
rlm@345:          (delayed-difference [] [:a] 100 #(search-string % "Threw"))
rlm@345:          (scroll-text)
rlm@345:          )))
rlm@345: 
rlm@354: (defn buy-item [n quantity [moves state :as script]]
rlm@354:   (->> script
rlm@354:        (set-cursor n)
rlm@354:        (purchase-item quantity)))
rlm@354: 
rlm@369: (defn switch-items [item-fn idx-1 idx-2 script]
rlm@369:   (->> script
rlm@369:        (wait-until select-menu-entry)
rlm@369:        (set-cursor idx-1)
rlm@369:        (wait-until select-menu-entry)
rlm@369:        (play-moves [[][:select][]])
rlm@369:        (set-cursor idx-2)
rlm@369:        (delayed-difference [] [:select] 100
rlm@369:                            #(item-fn % (list-offset %)))))
rlm@369: 
rlm@369: (def switch-pc-items (partial switch-items nth-pc-item))
rlm@369: (def switch-held-items (partial switch-items nth-item))
rlm@369: 
rlm@369: (defn combine-pc-items [idx-1 script]
rlm@369:   (->> script
rlm@369:        (switch-pc-items idx-1 (inc idx-1))))
rlm@345: 
rlm@345: (def desired-zero-quantities
rlm@345:   (map second (filter (comp (partial = 0) first)
rlm@345:                       (partition 2 (pc-item-writer-program)))))
rlm@369: 
rlm@604: (defn-memo bootstrap-corrupt-save
rlm@369:   ([] (bootstrap-corrupt-save (to-room-pc)))
rlm@369:   ([script]
rlm@369:    (->> script
rlm@369:         (do-save-corruption 3)
rlm@369:         (corrupt-item-list 0)
rlm@369:         close-all-menus)))
rlm@369: 
rlm@369: (defn-memo prepare-celadon-warp
rlm@369:   ([] (prepare-celadon-warp (bootstrap-corrupt-save)))
rlm@369:   ([script]
rlm@369:      (->> script
rlm@369:           (activate-start-menu)
rlm@369:           (set-cursor-relative 1)
rlm@369:           (select-menu-entry)
rlm@369:           ;; vastly increase text speed while we're here.
rlm@369:           (switch-held-items 21 27)
rlm@369:           (toss-held-item 35 0xFA)
rlm@369:           (close-all-menus))))
rlm@369: 
rlm@369: (defn-memo begin-initial-deposits
rlm@369:   ([] (begin-initial-deposits
rlm@369:        (prepare-celadon-warp)))
rlm@369:   ([script]
rlm@369:      (->> script
rlm@369:           (first-difference [] [:a] AF)
rlm@369:           (scroll-text)
rlm@369:           (set-cursor 1)
rlm@369:           select-menu-entry)))
rlm@369: 
rlm@345: (defn-memo initial-deposits
rlm@345:   ([] (initial-deposits (begin-initial-deposits)))
rlm@345:   ([script]
rlm@345:      (->> script
rlm@354:           (deposit-held-item 0 0x1)
rlm@345:           ((fn [script]
rlm@345:              (reduce 
rlm@345:               (fn [script item] (deposit-held-item item 0xFF script))
rlm@345:               script
rlm@360:               (range 3 (+ 13 3)))))
rlm@345:           close-all-menus)))
rlm@345: 
rlm@345: 
rlm@345: ;;0 -- 256
rlm@345: ;;1 -- 254
rlm@345: ;;2 -- 254
rlm@345: ;;3 -- 255
rlm@345: 
rlm@604: (defn-memo activate-home-pc
rlm@369:   [script]
rlm@369:   (->> script
rlm@369:        (delayed-difference [] [:a]
rlm@369:                            200 first-character)
rlm@369:        (scroll-text)))
rlm@369: 
rlm@345: (defn-memo restore-items
rlm@369:   ([] (restore-items (initial-deposits)))
rlm@345:   ([script]
rlm@345:      (->> script
rlm@369:           activate-home-pc
rlm@345:           (select-menu-entry)
rlm@345:           (widthdraw-pc-item 0 1)
rlm@354:           ;;(widthdraw-pc-item 0 99)
rlm@354:           ;;(widthdraw-pc-item 1 1)
rlm@360:           (widthdraw-pc-item 13 255)
rlm@345:           (close-all-menus))))
rlm@345: 
rlm@345: (defn-memo to-celadon
rlm@345:   ([] (to-celadon (restore-items)))
rlm@345:   ([script]
rlm@345:      (->> script
rlm@345:           (walk [→ → → → → → → ↑
rlm@345:                  ↓ ↓ ↓ ↓ ↓ ← ← ← ←
rlm@345:                  ↓ ↓]))))
rlm@345: 
rlm@345: 
rlm@351: ;; celadon store inventory
rlm@345: 
rlm@351: ;; Floor 2
rlm@351: ;;=====================================
rlm@351: ;; Great Ball        TM32 (double-team)
rlm@351: ;; Super Potion      TM33 (reflect)
rlm@351: ;; Revive            TM02 (razor-wind)
rlm@351: ;; Super Repel       TM07 (horn-drill)
rlm@351: ;; Antidote          TM37 (egg-bomb)
rlm@351: ;; Burn Heal         TM01 (mega-punch)
rlm@351: ;; Ice Heal          TM05 (mega-kick)
rlm@351: ;; Awakening         TM09 (take-down)
rlm@351: ;; Parlyz Heal       TM17 (submission)
rlm@345: 
rlm@345: 
rlm@351: ;; Floor 3
rlm@351: ;;=====================================       
rlm@351: ;; TM18 (counter)
rlm@345: 
rlm@351: 
rlm@351: ;; Floor 4
rlm@351: ;;=====================================
rlm@351: ;; Poke Doll
rlm@351: ;; Fire Stone
rlm@351: ;; Thunder Stone
rlm@351: ;; Water Stone
rlm@351: ;; Leaf Stone
rlm@351: 
rlm@351: ;; Floor 5
rlm@351: ;;=====================================
rlm@351: ;; X Accuracy         HP UP
rlm@351: ;; Guard Spec.        Protein
rlm@351: ;; Dire Hit           Iron
rlm@351: ;; X Attack           Carbos
rlm@351: ;; X Defend           Calcium
rlm@351: ;; X Speed            
rlm@351: ;; X Special
rlm@351: 
rlm@351: ;; Roof
rlm@351: ;;=====================================
rlm@351: ;; Fresh Water        TM13 (ice-beam)
rlm@351: ;; Soda Pop           TM48 (rock-slide)
rlm@352: ;; Lemonade :)        TM49 (tri-attack)
rlm@352: 
rlm@352: 
rlm@353: (defn-memo go-to-floor-two
rlm@352:   ([] (go-to-floor-two (to-celadon)))
rlm@352:   ([script]
rlm@352:      (->> script
rlm@593:           (walk [→ → ↑
rlm@593:                  ↑ ↑ ↑ ↑
rlm@593:                  ← ← ← ←
rlm@593:                  ↑ ↑ 
rlm@352:                  ← ← ← ← 
rlm@352:                  ↓ ↓ ↓
rlm@352:                  ← ←])
rlm@352:           (first-difference [] ↑ AF))))
rlm@352: 
rlm@353: (defn talk
rlm@360:   "Assumes that you are facing something that initiates text and
rlm@360:    causes it to do so."
rlm@360:   [script]
rlm@360:   (->> script
rlm@360:        (delayed-difference [] [:a] 100
rlm@368:                            first-character)))
rlm@353: 
rlm@354: (defn-memo get-money-floor-two
rlm@353:   ([] (get-money-floor-two (go-to-floor-two)))
rlm@353:   ([script]
rlm@353:      (->> script
rlm@353:           talk
rlm@353:           (set-cursor 1)
rlm@353:           (select-menu-entry)
rlm@594: 
rlm@594:           ;; These glitch items have to be sold one at a time
rlm@594:           ;; because the game will only award up to 500000 at
rlm@594:           ;; a time for selling them.
rlm@354:           (sell-held-item 0 1)
rlm@354:           (sell-held-item 0 1)
rlm@594: 
rlm@354:           (close-menu))))
rlm@352: 
rlm@354: (defn-memo floor-two-TMs
rlm@354:   ([] (floor-two-TMs (get-money-floor-two)))
rlm@354:   ([script]
rlm@354:      (->> script
rlm@369:           (set-cursor 0)
rlm@354:           (select-menu-entry)
rlm@354:           (buy-item 2 98)  ;; TM02 (razor-wind)
rlm@354:           (buy-item 4 71)  ;; TM37 (doubleteam)
rlm@354:           (buy-item 5 63)  ;; TM01 (mega-punch)
rlm@354:           (buy-item 6 1)   ;; TM05 (mega-kick)
rlm@354:           (buy-item 7 56)  ;; TM09 (take-down)
rlm@354:           (close-menu))))
rlm@354: 
rlm@354: (defn end-shop-conversation
rlm@354:   [script]
rlm@354:   (->> script
rlm@354:        (wait-until scroll-text [:b])
rlm@354:        (play-moves [[] [:b]])
rlm@354:        close-menu))
rlm@354: 
rlm@354: (defn-memo floor-two-more-money
rlm@354:   ([] (floor-two-more-money (floor-two-TMs)))
rlm@354:   ([script]
rlm@354:      (->> script
rlm@354:           (set-cursor 1)
rlm@354:           (select-menu-entry)
rlm@354:           (sell-held-item 0 1)
rlm@354:           (sell-held-item 0 1)
rlm@354:           close-menu
rlm@354:           end-shop-conversation)))
rlm@354: 
rlm@354: (defn turn [direction script]
rlm@354:   (->> script
rlm@354:        (first-difference [] direction AF)))
rlm@352: 
rlm@355: (defn-memo floor-two-items
rlm@355:   ([] (floor-two-items (floor-two-more-money)))
rlm@355:   ([script]
rlm@355:      (->> script
rlm@355:           (walk [←])
rlm@355:           (turn ↑)
rlm@355:           talk
rlm@355:           select-menu-entry
rlm@355:           (buy-item 5 12)  ;; burn heal
rlm@355:           (buy-item 6 55)  ;; ice heal
rlm@355:           (buy-item 7 4)   ;; awakening
rlm@355:           (buy-item 8 99)  ;; parlyz heal
rlm@355:           (buy-item 8 55)  ;; parlyz heal
rlm@355:           close-menu
rlm@355:           end-shop-conversation)))
rlm@352: 
rlm@356: (defn-memo go-to-floor-three
rlm@356:   ([] (go-to-floor-three (floor-two-items)))
rlm@356:   ([script]
rlm@356:      (->> script
rlm@361:           (walk [→ → → → → → → → → → ↑ ↑ ↑
rlm@361:                    → ↑]))))
rlm@357: (defn-memo get-TM18
rlm@356:   ([] (get-TM18 (go-to-floor-three)))
rlm@356:   ([script]
rlm@356:      (->> script
rlm@356:           (walk [↓ ↓])
rlm@356:           talk
rlm@356:           (scroll-text 3)
rlm@356:           end-text)))
rlm@352: 
rlm@357: (defn-memo go-to-floor-four
rlm@357:   ([] (go-to-floor-four (get-TM18)))
rlm@357:   ([script]
rlm@357:      (->> script
rlm@357:           (walk [← ← ← ← ↑ ↑
rlm@357:                  ↓ ← ← ↓ ↓ ↓
rlm@357:                  ← ← ← ← ←])
rlm@357:           (turn ↓))))
rlm@352: 
rlm@357: (defn-memo floor-four-items
rlm@357:   ([] (floor-four-items (go-to-floor-four)))
rlm@357:   ([script]
rlm@357:      (->> script
rlm@357:           talk
rlm@357:           select-menu-entry
rlm@357:           (buy-item 1 23)  ;; Fire Stone
rlm@357:           (buy-item 2 98)  ;; Thunder Stone
rlm@357:           (buy-item 3 29)  ;; Water Stone
rlm@357:           close-menu
rlm@357:           end-shop-conversation)))
rlm@352: 
rlm@358: (defn-memo go-to-floor-five
rlm@358:   ([] (go-to-floor-five (floor-four-items)))
rlm@358:   ([script]
rlm@358:      (->> script
rlm@358:           (walk [→ → → → → →
rlm@358:                  ↑ ↑ ↑
rlm@358:                  → → → → → ↑ ;; leave floor four
rlm@358:                  ↓ ← ← ← ← ← ← ← ←
rlm@359:                  ↓ ↓ ↓ ← ← ← ]);; go to five's clerk
rlm@358:           (turn ↑))))
rlm@358:                 
rlm@358: (defn-memo floor-five-items
rlm@358:   ([] (floor-five-items (go-to-floor-five)))
rlm@358:   ([script]
rlm@358:      (->> script
rlm@358:           talk
rlm@358:           select-menu-entry
rlm@358:           (buy-item 0 58)   ;; X-Accuracy
rlm@358:           (buy-item 1 99)   ;; Guard Spec.
rlm@358:           (buy-item 1 24)   ;; Guard Spec.
rlm@358:           close-menu
rlm@358:           end-shop-conversation)))
rlm@352: 
rlm@359: (defn-memo go-to-roof
rlm@359:   ([] (go-to-roof (floor-five-items)))
rlm@359:   ([script]
rlm@359:      (->> script
rlm@359:           (walk [→ → → → ↑ ↑ ↑ → → → ↑ ;; leave floor five
rlm@359:                  ↓ ← ← ←]) ;; walk to vending machine
rlm@359:           (turn ↑))))
rlm@352: 
rlm@359: (defn buy-drink
rlm@359:   "Assumes you're in front of the vending machine. Buys the indicated
rlm@359:    drink."
rlm@359:   [n script]
rlm@359:   (->> script
rlm@361:        (do-nothing 20)
rlm@361:        (play-moves [[:a][:a]])
rlm@361:        scroll-text
rlm@359:        (set-cursor n)
rlm@359:        select-menu-entry
rlm@359:        close-menu))
rlm@359: 
rlm@359: (defn-memo roof-drinks
rlm@359:   ([] (roof-drinks (go-to-roof)))
rlm@359:   ([script]
rlm@359:      (->> script
rlm@361:           (buy-drink 0) ;; fresh water (for TM13)
rlm@359:           ;; buy 16 lemonades
rlm@359:           ;; LEMONADE is the best item <3  :)
rlm@361:           (multiple-times 16 (partial buy-drink 2)))))
rlm@361: 
rlm@362: (defn-memo get-TM13
rlm@359:   ([] (get-TM13 (roof-drinks)))
rlm@359:   ([script]
rlm@359:      (->> script
rlm@594:           ;; alternate route depending on girl's motions
rlm@369:           ;;(walk [← ← ← ← ← ← ↓])
rlm@369:           (walk [↓ ↓ ↓ ← ← ← ← ← ←])
rlm@369:           (play-moves [[][][][][:a][:a][]])
rlm@361:           (scroll-text 3)
rlm@359:           select-menu-entry
rlm@359:           select-menu-entry
rlm@359:           (scroll-text 6)
rlm@359:           close-menu)))
rlm@362: 
rlm@363: (defn-memo to-celadon-poke-center
rlm@362:   ([] (to-celadon-poke-center (get-TM13)))
rlm@362:   ([script]
rlm@362:      (->> script
rlm@594:           ;; alternate route depending on girl's motions
rlm@369:           ;;(walk [↑ → → → → → → → → → ↑])       ; leave roof
rlm@369:           (walk [→ → → → → → → → → ↑ ↑ ↑ ↑])
rlm@362:           (walk [↓ ← ← ← ← ↓ ↓ ↓ ← ← ← ← ← 
rlm@362:                  ↑ ↑ ↑ ← ← ↑])                 ; to elevator
rlm@362:                  
rlm@362:           (walk [→ → ↑ ↑])                     ; to controls
rlm@362:           talk
rlm@362:           select-menu-entry                    ; to floor 1
rlm@594:           (walk [↓ ↓ ←])
rlm@362:           (walk [↓ → ↓ ↓ ↓ ↓ ↓ ↓])             ; leave store
rlm@594:           (walk [→ → → → → → → → → → ↑])
rlm@362:           (walk (repeat 23 →))
rlm@362:           (walk [↑ ↑ ↑ ↑])                     ; enter poke center
rlm@362:           (walk [↑ ↑ ↑ → → → → → → → → → →])   ; to computer
rlm@362:           (turn ↑))))
rlm@363: 
rlm@363: (defn activate-rlm-pc [script]
rlm@363:   (->> script
rlm@363:        talk
rlm@363:        scroll-text
rlm@369:        ;;wait-for-cursor
rlm@363:        (set-cursor 1)
rlm@363:        select-menu-entry
rlm@363:        (scroll-text 2)))
rlm@363: 
rlm@363: (defn begin-deposit [script]
rlm@363:   (->> script
rlm@363:        (set-cursor 1)
rlm@363:        select-menu-entry))
rlm@363: 
rlm@363: (defn begin-withdraw [script]
rlm@363:   (->> script
rlm@363:        (set-cursor 0)
rlm@363:        (select-menu-entry)))
rlm@363: 
rlm@363: (defn deposit-held-item-named
rlm@363:   [item-name quantity [moves state :as script]]
rlm@363:   (let [index (count
rlm@363:                (take-while
rlm@363:                 (fn [[name quant]]
rlm@363:                   (or (not= name item-name)
rlm@363:                       (< quant quantity)))
rlm@363:                   (inventory state)))]
rlm@363:     (println "index" index)
rlm@363:     (deposit-held-item index quantity script)))
rlm@363: 
rlm@369: (defn open-held-items
rlm@369:   [script]
rlm@369:   (->> script
rlm@369:        select-menu-entry))
rlm@363: 
rlm@595: (defn close-celadon-computer-menu
rlm@595:   [script]
rlm@595:   ;; this part was determined via manual binary search
rlm@595:   ;; because for some reason the current-depth RAM value
rlm@595:   ;; is the same for both the final menu being either on
rlm@595:   ;; or off. 
rlm@595:   (->> script
rlm@595:        (play-moves
rlm@595:         (concat (repeat 4 []) [[:b]]))))
rlm@595:        
rlm@369: (defn to-held-items
rlm@369:   [script]
rlm@369:   (->> script
rlm@369:        close-menu
rlm@369:        close-menu
rlm@595:        close-celadon-computer-menu
rlm@369:        activate-start-menu
rlm@369:        open-held-items))
rlm@369: 
rlm@369: (defn toss-pc-item [n quantity  [moves state :as script]]
rlm@369:   (let [total-quantity (second (nth-pc-item state n))]
rlm@369:     (->> script
rlm@369:          (set-cursor n)
rlm@369:          (select-menu-entry 1)
rlm@369:          (set-quantity total-quantity quantity)
rlm@369:          (delayed-difference [] [:a] 100 #(search-string % "Is"))
rlm@369:          (scroll-text)
rlm@369:          select-menu-entry
rlm@369:          (scroll-text))))
rlm@369: 
rlm@369: (defn-memo hacking-1
rlm@369:   ([] (hacking-1 (to-celadon-poke-center)))
rlm@363:   ([script]
rlm@363:      (->> script
rlm@363:           activate-rlm-pc
rlm@363:           begin-deposit
rlm@363:           (deposit-held-item-named 0x00           30)
rlm@363:           (deposit-held-item-named :TM01          63)
rlm@363:           (deposit-held-item-named :awakening      4)
rlm@363:           (deposit-held-item-named :thunderstone  98)
rlm@363:           (deposit-held-item-named :TM09          55)
rlm@363:           (deposit-held-item-named 0x00           55))))
rlm@363: 
rlm@604: (defn-memo hacking-2
rlm@369:   ([] (hacking-2 (hacking-1)))
rlm@363:   ([script]
rlm@363:      (->> script
rlm@364:           (to-held-items)
rlm@363:           (toss-held-item 0 166) ;; discard cruft
rlm@363:           close-menu
rlm@363:           close-menu)))
rlm@363: 
rlm@363: (defn-memo hacking-3
rlm@363:   ([] (hacking-3 (hacking-2)))
rlm@363:   ([script]
rlm@363:      (->> script
rlm@363:           activate-rlm-pc
rlm@363:           begin-withdraw
rlm@363:           (widthdraw-pc-item 0 99)
rlm@363:           (widthdraw-pc-item 0 1)
rlm@363:           (widthdraw-pc-item 2 0xFE)
rlm@368:           (widthdraw-pc-item 3 0xFE)
rlm@368:           close-menu)))
rlm@363:           
rlm@364: (defn-memo hacking-4
rlm@364:   ([] (hacking-4 (hacking-3)))
rlm@364:   ([script]
rlm@364:      (->> script
rlm@364:           begin-deposit
rlm@364:           (deposit-held-item 19 243)
rlm@364:           (deposit-held-item-named :lemonade 16)
rlm@364:           (deposit-held-item 18 224))))
rlm@364:           
rlm@364: (defn-memo hacking-5
rlm@364:   "clean out the held-item list again"
rlm@364:   ([] (hacking-5 (hacking-4)))
rlm@364:   ([script]
rlm@364:      (->> script
rlm@364:           (to-held-items)
rlm@364:           (toss-held-item 18 30)
rlm@364:           (toss-held-item 17 1)
rlm@364:           close-menu
rlm@364:           close-menu)))
rlm@363: 
rlm@364: (defn-memo hacking-6
rlm@364:   ([] (hacking-6 (hacking-5)))
rlm@364:   ([script]
rlm@364:      (->> script
rlm@364:           activate-rlm-pc
rlm@364:           begin-withdraw
rlm@364:           (widthdraw-pc-item 4 0xFE)
rlm@364:           (widthdraw-pc-item 5 0xFE)
rlm@365:           (widthdraw-pc-item 6 0xFE)
rlm@365:           close-menu)))
rlm@364: 
rlm@365: (defn-memo hacking-7
rlm@365:   ([] (hacking-7 (hacking-6)))
rlm@365:   ([script]
rlm@365:      (->> script
rlm@365:           begin-deposit
rlm@365:           (deposit-held-item 19 240)
rlm@365:           (deposit-held-item 18 230)
rlm@365:           (deposit-held-item-named :parlyz-heal 55)
rlm@365:           (deposit-held-item 17 184)
rlm@365:           (deposit-held-item 17 40)
rlm@365:           (deposit-held-item-named :TM37 71)
rlm@365:           (deposit-held-item-named :ice-heal 55)
rlm@365:           (deposit-held-item-named :fire-stone 23)
rlm@366:           (deposit-held-item-named :burn-heal 12)
rlm@369:           ;; as a special case, /don't/ close the menu.
rlm@369:           )))
rlm@366: 
rlm@366: (defn-memo hacking-8
rlm@366:   "Clear cruft away from held item list."
rlm@366:   ([] (hacking-8 (hacking-7)))
rlm@366:   ([script]
rlm@366:      (->> script
rlm@366:           to-held-items
rlm@366:           (toss-held-item 15 1)
rlm@366:           (toss-held-item 14 1)
rlm@366:           (toss-held-item 13 1)
rlm@366:           close-menu
rlm@366:           close-menu)))
rlm@366: 
rlm@366: (defn-memo hacking-9
rlm@366:   ([] (hacking-9 (hacking-8)))
rlm@366:   ([script]
rlm@366:      (->> script
rlm@366:           activate-rlm-pc
rlm@366:           begin-withdraw
rlm@366:           (widthdraw-pc-item 7 0xFE)
rlm@366:           (widthdraw-pc-item 8 0xFC)
rlm@366:           (widthdraw-pc-item 8 1)
rlm@366:           (widthdraw-pc-item 8 1)
rlm@366:           (widthdraw-pc-item 9 0xFE)
rlm@366:           (multiple-times
rlm@366:            7
rlm@368:            (partial combine-pc-items 2))
rlm@366:           close-menu)))
rlm@366:           
rlm@366: (defn-memo hacking-10
rlm@366:   ([] (hacking-10 (hacking-9)))
rlm@366:   ([script]
rlm@366:      (->> script
rlm@366:           begin-deposit
rlm@366:           (deposit-held-item 17 230)
rlm@366:           (deposit-held-item-named :parlyz-heal 55)
rlm@366:           (deposit-held-item 14 178)
rlm@366:           (deposit-held-item-named :water-stone 29)
rlm@366:           (deposit-held-item 14 32)
rlm@366:           (deposit-held-item-named :TM18 1)
rlm@366:           (deposit-held-item 13 1)
rlm@366:           (deposit-held-item 13 191)
rlm@366:           (deposit-held-item-named :TM02 98)
rlm@366:           (deposit-held-item-named :TM09 1)
rlm@366:           close-menu)))
rlm@366: 
rlm@366: (defn-memo hacking-11
rlm@366:   ([] (hacking-11 (hacking-10)))
rlm@366:   ([script]
rlm@366:      (->> script
rlm@367:           begin-withdraw
rlm@367:           (widthdraw-pc-item 3 0xFE)
rlm@367:           (widthdraw-pc-item 4 0xFE)
rlm@367:           (widthdraw-pc-item 5 1)
rlm@367:           (widthdraw-pc-item 5 1)
rlm@367:           (widthdraw-pc-item 5 1)
rlm@367:           (widthdraw-pc-item 5 0xFB)
rlm@367:           (multiple-times
rlm@367:            3
rlm@369:            (partial combine-pc-items 2))
rlm@367:           close-menu)))
rlm@367: 
rlm@367: (defn-memo hacking-12
rlm@367:   ([] (hacking-12 (hacking-11)))
rlm@367:   ([script]
rlm@367:      (->> script
rlm@367:           begin-deposit
rlm@367:           (deposit-held-item 18 203)
rlm@367:           (deposit-held-item-named :guard-spec 87)
rlm@367:           (deposit-held-item-named :guard-spec 24)
rlm@367:           (deposit-held-item-named :TM05 1)
rlm@367:           (multiple-times
rlm@367:            8
rlm@369:            (partial deposit-held-item 14 1))
rlm@367:           (deposit-held-item 14 55)
rlm@367:           (deposit-held-item-named :x-accuracy 58)
rlm@367:           (deposit-held-item 14 38)
rlm@367:           (deposit-held-item-named :TM13 1)
rlm@367:           (deposit-held-item 13 1)
rlm@367:           (deposit-held-item 13 233)
rlm@366:           close-menu)))
rlm@367:        
rlm@368: (defn-memo hacking-13
rlm@367:   ([] (hacking-13 (hacking-12)))
rlm@367:   ([script]
rlm@367:      (->> script
rlm@367:           (set-cursor-relative 1)
rlm@367:           (select-menu-entry)
rlm@367:           (toss-pc-item 1 1)
rlm@367:           (toss-pc-item 0 156)
rlm@368:           (toss-pc-item 0 11))))
rlm@368: 
rlm@368: (defn confirm-pattern []
rlm@368:   (let [start-address (inc pc-item-list-start)
rlm@368:         target-pattern (pc-item-writer-program)
rlm@368:         actual-pattern
rlm@368:         (subvec (vec (memory (second (hacking-13))))
rlm@368:                 start-address
rlm@368:                 (+ start-address (count target-pattern)))]
rlm@368:     (println target-pattern)
rlm@368:     (println actual-pattern)
rlm@368:     (= target-pattern actual-pattern)))
rlm@368: 
rlm@368: (defn-memo go-to-mansion-for-the-lulz
rlm@368:   ([] (go-to-mansion-for-the-lulz (hacking-13)))
rlm@368:   ([script]
rlm@595:      (let [lulz-delay 50]
rlm@595:        (->> script
rlm@595:             close-menu
rlm@595:             close-menu
rlm@595:             close-celadon-computer-menu
rlm@595:             (walk [← ← ← ← ← ← ← ← ← ↓ ↓ ↓ ↓])
rlm@595:             (walk (repeat 17 ←))
rlm@595:             (walk [↑ → → → → ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
rlm@595:             (walk [↓ ← ↑])
rlm@595:             (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@595:                    ← ← ← ← ↑ ↑ ↑ ← ↑])
rlm@595:             (talk)
rlm@595:             (do-nothing lulz-delay)
rlm@595:             (play-moves [[:a]])
rlm@595:             (do-nothing lulz-delay)
rlm@595:             (play-moves [[:a]])
rlm@595:             close-menu))))
rlm@367: 
rlm@368: (defn-memo launch-bootstrap-program
rlm@368:   ([] (launch-bootstrap-program
rlm@368:        (go-to-mansion-for-the-lulz)))
rlm@368:   ([script]
rlm@368:      (->> script
rlm@368:           ;; must corrupt item list again by switching pokemon
rlm@369:           activate-start-menu    ;; \
rlm@369:           (set-cursor 0)         ;; |
rlm@369:           select-menu-entry      ;; |
rlm@369:           select-menu-entry      ;; |
rlm@369:           (set-cursor 1)         ;; | -- switch 9th pokemon
rlm@369:           select-menu-entry      ;; |    with 4th pokemon
rlm@369:           (set-cursor 3)         ;; |
rlm@369:           select-menu-entry      ;; |
rlm@369:           close-menu             ;; /
rlm@369:           ;; now, open items and set map-function to
rlm@369:           ;; the program inside the item-computer.
rlm@368:           (set-cursor 1)
rlm@368:           (select-menu-entry)
rlm@368:           (toss-held-item 22 12)
rlm@368:           (switch-held-items 22 40)
rlm@368:           close-all-menus)))
rlm@369: 
rlm@376: (defn regen-control-checkpoint!
rlm@376:   [] (write-script! (launch-bootstrap-program) "control-checkpoint"))
rlm@376:                     
rlm@376: (defn control-checkpoint []
rlm@376:   (read-script "control-checkpoint"))
rlm@376: 
rlm@369: (def increasing-pattern [0x01 0x23 0x45 0x67 0x89 0xAB 0xCD 0xEF])
rlm@369: 
rlm@369: (defn test-pattern-writing
rlm@369:   ([] (test-pattern-writing increasing-pattern))
rlm@369:   ([pattern]
rlm@369:      (let [moves (bootstrap-pattern pattern)
rlm@369:            pattern-insertion
rlm@369:            (->> (launch-bootstrap-program)
rlm@369:                 (play-moves
rlm@369:                  (take 100 moves)))]
rlm@369:        (println "Input Pattern:")
rlm@369:        (apply println  (map #(format "0x%02X" %) pattern))
rlm@369:        (println "\nMemory Listing:")
rlm@369:        (print-listing (second pattern-insertion)
rlm@369:                       0xD162 (+ 0xD162 (count pattern)))
rlm@369:        (= (subvec (vec (memory (second pattern-insertion)))
rlm@369:                        0xD162 (+ 0xD162 (count pattern)))
rlm@369:           pattern))))
rlm@369: 
rlm@596: 
rlm@596: (defn item-writer-test-script []
rlm@596:   [[]
rlm@596:    (-> (second (control-checkpoint))
rlm@596:        (set-memory-range
rlm@596:         (inc pc-item-list-start)
rlm@596:         (pc-item-writer-program)))])
rlm@596: 
rlm@596: 
rlm@604: (defn-memo launch-main-bootstrap-program
rlm@414:   ([] (launch-main-bootstrap-program
rlm@595:        ;;(control-checkpoint)
rlm@603:        (launch-bootstrap-program)
rlm@603:        ;;(item-writer-test-script)
rlm@414:        ))
rlm@414:   ([script]
rlm@596:      (->> script
rlm@596:           (play-moves
rlm@596:            (bootstrap-pattern (main-bootstrap-program)))
rlm@596:           ;; I'd like to just press b here, but I can't
rlm@596:           ;; because the smallest item with item id >= 75 is
rlm@596:           ;; TM01, which has value 201.
rlm@596:           ;; (* 2 (- 201 75)) == 252, which plus 1 is 253 here :(
rlm@596:           ;;(play-moves [[:b]])
rlm@602:           (play-moves
rlm@602:            (take 253 (interleave (repeat 1000 [:b])
rlm@602:                                  (repeat 1000 [])))))))
rlm@596:              
rlm@541: (def bootstrap-start pokemon-list-start)
rlm@369: 
rlm@415: (defn test-main-bootstrap-integrety
rlm@415:   []
rlm@415:   (assert
rlm@415:    (= (main-bootstrap-program)
rlm@541:       (subvec
rlm@541:        (vec (memory (second (launch-main-bootstrap-program))))
rlm@541:        pokemon-list-start
rlm@541:        (+ pokemon-list-start (count (main-bootstrap-program)))))))
rlm@415:    
rlm@414: (defn set-target-address
rlm@414:   "Assumes that the game is under control of the main-bootstrap
rlm@414:    program in MODE-SELECT mode, and sets the target address to which
rlm@414:    jumps/writes will occur."
rlm@414:   [target-address script]
rlm@414:   (let [[target-high target-low] (disect-bytes-2 target-address)]
rlm@414:     (->> script
rlm@414:          (play-moves
rlm@414:           (map buttons
rlm@414:                [set-H-mode target-high 0x00
rlm@414:                 set-L-mode target-low  0x00])))))
rlm@416: 
rlm@416: (defn write-RAM-segment
rlm@416:   "Assumes that the game is under control of the main-bootstrap
rlm@416:    program in MODE-SELECT mode and that target-address has been
rlm@416:    appropriately set, and writes 255 bytes or less to RAM."
rlm@416:   [segment script]
rlm@416:   (->> script
rlm@416:        (play-moves
rlm@416:         (map buttons
rlm@416:              [write-mode (count segment)]))
rlm@416:        (play-moves (map buttons segment))
rlm@416:        (play-moves [[]])))
rlm@416: 
rlm@414: (defn write-RAM
rlm@414:   "Assumes that the game is under control of the main-bootstrap
rlm@414:    program in MODE-SELECT mode, and rewrites RAM starting at
rlm@414:    'start-address with 'new-ram."
rlm@414:   [start-address new-ram script]
rlm@416:   (loop [s (set-target-address start-address script)
rlm@416:          to-write new-ram]
rlm@416:     (if (< (count to-write) 0x100)
rlm@416:       (write-RAM-segment to-write s)
rlm@416:       (recur
rlm@416:        (write-RAM-segment (take 0xFF to-write) s)
rlm@416:        (drop 0xFF to-write)))))
rlm@416:           
rlm@414: (defn transfer-control
rlm@414:   "Assumes that the game is under control of the main-bootstrap
rlm@414:    program in MODE-SELECT mode, and jumps to the target-address."
rlm@414:   [target-address script]
rlm@414:   (->> script
rlm@414:        (set-target-address target-address)
rlm@414:        (play-moves [(buttons jump-mode)])))
rlm@414: 
rlm@541: 
rlm@541: (def relocated-bootstrap-start
rlm@541:   (+ 90 pokemon-box-1-address))
rlm@416: 
rlm@416: (defn-memo relocate-main-bootstrap
rlm@414:   ([] (relocate-main-bootstrap (launch-main-bootstrap-program)))
rlm@414:   ([script]
rlm@541:      (->> script
rlm@541:           (do-nothing 2)
rlm@541:           (write-RAM
rlm@541:            relocated-bootstrap-start
rlm@541:            (main-bootstrap-program
rlm@541:             relocated-bootstrap-start))
rlm@541:           (do-nothing 1)
rlm@541:           (transfer-control relocated-bootstrap-start)
rlm@541:           (do-nothing 1))))
rlm@414: 
rlm@417: (defn gen-new-kernel-checkpoint! []
rlm@417:   (write-script! (do-nothing 10 (relocate-main-bootstrap))
rlm@417:                  "new-kernel"))
rlm@417: 
rlm@417: (defn new-kernel [] (read-script "new-kernel"))
rlm@417: 
rlm@414: (def mid-game-data
rlm@414:   (subvec (vec (memory (mid-game)))
rlm@414:           pokemon-list-start
rlm@416:           (+ pokemon-list-start 697)))
rlm@414: 
rlm@414: (def mid-game-map-address 0x46BC)
rlm@414: 
rlm@417: (defn-memo set-mid-game-data
rlm@414:   ([] (set-mid-game-data (relocate-main-bootstrap)))
rlm@414:   ([script]
rlm@414:      (->> script
rlm@415:           (do-nothing 10)
rlm@416:           (write-RAM pokemon-list-start
rlm@416:                      mid-game-data))))
rlm@416: (defn test-set-data
rlm@416:   ([] (test-set-data (relocate-main-bootstrap)))
rlm@416:   ([script]
rlm@416:      (->> script
rlm@416:           (do-nothing 10)
rlm@416:           (write-RAM pokemon-list-start
rlm@416:                      (repeat 500 0xCC)))))
rlm@416:       
rlm@416: (defn test-mid-game-transfer []
rlm@416:   (= (subvec (vec (memory (second (set-mid-game-data))))
rlm@416:              pokemon-list-start
rlm@416:              (+ pokemon-list-start 500))
rlm@416:      (subvec (vec (memory (mid-game)))
rlm@416:              pokemon-list-start
rlm@416:              (+ pokemon-list-start 500))))
rlm@415: 
rlm@417: (defn-memo return-to-pokemon-kernel
rlm@416:   ([] (return-to-pokemon-kernel (set-mid-game-data)))
rlm@416:   ([script]
rlm@416:      (let [scratch (+ 200 pokemon-box-1-address)
rlm@416:            return-program
rlm@416:            (flatten
rlm@416:             [0xFB
rlm@416:              0xC3
rlm@416:              (reverse (disect-bytes-2 mid-game-map-address))])]
rlm@416:        (->> script
rlm@416:             (write-RAM scratch return-program)
rlm@416:             (transfer-control scratch)
rlm@416:             (do-nothing 1)))))
rlm@416:                                               
rlm@416:        
rlm@414: 
rlm@414: 
rlm@414: