Mercurial > vba-clojure

     1 (ns com.aurellem.world.practice

     2  (:use (com.aurellem.gb saves util constants gb-driver vbm items assembly characters))

     3  (:use (com.aurellem.run title))

     4  (:use (com.aurellem.exp pokemon))

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

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

     7 

     8 

     9 ;;(def original-rom (rom(root)))

    10 

    11 

    12 (def hex-pc (comp hex PC))

    13 

    14 (defn nstep [state n]

    15   (if (zero? n) state

    16       (recur (step state) (dec n))))

    17 

    18 

    19 (defn view-memory*

    20   "View a region of indexable memory in the given state."

    21   [state start length]

    22   ((comp vec map)

    23    #((comp  aget) (memory state) %)

    24    (range start (+ start length))))

    25 

    26 

    27 (defn state-surprise

    28   "This is one tick before the trainer goes [!]"

    29   []

    30   (->

    31    (pre-trainer-battle)

    32    (step [:r])

    33    (step)

    34    (ntick 88147)

    35    ;(step [:r])

    36 

    37    ;(step [:r])

    38    ;(step [:r])

    39    ;(step [:r])

    40    ;(step [:r])

    41    ))

    42 (defn state-inject

    43   "I have replaced the letter e with e-acute @ 0xC4E8."

    44   []

    45   (read-state "inject-surprise"))

    46 

    47 

    48 

    49 

    50 (defn pc-trail

    51   "Track the PC for a number of ticks."

    52   [state ticks]

    53   (tick state)

    54   (set-state! state)

    55   (loop [pcs [(PC)] ]

    56     (if (> (count pcs) ticks) pcs

    57         (do

    58           (com.aurellem.gb.Gb/tick)

    59           (recur (conj pcs (PC)))))))

    60 

    61 

    62 

    63 (defn differences [list-1 list-2]

    64   (remove

    65    (fn [[a b c]] (= b c))

    66    (map vector

    67         (range)

    68         list-1

    69         list-2)))

    70 

    71 (defn pc-diff [state-1 state-2]

    72   (differences (map hex (pc-trail state-1 10000))

    73                (map hex (pc-trail state-2 10000))))

    74 

    75 

    76 (defn memory-diff [state-1 state-2]

    77   (remove

    78   (fn[[a b c]] (= b c))

    79   (map (comp vec (partial map hex) list)

    80        (range)

    81        (vec (memory state-1))

    82        (vec (memory state-2)))

    83    )

    84   )

    85 

    86 

    87 

    88 (defn state-speak

    89   "This is when the trainer speaks."

    90   []

    91   (->

    92    (pre-trainer-battle)

    93    (set-memory 0xD354 0x0)

    94    (step [:r])

    95    (step)

    96    (ntick 88147)

    97    (tick)

    98    (nstep 102)

    99 

   100    ;(step [:r])

   101 

   102    ;(step [:r])

   103    ;(step [:r])

   104    ;(step [:r])

   105    ;(step [:r])

   106    ))

   107   

   108   

   109 

   110 (defn get-memory [state n]

   111   (aget (memory state) n))

   112 

   113 (defn first-change

   114   "Watch the current memory location as it ticks,

   115 return the first state that differs at location mem." 

   116   [state n]

   117   (tick state)

   118   (set-state! state)

   119   (let [init (aget (memory state) n)]

   120     (loop []

   121       (if (= (aget (memory) n) init)

   122         (do

   123           (com.aurellem.gb.Gb/tick)

   124           (recur))))

   125     (update-state)))

   126 

   127 

   128 

   129 

   130 (defn spell-array

   131   [array mem n]

   132   (character-codes->str

   133           (take n (drop mem

   134                         (vec array)))))

   135 

   136 (defn spell

   137   ([state mem n]

   138      (spell (memory state) mem n))

   139   ([mem n] (spell @current-state mem n)))

   140 

   141 

   142 

   143 (comment

   144   (println)

   145   (print (character-codes->str (take 6000 (drop 0xA75F4

   146                                                (vec(com.aurellem.gb.gb-driver/rom)))))))

   147 

   148 ;(dorun (map println (view-memory* (state-surprise)  0x1AEF 1600)))

   149 

   150 

   151 

   152 (def surprise-words

   153   [0x80 0xAB 0xAB 0x7F 0xB1 0xA8 0xA6 0xA7 0xB3 0xE7 0x7F 0x8B 0xA4 0xB3 0xE0 0xB2 0x7F 0xB1 0xAE 0xAB 0xAB 0x7F 0xB3 0xA7 0xA4 0x7F 0xA3 0xA8 0xA2 0xA4 0xE7])

   154 

   155 (defn sublist

   156   "Unshifts the list until the sublist is at the start."

   157   [list sub]

   158   (cond

   159     (empty? sub) list

   160     (empty? list) nil

   161     (= (take (count sub) list) sub) list

   162     :else (recur (rest list) sub)))

   163 

   164 (defn find-sublist

   165   "Returns the position of the first occurence of sublist."

   166   [list sub]

   167   (loop [n 0 a list]

   168     (cond

   169       (empty? a) nil

   170       (= (take (count sub) a) sub) n

   171       :else (recur (inc n) (rest a)))))

   172 

   173 (defn find-sublists

   174   "Returns a vector of the occurences of sublists."

   175   [list sub]

   176   (let [m (find-sublist list sub)]

   177     (if (nil? m) '()

   178         (cons m

   179               (map (partial + (inc m))

   180                    (find-sublists

   181                     (drop (inc m) list)

   182                     sub))))))

   183 

   184 

   185 

   186 (defn search-rom

   187   "Search for the given codes in ROM, returning short snippets of

   188 text around the results."

   189   ([codes k]

   190      (search-rom com.aurellem.gb.gb-driver/original-rom codes k))

   191   ([rom codes k]

   192      (map

   193       (fn [n]

   194         [(hex n)

   195          (take k (drop n rom))])

   196       

   197       (find-sublists

   198        rom

   199        codes))))

   200 

   201 (defn spelling-bee

   202   "Search for the given string in ROM, returning short snippets of

   203   text around the results."

   204   ([str k]

   205      (spelling-bee com.aurellem.gb.gb-driver/original-rom str k))

   206   ([rom str k]

   207      (map

   208       (fn [[address snip]]

   209         [address (character-codes->str snip)]

   210         (search-rom rom (str->character-codes str) k)))))

   211      

   212 

   213 

   214 

   215 

   216 (defn change-speech

   217   ([state str k]

   218      (loop [ops str

   219             s state

   220             n k]

   221        (if (empty? ops) s

   222            (recur

   223             (rest ops)

   224             (set-memory (first-change s (+ 0xC4B9 n)) (+ 0xC4B9 n)

   225                         (first ops))

   226             (if (not= n 19) (inc n)

   227                 (+ n 21))))))

   228   ([str k]

   229      (change-speech (state-speak) str k))

   230   ([str]

   231      (change-speech str 0)))

   232 

   233 

   234 

   235 (defn rewrite-memory

   236   "Alters the vector of memory. Treats strings as lists of character

   237 ops."

   238   ([mem start strs-or-ops]

   239      (let [x (first strs-or-ops)]

   240        (cond (empty? strs-or-ops) mem

   241              (string? x)

   242              

   243              (recur mem start

   244                     (concat

   245                      (str->character-codes x)

   246                      (rest strs-or-ops)))

   247         :else

   248         (recur

   249          (assoc mem start x)

   250          (inc start)

   251          (rest strs-or-ops))))))

   252 

   253 (def rewrite-rom

   254   "Alters the ROM array using write-memory. Takes a list of

   255 various strings/bytes as data."

   256   (partial rewrite-memory (vec (rom(root)))))

   257 

   258 (defn restore-rom! [] (write-rom! original-rom))

   259 

   260 

   261 

   262 (def oak-intro

   263   

   264                   (list "Hello there!"

   265                         0x4F

   266                         "Welcome to the"

   267                         0x55

   268                         "world of "

   269                         0x54

   270                         "MON!"

   271                         0x51

   272                         "My name is OAK!"

   273                         0x4F

   274                         "People call me"

   275                         0x55

   276                         "the "

   277                         0x54

   278                         "MON PROF!"

   279                         0x58

   280                         "This world is"

   281                         0x4F

   282                         "inhabited by"

   283                         0x55

   284                         "creatures called"

   285                         0x55

   286                         0x54

   287                         "MON!"

   288                         0x50

   289                         0x50

   290                         0x51

   291                         "For some people, "

   292                         0x4F

   293                         0x54

   294                         "MON are"

   295                         0x55

   296                         "pets. Others use"

   297                         0x55

   298                         "them for fights."

   299                         0x51

   300                         "Myself..."

   301                         0x51

   302                         "I study "

   303                         0x54

   304                         "MON"

   305                         0x4F

   306                         "as a profession."

   307                         0x58

   308                         "First,  what is"

   309                         0x4F

   310                         "your name?"

   311                         0x58

   312                         "This is my grand-"

   313                         0x4F

   314                         "son. He's been"

   315                         0x55

   316                         "your rival since"

   317                         0x55

   318                         "you were a baby."

   319                         0x51

   320                         "...Erm,  what is"

   321                         0x4F

   322                         "his name again?"

   323                         0x58

   324                         0x52

   325                         "!"

   326                         0x51

   327                         "Your very own"

   328                         0x4F

   329                         0x54

   330                         "MON legend is"

   331                         0x55

   332                         "about to unfold!"

   333                         0x51

   334                         "A world of dreams"

   335                         0x4F

   336                         "and adventures"

   337                         0x55

   338                         "with "

   339                         0x54

   340                         "MON"

   341                         0x55

   342                         "awaits! Let's go!"

   343                         0x57)                 )

   344 

   345 (defn state-intro

   346   "Professor Oak speaks!"

   347   []

   348   (do

   349     (->

   350      (rewrite-rom 0xA07BB

   351                   (list 0x87 0xA4 0xAB 0xAB 0xAE 0x7F 0xB3 0xA7 0xA4 0xB1 0xA4 0xE7 0x4F 0x96 0xA4 0xAB 0xA2 0xAE 0xAC 0xA4 0x7F 0xB3 0xAE 0x7F 0xB3 0xA7 0xA4 0x55 0xB6 0xAE 0xB1 0xAB 0xA3 0x7F 0xAE 0xA5 0x7F 0x54 0x8C 0x8E 0x8D 0xE7 0x51 0x8C 0xB8 0x7F 0xAD 0xA0 0xAC 0xA4 0x7F 0xA8 0xB2 0x7F 0x8E 0x80 0x8A 0xE7 0x4F 0x8F 0xA4 0xAE 0xAF 0xAB 0xA4 0x7F 0xA2 0xA0 0xAB 0xAB 0x7F 0xAC 0xA4 0x55 0xB3 0xA7 0xA4 0x7F 0x8F 0x8C 0x8E 0x8D 0x7F 0x8F 0x91 0x8E 0x85 0xE7 0x58 0x93 0xA7 0xA8 0xB2 0x7F 0xB6 0xAE 0xB1 0xAB 0xA3 0x7F 0xA8 0xB2 0x4F 0xA8 0xAD 0xA7 0xA0 0xA1 0xA8 0xB3 0xA4 0xA3 0x7F 0xA1 0xB8 0x55 0xA2 0xB1 0xA4 0xA0 0xB3 0xB4 0xB1 0xA4 0xB2 0x7F 0xA2 0xA0 0xAB 0xAB 0xA4 0xA3 0x55 0x54 0x8C 0x8E 0x8D 0xE7 0x50 0x50 0x51 0x85 0xAE 0xB1 0x7F 0xB2 0xAE 0xAC 0xA4 0x7F 0xAF 0xA4 0xAE 0xAF 0xAB 0xA4 0xF3 0x7F 0x4F 0x54 0x8C 0x8E 0x8D 0x7F 0xA0 0xB1 0xA4 0x55 0xAF 0xA4 0xB3 0xB2 0xF1 0x7F 0x8E 0xB3 0xA7 0xA4 0xB1 0xB2 0x7F 0xB4 0xB2 0xA4 0x55 0xB3 0xA7 0xA4 0xAC 0x7F 0xA5 0xAE 0xB1 0x7F 0xA5 0xA8 0xA6 0xA7 0xB3 0xB2 0xF1 0x51 0x8C 0xB8 0xB2 0xA4 0xAB 0xA5 0xF1 0xF1 0xF1 0x51 0x88 0x7F 0xB2 0xB3 0xB4 0xA3 0xB8 0x7F 0x54 0x8C 0x8E 0x8D 0x4F 0xA0 0xB2 0x7F 0xA0 0x7F 0xAF 0xB1 0xAE 0xA5 0xA4 0xB2 0xB2 0xA8 0xAE 0xAD 0xF1 0x58 0x85 0xA8 0xB1 0xB2 0xB3 0xF3 0x7F 0x7F 0xB6 0xA7 0xA0 0xB3 0x7F 0xA8 0xB2 0x4F 0xB8 0xAE 0xB4 0xB1 0x7F 0xAD 0xA0 0xAC 0xA4 0xE6 0x58 0x93 0xA7 0xA8 0xB2 0x7F 0xA8 0xB2 0x7F 0xAC 0xB8 0x7F 0xA6 0xB1 0xA0 0xAD 0xA3 0xE3 0x4F 0xB2 0xAE 0xAD 0xF1 0x7F 0x87 0xA4 0xE0 0xB2 0x7F 0xA1 0xA4 0xA4 0xAD 0x55 0xB8 0xAE 0xB4 0xB1 0x7F 0xB1 0xA8 0xB5 0xA0 0xAB 0x7F 0xB2 0xA8 0xAD 0xA2 0xA4 0x55 0xB8 0xAE 0xB4 0x7F 0xB6 0xA4 0xB1 0xA4 0x7F 0xA0 0x7F 0xA1 0xA0 0xA1 0xB8 0xF1 0x51 0xF1 0xF1 0xF1 0x84 0xB1 0xAC 0xF3 0x7F 0x7F 0xB6 0xA7 0xA0 0xB3 0x7F 0xA8 0xB2 0x4F 0xA7 0xA8 0xB2 0x7F 0xAD 0xA0 0xAC 0xA4 0x7F 0xA0 0xA6 0xA0 0xA8 0xAD 0xE6 0x58 0x52 0xE7 0x51 0x98 0xAE 0xB4 0xB1 0x7F 0xB5 0xA4 0xB1 0xB8 0x7F 0xAE 0xB6 0xAD 0x4F 0x54 0x8C 0x8E 0x8D 0x7F 0xAB 0xA4 0xA6 0xA4 0xAD 0xA3 0x7F 0xA8 0xB2 0x55 0xA0 0xA1 0xAE 0xB4 0xB3 0x7F 0xB3 0xAE 0x7F 0xB4 0xAD 0xA5 0xAE 0xAB 0xA3 0xE7 0x51 0x80 0x7F 0xB6 0xAE 0xB1 0xAB 0xA3 0x7F 0xAE 0xA5 0x7F 0xA3 0xB1 0xA4 0xA0 0xAC 0xB2 0x4F 0xA0 0xAD 0xA3 0x7F 0xA0 0xA3 0xB5 0xA4 0xAD 0xB3 0xB4 0xB1 0xA4 0xB2 0x55 0xB6 0xA8 0xB3 0xA7 0x7F 0x54 0x8C 0x8E 0x8D 0x55 0xA0 0xB6 0xA0 0xA8 0xB3 0xB2 0xE7 0x7F 0x8B 0xA4 0xB3 0xE0 0xB2 0x7F 0xA6 0xAE 0xE7 0x57 0x0 0x83 0xAE 0x7F 0xB8 0xAE 0xB4 0x7F 0xB6 0xA0 0xAD 0xB3 0x7F 0xB3 0xAE 0x4F 0xA6 0xA8 0xB5 0xA4 0x7F 0xA0 0x7F 0xAD 0xA8 0xA2 0xAA 0xAD 0xA0 0xAC 0xA4 0x55 0xB3 0xAE 0x7F 0x50 0x1 0x6D 0xCD 0x0 0xE6 0x57 0x0 0x91 0xA8 0xA6 0xA7 0xB3 0xE7 0x7F 0x92 0xAE 0x7F 0xB8 0xAE 0xB4 0xB1 0x4F 0xAD 0xA0 0xAC 0xA4 0x7F 0xA8 0xB2 0x7F 0x52 0xE7 0x58 0x0 0x93 0xA7 0xA0 0xB3 0xBD 0x7F 0xB1 0xA8 0xA6 0xA7 0xB3 0xE7 0x7F 0x88 0x4F 0xB1 0xA4 0xAC 0xA4 0xAC 0xA1 0xA4 0xB1 0x7F 0xAD 0xAE 0xB6 0xE7 0x7F 0x87 0xA8 0xB2 0x55 0xAD 0xA0 0xAC 0xA4 0x7F 0xA8 0xB2 0x7F 0x53 0xE7 0x58 0x1 0x3F 0xCD 0x0 0x7F 0xA0 0xAD 0xA3 0x4F 0x50 0x1 0x6D 0xCD 0x0 0x7F 0xB6 0xA8 0xAB 0xAB 0x55 0xA1 0xA4 0x7F 0xB3 0xB1 0xA0 0xA3 0xA4 0xA3 0xE8 0x57 0x0 0x98 0xAE 0xB4 0x7F 0xAD 0xA4 0xA4 0xA3 0x7F 0xF9 0x7F 0x54 0x8C 0x8E 0x8D 0x4F 0xB3 0xAE 0x7F 0xA5 0xA8 0xA6 0xA7 0xB3 0xE7 0x58 0x0 0x92 0xAE 0xB1 0xB1 0xB8 0xF4 0x7F 0x8C 0x84 0x96 0x7F 0xA2 0xA0 0xAD 0xBE 0x4F 0xA0 0xB3 0xB3 0xA4 0xAD 0xA3 0xE7 0x58 0x0 0x98 0xAE 0xB4 0xB1 0x7F 0x54 0x8C 0x8E 0x8D 0x7F 0xAC 0xB4 0xB2 0xB3 0x4F 0xA0 0xAB 0xAB 0x7F 0xA1 0xA4 0x7F 0xA3 0xA8 0xA5 0xA5 0xA4 0xB1 0xA4 0xAD 0xB3 0xE7 0x58 0x0 0x8D 0xAE 0x7F 0x54 0x8C 0x8E 0x8D 0x7F 0xA2 0xA0 0xAD 0x4F 0xA4 0xB7 0xA2 0xA4 0xA4 0xA3 0x7F 0x8B 0xFB 0xFB 0xE7 0x58 0x0 0x80 0xAB 0xAB 0x7F 0x54 0x8C 0x8E 0x8D 0x7F 0xAC 0xB4 0xB2 0xB3 0x4F 0xA1 0xA4 0x7F 0xA0 0xB3 0x7F 0xAB 0xA4 0xA0 0xB2 0xB3 0x7F 0x8B 0xFB 0xF6 0xE7 0x58 0x0 0x98 0xAE 0xB4 0xB1 0x7F 0xB3 0xAE 0xB3 0xA0 0xAB 0x7F 0xAB 0xA4 0xB5 0xA4 0xAB 0xB2 0x4F 0xA4 0xB7 0xA2 0xA4 0xA4 0xA3 0x7F 0xF7 0xFB 0xFB 0xE7 0x58 0x0 0x8D 0xAE 0x7F 0x54 0x8C 0x8E 0x8D 0x7F 0xA2 0xA0 0xAD 0x4F 0xA4 0xB7 0xA2 0xA4 0xA4 0xA3 0x7F 0x8B 0xF9 0xF6 0xE7 0x58 0x0 0x80 0xAB 0xAB 0x7F 0x54 0x8C 0x8E 0x8D 0x7F 0xAC 0xB4 0xB2 0xB3 0x4F 0xA1 0xA4 0x7F 0xA0 0xB3 0x7F 0xAB 0xA4 0xA0 0xB2 0xB3 0x7F 0x8B 0xF8 0xFB 0xE7 0x58 0x0 0x98 0xAE 0xB4 0xB1 0x7F 0xB3 0xAE 0xB3 0xA0 0xAB 0x7F 0xAB 0xA4 0xB5 0xA4 0xAB 0xB2 0x4F 0xA4 0xB7 0xA2 0xA4 0xA4 0xA3 0x7F 0xFE 0xF6 0xE7 0x58 0x0 0x8D 0xAE 0x7F 0x54 0x8C 0x8E 0x8D 0x7F 0xA2 0xA0 0xAD 0x4F 0xA4 0xB7 0xA2 0xA4 0xA4 0xA3 0x7F 0x8B 0xF8 0xF6 0xE7 0x58 0x0 0x80 0xAB 0xAB 0x7F 0x54 0x8C 0x8E 0x8D 0x7F 0xAC 0xB4 0xB2 0xB3 0x4F 0xA1 0xA4 0x7F 0xA0 0xB3 0x7F 0xAB 0xA4 0xA0 0xB2 0xB3 0x7F 0x8B 0xF7 0xFB 0xE7 0x58 0x0 0x98 0xAE 0xB4 0xB1 0x7F 0xB3 0xAE 0xB3 0xA0 0xAB 0x7F 0xAB 0xA4 0xB5 0xA4 0xAB 0xB2 0x4F 0xA4 0xB7 0xA2 0xA4 0xA4 0xA3 0x7F 0xFB 0xF6 0xE7 0x58 0x1 0x6D 0xCD 0x0 0x7F 0xA8 0xB2 0x7F 0xAE 0xB5 0xA4 0xB1 0x4F 0xFC 0x71 0xFE 0x73 0x7F 0xB3 0xA0 0xAB 0xAB 0xE7 0x58 0x1 0x6D 0xCD 0x0)

   352                  ;; (list

   353                  ;;  "Sleeping on the"

   354                  ;;  0x4F

   355                  ;;  "job again are we?"

   356                  ;;  0x51

   357                  ;;  0x00

   358                  ;;  "test"

   359                  ;;  0x59

   360                  ;;  "EOM")

   361 

   362  

   363                   )

   364      (int-array)

   365      (write-rom!))

   366     (root)

   367      

   368     )

   369   

   370   )

   371 

   372 (comment

   373 "Hello there![0x4F]Welcome to the[0x55]world of [POKE]MON![0x51]My

   374 name is OAK![0x4F]People call me[0x55]the [POKE]MON PROF![0x58]This

   375 world is[0x4F]inhabited by[0x55]creatures

   376 called[0x55][POKE]MON![0x50][0x50][0x51]For some people,

   377 [0x4F][POKE]MON are[0x55]pets. Others use[0x55]them for

   378 fights.[0x51]Myself...[0x51]I study [POKE]MON[0x4F]as a

   379 profession.[0x58]First,  what is[0x4F]your name?[0x58]This is my

   380 grand-[0x4F]son. He's been[0x55]your rival since[0x55]you were a

   381 baby.[0x51]...Erm,  what is[0x4F]his name again?[0x58][RED]![0x51]Your

   382 very own[0x4F][POKE]MON legend is[0x55]about to unfold![0x51]A world

   383 of dreams[0x4F]and adventures[0x55]with [POKE]MON[0x55]awaits! Let's

   384 go![0x57]")

   385 

   386 

   387 

   388 

   389 

   390 

   391 

   392 

   393 

   394 

   395 

   396 

   397
author	Robert McIntyre <rlm@mit.edu>
date	Mon, 26 Mar 2012 23:04:12 -0500
parents	a44a2c459aeb
children	a60ea8632ff4