Mercurial > vba-clojure

     1 (ns com.aurellem.run.bootstrap-0

     2   (:use (com.aurellem.gb gb-driver vbm characters))

     3   (:use (com.aurellem.run title save-corruption))

     4   (:use (com.aurellem.exp item-bridge))

     5   (:import [com.aurellem.gb.gb_driver SaveState]))

     6 

     7 (defn-memo boot-root []

     8   [ [] (root)])

     9   

    10 (defn-memo to-rival-name

    11   ([] (to-rival-name (boot-root)))

    12   ([script]

    13      (-> script

    14          title

    15          oak

    16          name-entry-rlm

    17          scroll-text

    18          scroll-text

    19          scroll-text

    20          scroll-text

    21          scroll-text

    22          )))

    23 

    24 (defn-memo name-rival-bootstrap

    25   ([] (name-rival-bootstrap (to-rival-name)))

    26   ([script]

    27      (->> script

    28          (advance [] [:a])

    29          (advance [] [:r] DE)

    30          (play-moves

    31           [[]

    32            [:r] [] [:r] [] [:r] [] [:r] []

    33            [:r] [] [:r] [] [:r] [] [:d] []

    34            [:d] [:a]                         ;; space

    35            [:l] [] [:d] [:a]                 ;; [PK]

    36            [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G

    37            [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]

    38            [:u] [] [:u] [] [:u] [] [:l] [:a] ;; G

    39            [:d] [] [:d] [] [:d] [] [:r] [:a] ;; [PK]

    40 

    41            [:d] [] [:r] [:a]                 ;; finish

    42            ]))))

    43 

    44 (defn walk

    45   "Move the character along the given directions."

    46   [directions script]

    47   (reduce (fn [script direction]

    48             (move direction script))

    49           script directions))

    50 

    51 (def ↑ [:u])

    52 (def ↓ [:d])

    53 (def ← [:l])

    54 (def → [:r])

    55 

    56 (defn-memo leave-house

    57   ([] (leave-house (name-rival-bootstrap)))

    58   ([script]

    59      (->> script

    60           finish-title

    61           start-walking

    62           walk-to-stairs

    63           walk-to-door

    64           (walk [↓ ↓]))))

    65 

    66 (defn-memo to-pallet-town-edge

    67   ([] (to-pallet-town-edge (leave-house)))

    68   ([script]

    69      (->> script

    70           start-walking

    71           (walk [→ → → → →

    72                  ↑ ↑ ↑ ↑ ↑ ↑]))))

    73 

    74 (defn end-text [script]

    75   (->> script

    76        (scroll-text)

    77        (play-moves [[] [:a]])))

    78 

    79 (defn-memo start-pikachu-battle

    80   ([] (start-pikachu-battle

    81        (to-pallet-town-edge)))

    82   ([script]

    83      (->> script

    84           (advance [:b] [:b :a] DE)

    85           (scroll-text)

    86           (play-moves [[:b]])

    87           (scroll-text)

    88           (end-text) ;; battle begins

    89           (scroll-text))))

    90 

    91 (defn-memo capture-pikachu

    92   ([] (capture-pikachu (start-pikachu-battle)))

    93   ([script]

    94      (->> script

    95           (scroll-text 2)

    96           (end-text))))

    97 

    98 (defn-memo go-to-lab

    99   ([] (go-to-lab (capture-pikachu)))

   100   ([script]

   101      (->> script

   102           (scroll-text 5)

   103           (end-text)

   104           (scroll-text)

   105           (end-text)

   106           (scroll-text 8)

   107           (end-text)

   108           (scroll-text)

   109           (end-text))))

   110 

   111 (defn-memo obtain-pikachu

   112   ([] (obtain-pikachu (go-to-lab)))

   113   ([script]

   114      (->> script

   115           (scroll-text)

   116           (play-moves

   117            (concat 

   118             (repeat 51 [])

   119             [[:a] []]))

   120           (walk [↓ ↓ → → ↑])

   121           (play-moves

   122            (concat [[] [:a]]

   123                    (repeat 100 [])))

   124           (scroll-text 9)

   125           (end-text)

   126           (scroll-text 7)

   127 

   128           (play-moves

   129            (concat

   130             (repeat 42 [])

   131                    [[:b] [:b] [:b] [:b]])))))

   132 

   133 (defn-memo begin-battle-with-rival

   134   ([] (begin-battle-with-rival

   135         (obtain-pikachu)))

   136   ([script]

   137      (->> script

   138           (walk [↓ ↓ ↓ ↓])

   139           (scroll-text 3)

   140           (end-text)

   141           (scroll-text))))

   142 

   143 (defn search-string

   144   [array string]

   145   (let [codes

   146         (str->character-codes string)

   147         codes-length (count codes)

   148         mem (vec array)

   149         mem-length (count mem)]

   150     (loop [idx 0]

   151       (if (< (- mem-length idx) codes-length)

   152         nil

   153         (if (= (subvec mem idx (+ idx codes-length))

   154                codes)

   155           idx

   156           (recur (inc idx)))))))

   157         

   158 (defn critical-hit

   159   "Put the cursor over the desired attack. This program will

   160    determine the appropriate amount of blank frames to

   161    insert before pressing [:a] to ensure that the attack is

   162    a critical hit."

   163   [script]

   164   (loop [blanks 6]

   165     (let [new-script

   166           (->> script

   167                (play-moves

   168                 (concat (repeat blanks [])

   169                         [[:a][]])))]

   170       (if (let [future-state

   171                 (run-moves (second new-script)

   172                            (repeat 400 []))

   173 

   174                 result (search-string (memory future-state)

   175                                       "Critical")]

   176             (if result

   177               (println "critical hit with" blanks "blank frames"))

   178             result) 

   179         new-script

   180         (recur (inc blanks))))))  

   181 

   182 (defn-memo battle-with-rival

   183   ([] (battle-with-rival

   184         (begin-battle-with-rival)))

   185   ([script]

   186      (->> script

   187           (play-moves (repeat 381 []))

   188           (play-moves [[:a]])

   189           (critical-hit)

   190           (play-moves (repeat 100 []))

   191           (scroll-text)

   192           (play-moves

   193            (concat (repeat 275 []) [[:a]]))

   194           (critical-hit)

   195           (play-moves (repeat 100 []))

   196           (scroll-text)

   197           (play-moves

   198            (concat (repeat 270 []) [[:a]]))

   199           (play-moves [[][][][][][][][][:a]]))))

   200 

   201 (defn-memo finish-rival-text

   202   ([] (finish-rival-text

   203        (battle-with-rival)))

   204   ([script]

   205      (->> script

   206           (scroll-text 2)

   207           (end-text)

   208           (scroll-text 9)

   209           (end-text))))

   210 

   211 (defn do-nothing [n script]

   212   (->> script

   213        (play-moves

   214         (repeat n []))))

   215 

   216 (defn-memo pikachu-comes-out

   217   ([] (pikachu-comes-out

   218        (finish-rival-text)))

   219   ([script]

   220      (->> script

   221           (do-nothing 177)

   222           (end-text)

   223           (scroll-text 7)

   224           (end-text))))

   225 

   226 (defn-memo leave-oaks-lab

   227   ([] (leave-oaks-lab

   228        (pikachu-comes-out)))

   229   ([script]

   230      (->> script 

   231           (walk [← ← ↓ ↓ ↓ ↓ ↓ ↓]))))

   232 

   233 (defn-memo  oaks-lab->pallet-town-edge

   234   ([] (oaks-lab->pallet-town-edge

   235        (leave-oaks-lab)))

   236   ([script]

   237      (->> script

   238           (walk [← ← ← ←

   239                  ↑ ↑ ↑ ↑

   240                  ↑ ↑ ↑ ↑ ↑ ↑

   241                  → ↑]))))

   242                  

   243 

   244 (defn move-thru-grass

   245   [direction script]

   246   (loop [blanks 0]

   247     (let [new-script

   248           (->> script

   249                (play-moves (repeat blanks []))

   250                (move direction))

   251 

   252           future-state

   253           (run-moves (second new-script)

   254                      (repeat 600 []))

   255           

   256           result (search-string (memory future-state)

   257                                 "Wild")]

   258       (if (nil? result)

   259         new-script

   260         (recur (inc blanks))))))

   261 

   262 (defn walk-thru-grass

   263   [directions script]

   264   (reduce (fn [script direction]

   265             (move-thru-grass direction script))

   266           script directions))

   267 

   268 (defn-memo pallet-edge->viridian-mart

   269   ([] (pallet-edge->viridian-mart

   270        (oaks-lab->pallet-town-edge)))

   271   ([script]

   272      (->> script

   273           ;; leave straight grass

   274           (walk-thru-grass

   275            [↑ ↑ ↑ ↑ ↑])

   276           

   277           (walk [↑ ↑ ↑ ↑])

   278 

   279           

   280           (walk-thru-grass

   281            [← ← ↑])

   282           (walk [↑ ↑ ↑ ↑ → → → ])

   283 

   284           (walk-thru-grass

   285            [→ ↑ ↑ ←])

   286 

   287           (walk

   288            [← ←

   289             ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑

   290             → → → → ])

   291 

   292           (walk-thru-grass

   293            [→ →

   294             ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ])

   295            

   296           (walk

   297            [↑ ↑

   298             ← ← ← ←

   299             ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑ ↑

   300             ← ←

   301             ↑ ↑ ↑ ↑

   302             → → → → → → → → → →

   303             ↑ ↑ ↑ ↑ ↑ ↑])))) 

   304
author	Robert McIntyre <rlm@mit.edu>
date	Mon, 26 Mar 2012 22:45:27 -0500
parents	868783405ac2
children	c85549460218