Mercurial > vba-clojure

annotate clojure/com/aurellem/run/bootstrap_0.clj @ 258:2a46422902be

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
script: got pikachu.
author Robert McIntyre <rlm@mit.edu>
date Mon, 26 Mar 2012 18:01:39 -0500
parents 8d1a354f7471
children 11cfe6dcb803
rev   line source
rlm@247 1 (ns com.aurellem.run.bootstrap-0
rlm@247 2 (:use (com.aurellem.gb gb-driver vbm))
rlm@250 3 (:use (com.aurellem.run title save-corruption))
rlm@250 4 (:use (com.aurellem.exp item-bridge)))
rlm@247 5
rlm@247 6
rlm@250 7 (defn-memo boot-root []
rlm@255 8 [ [] (root)])
rlm@247 9
rlm@255 10 (defn-memo to-rival-name
rlm@255 11 ([] (to-rival-name (boot-root)))
rlm@255 12 ([script]
rlm@255 13 (-> script
rlm@255 14 title
rlm@255 15 oak
rlm@255 16 name-entry-rlm
rlm@255 17 scroll-text
rlm@255 18 scroll-text
rlm@255 19 scroll-text
rlm@255 20 scroll-text
rlm@255 21 scroll-text
rlm@255 22 )))
rlm@247 23
rlm@255 24 (defn-memo name-rival-bootstrap
rlm@255 25 ([] (name-rival-bootstrap (to-rival-name)))
rlm@255 26 ([script]
rlm@255 27 (->> script
rlm@255 28 (advance [] [:a])
rlm@255 29 (advance [] [:r] DE)
rlm@255 30 (play-moves
rlm@255 31 [[]
rlm@255 32 [:r] [] [:r] [] [:r] [] [:r] []
rlm@255 33 [:r] [] [:r] [] [:r] [] [:d] []
rlm@255 34 [:d] [:a] ;; space
rlm@255 35 [:l] [] [:d] [:a] ;; [PK]
rlm@255 36 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
rlm@255 37 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
rlm@255 38 [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G
rlm@255 39 [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]
rlm@247 40
rlm@255 41 [:d] [] [:r] [:a] ;; finish
rlm@255 42 ]))))
rlm@255 43
rlm@255 44 (defn walk
rlm@255 45 "Move the character along the given directions."
rlm@255 46 [directions script]
rlm@255 47 (reduce (fn [script direction]
rlm@255 48 (move direction script))
rlm@255 49 script directions))
rlm@255 50
rlm@255 51 (def ↑ [:u])
rlm@255 52 (def ↓ [:d])
rlm@255 53 (def ← [:l])
rlm@255 54 (def → [:r])
rlm@255 55
rlm@255 56 (defn-memo leave-house
rlm@255 57 ([] (leave-house (name-rival-bootstrap)))
rlm@255 58 ([script]
rlm@255 59 (->> script
rlm@255 60 finish-title
rlm@255 61 start-walking
rlm@255 62 walk-to-stairs
rlm@255 63 walk-to-door
rlm@255 64 (walk [↓ ↓]))))
rlm@255 65
rlm@255 66 (defn-memo to-pallet-town-edge
rlm@255 67 ([] (to-pallet-town-edge (leave-house)))
rlm@255 68 ([script]
rlm@255 69 (->> script
rlm@255 70 start-walking
rlm@255 71 (walk [→ → → → →
rlm@255 72 ↑ ↑ ↑ ↑ ↑ ↑]))))
rlm@255 73
rlm@257 74 (defn end-text [script]
rlm@257 75 (->> script
rlm@257 76 (scroll-text)
rlm@257 77 (play-moves [[] [:a]])))
rlm@257 78
rlm@257 79 (defn-memo start-pikachu-battle
rlm@257 80 ([] (start-pikachu-battle
rlm@257 81 (to-pallet-town-edge)))
rlm@257 82 ([script]
rlm@257 83 (->> script
rlm@257 84 (advance [:b] [:b :a] DE)
rlm@257 85 (scroll-text)
rlm@257 86 (play-moves [[:b]])
rlm@257 87 (scroll-text)
rlm@257 88 (end-text) ;; battle begins
rlm@257 89 (scroll-text))))
rlm@257 90
rlm@257 91 (defn-memo capture-pikachu
rlm@257 92 ([] (capture-pikachu (start-pikachu-battle)))
rlm@257 93 ([script]
rlm@257 94 (->> script
rlm@257 95 (scroll-text 2)
rlm@257 96 (end-text))))
rlm@257 97
rlm@257 98 (defn-memo go-to-lab
rlm@257 99 ([] (go-to-lab (capture-pikachu)))
rlm@257 100 ([script]
rlm@257 101 (->> script
rlm@257 102 (scroll-text 5)
rlm@257 103 (end-text)
rlm@257 104 (scroll-text)
rlm@257 105 (end-text)
rlm@257 106 (scroll-text 8)
rlm@257 107 (end-text)
rlm@257 108 (scroll-text)
rlm@257 109 (end-text))))
rlm@257 110
rlm@257 111 (defn-memo obtain-pikachu
rlm@257 112 ([] (obtain-pikachu (go-to-lab)))
rlm@257 113 ([script]
rlm@257 114 (->> script
rlm@257 115 (scroll-text)
rlm@257 116 (play-moves
rlm@257 117 (concat
rlm@257 118 (repeat 51 [])
rlm@257 119 [[:a] []]))
rlm@257 120 (walk [↓ ↓ → → ↑])
rlm@258 121 (play-moves
rlm@258 122 (concat [[] [:a]]
rlm@258 123 (repeat 100 [])))
rlm@258 124 (scroll-text 9)
rlm@258 125 (end-text)
rlm@258 126 (scroll-text 7)
rlm@258 127
rlm@258 128 (play-moves
rlm@258 129 (concat
rlm@258 130 (repeat 42 [])
rlm@258 131 [[:b]])))))
rlm@258 132
rlm@258 133 (defn-memo begin-battle-with-rival
rlm@258 134 ([] (begin-battle-with-rival
rlm@258 135 (obtain-pikachu)))
rlm@258 136 ([script]
rlm@258 137 (->> script
rlm@258 138 (play-moves
rlm@258 139 (repeat 200 [:b]))
rlm@258 140 (play-moves
rlm@258 141 (repeat 200 []))
rlm@258 142 (walk [↓ ↓ ↓]))))
rlm@258 143
rlm@258 144
rlm@257 145
rlm@257 146
rlm@257 147
rlm@257 148