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.exp pokemon))

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

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

     6 

     7 

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

     9 

    10 

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

    12 

    13 (defn nstep [state n]

    14   (if (zero? n) state

    15       (recur (step state) (dec n))))

    16 

    17 

    18 (defn view-memory*

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

    20   [state start length]

    21   ((comp vec map)

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

    23    (range start (+ start length))))

    24 

    25 

    26 (defn state-surprise

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

    28   []

    29   (->

    30    (pre-trainer-battle)

    31    (step [:r])

    32    (step)

    33    (ntick 88147)

    34    ;(step [:r])

    35 

    36    ;(step [:r])

    37    ;(step [:r])

    38    ;(step [:r])

    39    ;(step [:r])

    40    ))

    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 (defn state-speak

    88   "This is when the trainer speaks."

    89   []

    90   (->

    91    (pre-trainer-battle)

    92    (set-memory 0xD354 0x0)

    93    (step [:r])

    94    (step)

    95    (ntick 88147)

    96    (tick)

    97    (nstep 102)

    98 

    99    ;(step [:r])

   100 

   101    ;(step [:r])

   102    ;(step [:r])

   103    ;(step [:r])

   104    ;(step [:r])

   105    ))

   106   

   107   

   108 

   109 (defn get-memory [state n]

   110   (aget (memory state) n))

   111 

   112 (defn first-change

   113   "Watch the current memory location as it ticks,

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

   115   [state n]

   116   (tick state)

   117   (set-state! state)

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

   119     (loop []

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

   121         (do

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

   123           (recur))))

   124     (update-state)))

   125 

   126 

   127 

   128 

   129 (defn spell-array

   130   [array mem n]

   131   (character-codes->str

   132           (take n (drop mem

   133                         (vec array)))))

   134 

   135 (defn spell

   136   ([state mem n]

   137      (spell (memory state) mem n))

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

   139 

   140 

   141 

   142 (comment

   143   (println)

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

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

   146 

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

   148 

   149 

   150 

   151 (def surprise-words

   152   [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])

   153 

   154 (defn sublist

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

   156   [list sub]

   157   (cond

   158     (empty? sub) list

   159     (empty? list) nil

   160     (= (take (count sub) list) sub) list

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

   162 

   163 (defn find-sublist

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

   165   [list sub]

   166   (loop [n 0 a list]

   167     (cond

   168       (empty? a) nil

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

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

   171 

   172 (defn find-sublists

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

   174   [list sub]

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

   176     (if (nil? m) '()

   177         (cons m

   178               (map (partial + (inc m))

   179                    (find-sublists

   180                     (drop (inc m) list)

   181                     sub))))))

   182 

   183 

   184 

   185 (defn search-rom

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

   187 text around the results."

   188   ([codes k]

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

   190   ([rom codes k]

   191      (map

   192       (fn [n]

   193         [(hex n)

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

   195       

   196       (find-sublists

   197        rom

   198        codes))))

   199 

   200 (defn spelling-bee

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

   202   text around the results."

   203   ([str k]

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

   205   ([rom str k]

   206      (map

   207       (fn [[address snip]]

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

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

   210      

   211 

   212 

   213 

   214 

   215 (defn change-speech

   216   ([state str k]

   217      (loop [ops str

   218             s state

   219             n k]

   220        (if (empty? ops) s

   221            (recur

   222             (rest ops)

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

   224                         (first ops))

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

   226                 (+ n 21))))))

   227   ([str k]

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

   229   ([str]

   230      (change-speech str 0)))

   231 

   232 

   233 

   234 (defn rewrite-memory

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

   236 ops."

   237   ([mem start strs-or-ops]

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

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

   240              (string? x)

   241              

   242              (recur mem start

   243                     (concat

   244                      (str->character-codes x)

   245                      (rest strs-or-ops)))

   246         :else

   247         (recur

   248          (assoc mem start x)

   249          (inc start)

   250          (rest strs-or-ops))))))

   251 

   252 (def rewrite-rom

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

   254 various strings/bytes as data."

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

   256 

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

   258 

   259 

   260 

   261 (def oak-intro

   262   

   263                   (list "Hello there!"

   264                         0x4F

   265                         "Welcome to the"

   266                         0x55

   267                         "world of "

   268                         0x54

   269                         "MON!"

   270                         0x51

   271                         "My name is OAK!"

   272                         0x4F

   273                         "People call me"

   274                         0x55

   275                         "the "

   276                         0x54

   277                         "MON PROF!"

   278                         0x58

   279                         "This world is"

   280                         0x4F

   281                         "inhabited by"

   282                         0x55

   283                         "creatures called"

   284                         0x55

   285                         0x54

   286                         "MON!"

   287                         0x50

   288                         0x50

   289                         0x51

   290                         "For some people, "

   291                         0x4F

   292                         0x54

   293                         "MON are"

   294                         0x55

   295                         "pets. Others use"

   296                         0x55

   297                         "them for fights."

   298                         0x51

   299                         "Myself..."

   300                         0x51

   301                         "I study "

   302                         0x54

   303                         "MON"

   304                         0x4F

   305                         "as a profession."

   306                         0x58

   307                         "First,  what is"

   308                         0x4F

   309                         "your name?"

   310                         0x58

   311                         "This is my grand-"

   312                         0x4F

   313                         "son. He's been"

   314                         0x55

   315                         "your rival since"

   316                         0x55

   317                         "you were a baby."

   318                         0x51

   319                         "...Erm,  what is"

   320                         0x4F

   321                         "his name again?"

   322                         0x58

   323                         0x52

   324                         "!"

   325                         0x51

   326                         "Your very own"

   327                         0x4F

   328                         0x54

   329                         "MON legend is"

   330                         0x55

   331                         "about to unfold!"

   332                         0x51

   333                         "A world of dreams"

   334                         0x4F

   335                         "and adventures"

   336                         0x55

   337                         "with "

   338                         0x54

   339                         "MON"

   340                         0x55

   341                         "awaits! Let's go!"

   342                         0x57)                 )

   343 

   344 (defn state-intro

   345   "Professor Oak speaks!"

   346   []

   347   (do

   348     (->

   349      (rewrite-rom 0xA07BB

   350                   (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)

   351                  ;; (list

   352                  ;;  "Sleeping on the"

   353                  ;;  0x4F

   354                  ;;  "job again are we?"

   355                  ;;  0x51

   356                  ;;  0x00

   357                  ;;  "test"

   358                  ;;  0x59

   359                  ;;  "EOM")

   360 

   361  

   362                   )

   363      (int-array)

   364      (write-rom!))

   365     (root)

   366      

   367     )

   368   

   369   )

   370 

   371 (comment

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

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

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

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

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

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

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

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

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

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

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

   383 go![0x57]")

   384 

   385 

   386 

   387 

   388 

   389 

   390 

   391 

   392 

   393 

   394 

   395 

   396
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 31 Mar 2012 00:41:14 -0500
parents	df9cad9909d2
children	de172acc5a03