Mercurial > vba-clojure

     1 (ns com.aurellem.world.practice

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

     3   assembly characters))

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

     5   ;;(:use (com.aurellem.exp pokemon))

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

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

     8   

     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* [state start length]

    19   ((comp vec map)

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

    21    (range start (+ start length))))

    22 

    23 

    24 (defn state-surprise

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

    26   []

    27   (->

    28    (pre-trainer-battle)

    29    (step [:r])

    30    (step)

    31    (ntick 88147)

    32    ;(step [:r])

    33 

    34    ;(step [:r])

    35    ;(step [:r])

    36    ;(step [:r])

    37    ;(step [:r])

    38    ))

    39 (defn state-inject

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

    41   []

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

    43 

    44 

    45 

    46 

    47 (defn pc-trail

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

    49   [state ticks]

    50   (tick state)

    51   (set-state! state)

    52   (loop [pcs [(PC)] ]

    53     (if (> (count pcs) ticks) pcs

    54         (do

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

    56           (recur (conj pcs (PC)))))))

    57 

    58 

    59 

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

    61   (remove

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

    63    (map vector

    64         (range)

    65         list-1

    66         list-2)))

    67 

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

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

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

    71 

    72 

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

    74   (remove

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

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

    77        (range)

    78        (vec (memory state-1))

    79        (vec (memory state-2)))

    80    )

    81   )

    82 

    83 

    84 

    85 (defn state-speak

    86   "This is when the trainer speaks."

    87   []

    88   (->

    89    (pre-trainer-battle)

    90    (set-memory 0xD354 0x0)

    91    (step [:r])

    92    (step)

    93    (ntick 88147)

    94    (tick)

    95    (nstep 102)

    96 

    97    ;(step [:r])

    98 

    99    ;(step [:r])

   100    ;(step [:r])

   101    ;(step [:r])

   102    ;(step [:r])

   103    ))

   104   

   105   

   106 

   107 (defn get-memory [state n]

   108   (aget (memory state) n))

   109 

   110 (defn first-change

   111   "Watch the current memory location as it ticks,

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

   113   [state n]

   114   (tick state)

   115   (set-state! state)

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

   117     (loop []

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

   119         (do

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

   121           (recur))))

   122     (update-state)))

   123 

   124 

   125 

   126 (defn spell [state mem n]

   127   (print (character-codes->str

   128           (take n (drop mem

   129                         (vec(memory state)))))))

   130 

   131 

   132 (do

   133   (println)

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

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

   136   )

   137 

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

   139 

   140 

   141 

   142 (def surprise-words

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

   144 

   145 (defn sublist

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

   147   [list sub]

   148   (cond

   149     (empty? sub) list

   150     (empty? list) nil

   151     (= (take (count sub) list) sub) list

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

   153 

   154 (defn subloc

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

   156   [list sub]

   157   (loop [n 0 a list]

   158     (cond

   159       (empty? a) nil

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

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

   162 

   163 

   164 

   165 

   166 (defn change-speech

   167   ([state str k]

   168      (loop [ops str

   169             s state

   170             n k]

   171        (if (empty? ops) s

   172            (recur

   173             (rest ops)

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

   175                         (first ops))

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

   177                 (+ n 21))))))

   178   ([str k]

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

   180   ([str]

   181      (change-speech str 0))

   182        

   183          

   184     

   185       

   186   )

   187
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 24 Mar 2012 03:10:56 -0500
parents	67c42608ef9d
children	d5dddf33543c