rlm@247: (ns com.aurellem.run.bootstrap-0
rlm@260:   (:use (com.aurellem.gb gb-driver vbm characters))
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@255:          scroll-text
rlm@255:          )))
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@262: (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@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@264:   ([] (pallet-edge->viridian-mart
rlm@264:        (oaks-lab->pallet-town-edge)))
rlm@264:   ([script]
rlm@264:      (->> 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@266:           ;; this part it dependent on that
rlm@266:           ;; stupid NPC in the grass patch
rlm@264:           (walk-thru-grass
rlm@264:            [→ →
rlm@264:             ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ])
rlm@264:            
rlm@264:           (walk
rlm@264:            [↑ ↑
rlm@264:             ← ← ← ←
rlm@264:             ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑
rlm@264:             ← ←
rlm@264:             ↑ ↑ ↑ ↑
rlm@264:             → → → → → → → → → →
rlm@266:             ↑ ↑ ↑ ↑ ↑ ↑ ↑])))) 
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@270: 
rlm@270:           (walk [← ← ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓])
rlm@270:           
rlm@270:           )))