Mercurial > vba-clojure

     1 (ns com.aurellem.gb.util

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

     3   (:import java.io.File)

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

     5 

     6 (defn A [state]

     7   (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))

     8 

     9 (defn B [state]

    10   (bit-shift-right (bit-and 0x0000FF00 (BC state)) 8))

    11 

    12 (defn D [state]

    13   (bit-shift-right (bit-and 0x0000FF00 (DE state)) 8))

    14 

    15 (defn H [state]

    16   (bit-shift-right (bit-and 0x0000FF00 (HL state)) 8))

    17 

    18 (defn C [state]

    19   (bit-and 0xFF (BC state)))

    20 (defn F [state]

    21   (bit-and 0xFF (AF state)))

    22 (defn E [state]

    23   (bit-and 0xFF (DE state)))

    24 (defn L [state]

    25   (bit-and 0xFF (HL state)))

    26 

    27 (defn binary-str [num]

    28   (format "%08d"

    29           (Integer/parseInt

    30            (Integer/toBinaryString num) 10)))

    31 

    32 

    33 (defn view-register [state name reg-fn]

    34   (println (format "%s: %s" name

    35                    (binary-str (reg-fn state))))

    36   state)

    37 

    38 (defn view-memory

    39   ([^SaveState state mem]

    40      (let [val (aget (memory state) mem)]

    41        (println (format "0x%04X = %s 0x%02X %d" mem

    42                         (binary-str val) val val)))

    43      state)

    44   ([mem]

    45      (view-memory @current-state mem)))

    46 

    47 (defn print-listing

    48   ([^SaveState state begin end]

    49      (dorun (map 

    50              (fn [opcode line]

    51                (println (format "0x%04X: 0x%02X %s %d"

    52                                 line

    53                                 opcode (binary-str opcode)

    54                                 opcode)))

    55              (subvec  (vec (memory state)) begin end)

    56              (range begin end)))

    57      state)

    58   ([begin end]

    59      (print-listing @current-state begin end)))

    60 

    61 (defn print-pc

    62   ([^SaveState state]

    63      (println (format "PC: 0x%04X" (PC state)))

    64      state)

    65   ([] (print-pc @current-state))) 

    66 

    67 (defn print-op

    68   ([^SaveState state]

    69      (println (format "OP: 0x%02X" (aget (memory state) (PC state))))

    70      state)

    71   ([] (print-op @current-state)))

    72 

    73 (defn d-tick

    74   ([state]

    75   (-> state print-pc print-op tick)))

    76 

    77 (defn print-interrupt

    78   [^SaveState state]

    79   (println (format "IE: %d" (IE state)))

    80   state)

    81 

    82 (defn set-memory

    83   ([state location value]

    84      (set-state! state)

    85      (let [mem (memory state)]

    86        (aset mem location value)

    87        (write-memory! mem)

    88        (update-state)))

    89   ([location value]

    90      (set-memory @current-state location value)))

    91 

    92 (defn set-memory-range

    93   ([state start values]

    94      (set-state! state)

    95      (let [mem (memory state)]

    96   

    97        (dorun (map (fn [index val]

    98                      (aset mem index val))

    99                    (range start

   100                           (+ start (count values))) values))

   101     (write-memory! mem)

   102     (update-state)))

   103   ([start values]

   104      (set-memory-range

   105       @current-state start values)))

   106 

   107 (defn common-differences [& seqs]

   108   (let [backbone (range (count (first seqs)))]

   109     (filter

   110      (comp (partial apply distinct?) second)

   111      (zipmap backbone

   112              (apply (partial map list) seqs)))))

   113 

   114 (defn temporal-compare [& states]

   115   (apply common-differences

   116          (map (comp vec memory)

   117               states)))

   118 

   119 (defn mid-game []

   120   (read-state "mid-game"))

   121 

   122 

   123 

   124 (defn disect-bytes-2

   125   "return a vector consiting of the last 16 bytes of the

   126    integer expressed as two 8 bit numbers (inside an integer)

   127    in the form [high-bits low-bits]."

   128   [num]

   129   [(bit-shift-right

   130     (bit-and num 0xFF00) 8)

   131    (bit-and num 0xFF)])

   132 

   133 (defn disect-bytes-3

   134   "same as disect-bytes-2 except that it assumes the input is a

   135    24 bit number and returns [high-bits medium-bits low-bits]"

   136   [num]

   137   (vec

   138    (concat 

   139     [(bit-shift-right (bit-and num 0xFF0000) 16)]

   140     (disect-bytes-2 num))))

   141 

   142 (defn glue-bytes

   143   "Given two or three 8-bit numbers inside 32-bit integers,

   144    combine them into the integer number that they together

   145    represent."

   146   ([h l]

   147      (+ l (bit-shift-left h 8)))

   148 

   149   ([h m l]

   150      (+ (glue-bytes m l)

   151         (bit-shift-left h 16))))

   152 

   153 (def cartography

   154   (File. user-home

   155          "proj/vba-clojure/clojure/com/aurellem/exp/cartography"))

   156 

   157 

   158 

   159 (defn print-D-memory

   160   ([^SaveState state]

   161      

   162      (let [descriptions

   163            (clojure.string/split-lines

   164             (slurp cartography))]

   165        (dorun

   166         (map

   167          (fn [line data desc]

   168            (printf "%04X  %02X%s\n"

   169                    line data (apply str

   170                                     (drop 20 desc))))

   171          (range pokemon-record-begin

   172                 (inc D-memory-end))

   173          

   174          (subvec (vec (memory state))

   175                  pokemon-record-begin

   176                  (inc D-memory-end))

   177          descriptions))))

   178   ([] (print-D-memory @current-state)))

   179
author	Robert McIntyre <rlm@mit.edu>
date	Wed, 28 Mar 2012 05:08:24 -0500
parents	69184558fcf3
children	eec3e69500d9