rlm@247: (ns com.aurellem.run.bootstrap-0
rlm@277:   (:use (com.aurellem.gb gb-driver vbm characters money))
rlm@250:   (:use (com.aurellem.run 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@255:      (-> script
rlm@255:          title
rlm@255:          oak
rlm@255:          name-entry-rlm
rlm@255:          scroll-text
rlm@255:          scroll-text
rlm@255:          scroll-text
rlm@255:          scroll-text
rlm@274:          scroll-text)))
rlm@247: 
rlm@255: (defn-memo name-rival-bootstrap
rlm@255:   ([] (name-rival-bootstrap (to-rival-name)))
rlm@255:   ([script]
rlm@255:      (->> script
rlm@255:          (advance [] [:a])
rlm@255:          (advance [] [:r] DE)
rlm@255:          (play-moves
rlm@255:           [[]
rlm@255:            [:r] [] [:r] [] [:r] [] [:r] []
rlm@255:            [:r] [] [:r] [] [:r] [] [:d] []
rlm@255:            [:d] [:a]                         ;; space
rlm@255:            [:l] [] [:d] [:a]                 ;; [PK]
rlm@255:            [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
rlm@255:            [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
rlm@255:            [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
rlm@255:            [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
rlm@247: 
rlm@255:            [:d] [] [:r] [:a]                 ;; finish
rlm@255:            ]))))
rlm@255: 
rlm@255: (defn walk
rlm@255:   "Move the character along the given directions."
rlm@255:   [directions script]
rlm@255:   (reduce (fn [script direction]
rlm@255:             (move direction script))
rlm@255:           script directions))
rlm@255: 
rlm@255: (def ↑ [:u])
rlm@255: (def ↓ [:d])
rlm@255: (def ← [:l])
rlm@255: (def → [:r])
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:           start-walking
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:           start-walking
rlm@255:           (walk [→ → → → →
rlm@255:                  ↑ ↑ ↑ ↑ ↑ ↑]))))
rlm@255: 
rlm@257: (defn end-text [script]
rlm@257:   (->> script
rlm@257:        (scroll-text)
rlm@257:        (play-moves [[] [:a]])))
rlm@257: 
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@257:           (advance [:b] [:b :a] DE)
rlm@257:           (scroll-text)
rlm@257:           (play-moves [[:b]])
rlm@257:           (scroll-text)
rlm@257:           (end-text) ;; battle begins
rlm@257:           (scroll-text))))
rlm@257: 
rlm@257: (defn-memo capture-pikachu
rlm@257:   ([] (capture-pikachu (start-pikachu-battle)))
rlm@257:   ([script]
rlm@257:      (->> script
rlm@257:           (scroll-text 2)
rlm@257:           (end-text))))
rlm@257: 
rlm@257: (defn-memo go-to-lab
rlm@257:   ([] (go-to-lab (capture-pikachu)))
rlm@257:   ([script]
rlm@257:      (->> script
rlm@257:           (scroll-text 5)
rlm@257:           (end-text)
rlm@257:           (scroll-text)
rlm@257:           (end-text)
rlm@257:           (scroll-text 8)
rlm@257:           (end-text)
rlm@257:           (scroll-text)
rlm@257:           (end-text))))
rlm@257: 
rlm@257: (defn-memo obtain-pikachu
rlm@257:   ([] (obtain-pikachu (go-to-lab)))
rlm@257:   ([script]
rlm@257:      (->> script
rlm@257:           (scroll-text)
rlm@257:           (play-moves
rlm@257:            (concat 
rlm@257:             (repeat 51 [])
rlm@257:             [[:a] []]))
rlm@257:           (walk [↓ ↓ → → ↑])
rlm@258:           (play-moves
rlm@258:            (concat [[] [:a]]
rlm@258:                    (repeat 100 [])))
rlm@258:           (scroll-text 9)
rlm@258:           (end-text)
rlm@258:           (scroll-text 7)
rlm@258: 
rlm@258:           (play-moves
rlm@258:            (concat
rlm@258:             (repeat 42 [])
rlm@260:                    [[:b] [:b] [:b] [:b]])))))
rlm@258: 
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@260:           (walk [↓ ↓ ↓ ↓])
rlm@260:           (scroll-text 3)
rlm@260:           (end-text)
rlm@260:           (scroll-text))))
rlm@260: 
rlm@260: (defn search-string
rlm@260:   [array string]
rlm@260:   (let [codes
rlm@260:         (str->character-codes string)
rlm@260:         codes-length (count codes)
rlm@260:         mem (vec array)
rlm@260:         mem-length (count mem)]
rlm@260:     (loop [idx 0]
rlm@260:       (if (< (- mem-length idx) codes-length)
rlm@260:         nil
rlm@260:         (if (= (subvec mem idx (+ idx codes-length))
rlm@260:                codes)
rlm@260:           idx
rlm@260:           (recur (inc idx)))))))
rlm@260:         
rlm@260: (defn critical-hit
rlm@260:   "Put the cursor over the desired attack. This program will
rlm@260:    determine the appropriate amount of blank frames to
rlm@260:    insert before pressing [:a] to ensure that the attack is
rlm@260:    a critical hit."
rlm@260:   [script]
rlm@260:   (loop [blanks 6]
rlm@260:     (let [new-script
rlm@260:           (->> script
rlm@260:                (play-moves
rlm@260:                 (concat (repeat blanks [])
rlm@260:                         [[:a][]])))]
rlm@260:       (if (let [future-state
rlm@260:                 (run-moves (second new-script)
rlm@260:                            (repeat 400 []))
rlm@260: 
rlm@260:                 result (search-string (memory future-state)
rlm@260:                                       "Critical")]
rlm@260:             (if result
rlm@260:               (println "critical hit with" blanks "blank frames"))
rlm@260:             result) 
rlm@260:         new-script
rlm@260:         (recur (inc blanks))))))  
rlm@260: 
rlm@260: (defn-memo battle-with-rival
rlm@260:   ([] (battle-with-rival
rlm@260:         (begin-battle-with-rival)))
rlm@260:   ([script]
rlm@260:      (->> script
rlm@260:           (play-moves (repeat 381 []))
rlm@260:           (play-moves [[:a]])
rlm@260:           (critical-hit)
rlm@260:           (play-moves (repeat 100 []))
rlm@260:           (scroll-text)
rlm@258:           (play-moves
rlm@260:            (concat (repeat 275 []) [[:a]]))
rlm@260:           (critical-hit)
rlm@260:           (play-moves (repeat 100 []))
rlm@260:           (scroll-text)
rlm@258:           (play-moves
rlm@260:            (concat (repeat 270 []) [[:a]]))
rlm@260:           (play-moves [[][][][][][][][][:a]]))))
rlm@260: 
rlm@260: (defn-memo finish-rival-text
rlm@260:   ([] (finish-rival-text
rlm@260:        (battle-with-rival)))
rlm@260:   ([script]
rlm@260:      (->> script
rlm@260:           (scroll-text 2)
rlm@260:           (end-text)
rlm@260:           (scroll-text 9)
rlm@260:           (end-text))))
rlm@260: 
rlm@262: (defn do-nothing [n script]
rlm@262:   (->> script
rlm@262:        (play-moves
rlm@262:         (repeat n []))))
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@262:           (do-nothing 177)
rlm@262:           (end-text)
rlm@262:           (scroll-text 7)
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@262:           (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@262:           (walk [← ← ← ←
rlm@262:                  ↑ ↑ ↑ ↑
rlm@262:                  ↑ ↑ ↑ ↑ ↑ ↑
rlm@262:                  → ↑]))))
rlm@264: 
rlm@264: (defn move-thru-grass
rlm@264:   [direction script]
rlm@264:   (loop [blanks 0]
rlm@264:     (let [new-script
rlm@264:           (->> script
rlm@264:                (play-moves (repeat blanks []))
rlm@264:                (move direction))
rlm@264: 
rlm@264:           future-state
rlm@264:           (run-moves (second new-script)
rlm@264:                      (repeat 600 []))
rlm@264:           
rlm@264:           result (search-string (memory future-state)
rlm@264:                                 "Wild")]
rlm@264:       (if (nil? result)
rlm@264:         new-script
rlm@264:         (recur (inc blanks))))))
rlm@264: 
rlm@264: (defn walk-thru-grass
rlm@264:   [directions script]
rlm@264:   (reduce (fn [script direction]
rlm@264:             (move-thru-grass direction script))
rlm@264:           script directions))
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@271:                      [↑ ↑ ←])]
rlm@271:        
rlm@271:        (->> script
rlm@264:           ;; leave straight grass
rlm@264:           (walk-thru-grass
rlm@264:            [↑ ↑ ↑ ↑ ↑])
rlm@264:           
rlm@264:           (walk [↑ ↑ ↑ ↑])
rlm@264:           
rlm@264:           (walk-thru-grass
rlm@264:            [← ← ↑])
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@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@269:                  ← ← ← ← ← ← ← ← ← ← 
rlm@269:                  ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269:                  ← ←
rlm@269:                  ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269:                  ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269:                  → → → → → → → →
rlm@269:                  ↓ ↓ ↓ ↓
rlm@269:                  ← ← ← ← ←
rlm@269:                  ↓ ↓ ↓ ↓])
rlm@266: 
rlm@269:           (walk-thru-grass
rlm@269:            [↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@269: 
rlm@269:           (walk [↓ ↓ ← ↓ ↓ ↓ ←
rlm@269:                  ↓ ↓ ↓ ↓ ↓
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@269:                  ← ← ← ← ← ← ← ← ← ← 
rlm@269:                  ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@269: 
rlm@269:           (walk-thru-grass
rlm@269:            [↓ ↓ ↓ ↓ ↓])
rlm@269: 
rlm@269:           (walk
rlm@269:            [↓ ↓ ← ↓
rlm@269:             ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓
rlm@269:             → →])
rlm@269: 
rlm@269:           (walk-thru-grass
rlm@269:            [→ ↓ ↓ ↓])
rlm@269: 
rlm@269:           (walk [↓ ← ← ↓ ↓ ↓ ↓ ↓ ↓])
rlm@269:           
rlm@269:           (walk-thru-grass
rlm@269:            [↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@269:           
rlm@269:           (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@270:           (play-moves [[:a]])
rlm@270:           (scroll-text 11)
rlm@270:           (end-text)
rlm@270:           (end-text)
rlm@270:           (do-nothing 200)
rlm@270:           (end-text)
rlm@270:           (scroll-text 3)
rlm@270:           (end-text)
rlm@270:           (scroll-text 2)
rlm@270:           (end-text)
rlm@270:           (scroll-text 5)
rlm@270:           (end-text)
rlm@270:           (scroll-text 2)
rlm@270:           (end-text)
rlm@270:           (scroll-text 9)
rlm@270:           (end-text)
rlm@270:           (scroll-text 7)
rlm@270:           (end-text)
rlm@271:           (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@274:           (walk [↑ ↑ ← ←]))))
rlm@275: 
rlm@275: (defn buy-item
rlm@275:   "Assumes that the main item-screen is up, and buys
rlm@275:    quantity of the nth item in the list, assuming that you
rlm@275:    have enough money."
rlm@275:   [n quantity script]
rlm@275:   (if (= 0  quantity)
rlm@275:     script
rlm@275:     (let [after-initial-pause
rlm@275:           (do-nothing 20  script)
rlm@275:           move-to-item
rlm@275:           (reduce (fn [script _]
rlm@275:                     (->> script
rlm@275:                          (play-moves [[:d]])
rlm@275:                          (do-nothing 3)))
rlm@275:                   after-initial-pause
rlm@275:                   (range n))
rlm@275:           select-item
rlm@275:           (play-moves [[:a]] move-to-item)
rlm@275:           request-items
rlm@275:           (reduce (fn [script _]
rlm@275:                     (->> script
rlm@275:                          (play-moves [[:u]])
rlm@275:                          (do-nothing 1)))
rlm@275:                   select-item
rlm@275:                   (range (dec quantity)))
rlm@275:           buy-items
rlm@275:           (->> request-items
rlm@275:                (do-nothing 3)
rlm@275:                (play-moves [[:a]])
rlm@275:                (scroll-text)
rlm@275:                (scroll-text)
rlm@275:                (play-moves [[:a]])
rlm@275:                (scroll-text))]
rlm@275:       buy-items)))
rlm@275:      
rlm@275: 
rlm@275: (defn buy-items
rlm@275:   "Given a list of [item-no quantity], buys the quantity
rlm@275:    from the shop's list. Assumes that the item list is
rlm@275:    already up."
rlm@275:   [item-pairs script]
rlm@275:   (let [item-lookup (into {0 0 1 0 2 0 3 0 4 0} item-pairs)
rlm@275:         initial-purchase
rlm@275:         (->> script
rlm@275:              (buy-item 0 (item-lookup 0))
rlm@275:              (buy-item 1 (item-lookup 1))
rlm@275:              (buy-item 2 (item-lookup 2)))]
rlm@275:     (cond
rlm@275:       (and
rlm@275:        (not= 0 (item-lookup 3))
rlm@275:        (not= 0 (item-lookup 4)))
rlm@275:       (->> initial-purchase
rlm@275:            (do-nothing 20)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 3)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 3)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 10)
rlm@275:            (buy-item 0 (item-lookup 3))
rlm@275:            (do-nothing 20)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 3)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 3)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 10)
rlm@275:            (buy-item 0 (item-lookup 4)))
rlm@275:       (and (= 0 (item-lookup 3))
rlm@275:            (not= 0 (item-lookup 4)))
rlm@275:       (->> initial-purchase
rlm@275:            (do-nothing 20)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 3)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 3)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 10)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 10)
rlm@275:            (buy-item 0 (item-lookup 4)))
rlm@275:       (and (not= 0 (item-lookup 3))
rlm@275:            (= 0 (item-lookup 4)))
rlm@275:       (->> initial-purchase
rlm@275:            (do-nothing 20)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 3)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 3)
rlm@275:            (play-moves [[:d]])
rlm@275:            (do-nothing 10)
rlm@275:            (buy-item 0 (item-lookup 3))))))
rlm@275: 
rlm@275: 
rlm@275: (defn test-buy-items
rlm@277:   ([] (test-buy-items
rlm@274:        (walk-to-counter)))
rlm@274:   ([script]
rlm@275:      (->> [(first script) (set-money (second script)
rlm@275:                                      999999)]
rlm@274:           (play-moves
rlm@274:            [[] [:a] []])
rlm@274:           (scroll-text)
rlm@274:           (do-nothing 100)
rlm@274:           (play-moves [[:a]])
rlm@274:           (do-nothing 100)
rlm@275:           (buy-items
rlm@275:            [[0 1]
rlm@275:             [1 15]
rlm@275:             [2 1]
rlm@275:             [3 20]
rlm@275:             [4 95]
rlm@275:             ]))))
rlm@275: 
rlm@275: (defn-memo buy-initial-items
rlm@275:   ([] (buy-initial-items
rlm@275:        (walk-to-counter)))
rlm@275:   ([script]
rlm@275:      (->> script
rlm@275:           (play-moves
rlm@275:            [[] [:a] []])
rlm@274:           (scroll-text)
rlm@274:           (do-nothing 100)
rlm@274:           (play-moves [[:a]])
rlm@274:           (do-nothing 100)
rlm@275:           (buy-items
rlm@275:            [[0 1]
rlm@275:             [1 1]
rlm@275:             [2 1]
rlm@275:             [3 1]
rlm@275:             [4 1]
rlm@275:             ]))))
rlm@274: 
rlm@274: 
rlm@274:           
rlm@274: