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@250:   (:use (com.aurellem.exp item-bridge)))
rlm@247: 
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: