rlm@345: (ns com.aurellem.run.bootstrap-1
rlm@377:   (:use (com.aurellem.gb saves gb-driver util constants
rlm@345:                          items vbm characters money))
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@345: (defn pc-item-writer-program
rlm@345:   []
rlm@345:   (let [limit 201
rlm@377:         [target-high target-low] (disect-bytes-2 pokemon-list-start)]
rlm@345:     (flatten
rlm@345:      [[0x00  ;; (item-hack) set increment stack pointer no-op
rlm@345:        0x1E  ;; load limit into E
rlm@345:        limit
rlm@345:        0x3F  ;; (item-hack) set carry flag no-op
rlm@345: 
rlm@345:        ;; load 2 into C.
rlm@345:        0x0E   ;; C == 1 means input-first nybble
rlm@345:        0x04   ;; C == 0 means input-second nybble
rlm@345: 
rlm@345:        0x21 ;; load target into HL
rlm@345:        target-low
rlm@345:        target-high
rlm@345:        0x37 ;; (item-hack) set carry flag no-op
rlm@345: 
rlm@345:        0x00 ;; (item-hack) no-op
rlm@345:        0x37 ;; (item-hack) set carry flag no-op
rlm@345:        
rlm@345:        0x00 ;; (item-hack) no-op
rlm@345:        0xF3 ;; disable interrupts
rlm@345:        ;; Input Section
rlm@345: 
rlm@345:        0x3E ;; load 0x20 into A, to measure buttons
rlm@345:        0x10 
rlm@345: 
rlm@345:        0x00 ;; (item-hack) no-op
rlm@345:        0xE0 ;; load A into [FF00]
rlm@345:        0x00
rlm@345: 
rlm@345:        0xF0 ;; load 0xFF00 into A to get
rlm@345:        0x00 ;; button presses
rlm@345:        
rlm@345:        0xE6
rlm@345:        0x0F ;; select bottom four bits of A
rlm@345:        0x37 ;; (item-hack) set carry flag no-op
rlm@345: 
rlm@345:        0x00 ;; (item-hack) no-op
rlm@345:        0xB8 ;; see if input is different (CP A B)
rlm@345: 
rlm@345:        0x00 ;; (item-hack) (INC SP)
rlm@345:        0x28 ;; repeat above steps if input is not different
rlm@345:        ;; (jump relative backwards if B != A)
rlm@345:        0xED ;; (literal -19) (item-hack) -19 == egg bomb (TM37)
rlm@345: 
rlm@345:        0x47 ;; load A into B
rlm@345:        
rlm@345:        0x0D ;; dec C
rlm@345:        0x37 ;; (item-hack) set-carry flag
rlm@345:        ;; branch based on C:
rlm@345:        0x20 ;; JR NZ
rlm@345:        23 ;; skip "input second nybble" and "jump to target" below
rlm@345:        
rlm@345:        ;; input second nybble
rlm@345: 
rlm@345:        0x0C ;; inc C
rlm@345:        0x0C ;; inc C
rlm@345: 
rlm@345:        0x00 ;; (item-hack) no-op
rlm@345:        0xE6 ;; select bottom bits
rlm@345:        0x0F
rlm@345:        0x37 ;; (item-hack) set-carry flag no-op
rlm@345: 
rlm@345:        0x00 ;; (item-hack) no-op
rlm@345:        0xB2 ;; (OR A D) -> A
rlm@345: 
rlm@345:        0x22 ;; (do (A -> (HL)) (INC HL))
rlm@345: 
rlm@345:        0x1D ;; (DEC E)
rlm@345: 
rlm@345:        0x00 ;; (item-hack) 
rlm@345:        0x20 ;; jump back to input section if not done
rlm@345:        0xDA ;; literal -36 == TM 18 (counter)
rlm@345:        0x01 ;; (item-hack) set BC to literal (no-op)
rlm@345: 
rlm@345:        ;; jump to target
rlm@345:        0x00  ;; (item-hack) these two bytes can be anything.
rlm@345:        0x01 
rlm@345: 
rlm@345:        0x00   ;; (item-hack) no-op
rlm@345:        0xBF   ;; (CP A A) ensures Z
rlm@345:        
rlm@345:        0xCA   ;; (item-hack) jump if Z
rlm@345:        target-low
rlm@345:        target-high
rlm@345:        0x01   ;; (item-hack) will never be reached.
rlm@345:        
rlm@345:        ;; input first nybble
rlm@345:        0x00
rlm@345:        0xCB
rlm@345:        0x37  ;; swap nybbles on A
rlm@345: 
rlm@345:        0x57  ;; A -> D
rlm@345: 
rlm@345:        0x37  ;; (item-hack) set carry flag no-op
rlm@345:        0x18  ;; relative jump backwards
rlm@345:        0xCD  ;; literal -51 == TM05; go back to input section
rlm@345:        0x01  ;; (item-hack) will never reach this instruction
rlm@345: 
rlm@345:        ]
rlm@369:       (repeat 8 [0x00 0x01]);; these can be anything
rlm@345: 
rlm@345:       [;; jump to actual program
rlm@345:        0x00
rlm@345:        0x37  ;; (item-hack) set carry flag no-op
rlm@345: 
rlm@345:        0x2E  ;; 0x3A -> L
rlm@345:        0x3A
rlm@345: 
rlm@345: 
rlm@345:        0x00  ;; (item-hack) no-op
rlm@345:        0x26  ;; 0xD5 -> L
rlm@345:        0xD5  
rlm@345:        0x01  ;; (item-hack) set-carry BC
rlm@345: 
rlm@345:        0x00  ;; (item-hack) these can be anything
rlm@345:        0x01  
rlm@345: 
rlm@345:        0x00
rlm@345:        0xE9 ;; jump to (HL)
rlm@345:        ]])))
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@369: (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@369: (defn 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@352:           (walk [↑ → → → → → → → → → → →
rlm@352:                  ↑ ↑ ↑ ↑ ↑ ↑
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@354:           (sell-held-item 0 1)
rlm@354:           (sell-held-item 0 1)
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@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@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@362:           (walk [↓ ↓ ← ←])
rlm@362:           (walk [↓ → ↓ ↓ ↓ ↓ ↓ ↓])             ; leave store
rlm@362:           (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@369: (defn to-held-items
rlm@369:   [script]
rlm@369:   (->> script
rlm@369:        close-menu
rlm@369:        close-menu
rlm@369:        end-text;;; grr
rlm@369:        
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@363: (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@368:      (->> script
rlm@368:           close-menu
rlm@368:           close-menu
rlm@368:           end-text ;;grr
rlm@368:           (walk [↓ ← ← ← ← ← ← ← ← ← ↓ ↓ ↓])
rlm@368:           (walk (repeat 17 ←))
rlm@368:           (walk [↑ → → → → ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑])
rlm@368:           (walk [↓ ← ↑])
rlm@368:           (walk [↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@368:                  ← ← ← ← ↑ ↑ ↑ ← ↑])
rlm@368:           (talk)
rlm@368:           (scroll-text 2)
rlm@369:           (do-nothing 100)
rlm@367:           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: (defn no-consecutive-repeats? [seq]
rlm@369:   (not (contains? (set(map - seq (rest seq))) 0)))
rlm@369: 
rlm@369: (defn byte->nybbles [byte]
rlm@369:   [(bit-shift-right byte 4) (bit-and byte 0x0F)])
rlm@369: 
rlm@369: (defn bootstrap-pattern
rlm@369:   "Given an assembly sequence, generate the keypresses required to
rlm@369:    create that sequence in memory using the pc-item-writer
rlm@369:    program. The assembly must not have any consecutive repeating
rlm@369:    nybbles."
rlm@369:   [assembly]
rlm@369:   (let [nybbles (flatten (map byte->nybbles assembly))
rlm@369:         moves (map (comp buttons (partial - 15)) nybbles)
rlm@369:         header (map buttons
rlm@369:                     (concat (repeat
rlm@369:                              50
rlm@369:                              (- 15 (first nybbles)))
rlm@369:                             [(first nybbles)]))
rlm@369:         tail (map buttons
rlm@369:                   (take
rlm@369:                    (- 201 (count moves))
rlm@369:                    (interleave (repeat 100 (last nybbles))
rlm@369:                                (repeat 1000 (- 15 (last nybbles))))))]
rlm@369:     (assert (no-consecutive-repeats? nybbles))
rlm@369:     (concat header moves tail)))
rlm@369: 
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@369: 
rlm@369: