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 (defn view-register [state name reg-fn]

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

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

    35   state)

    36 

    37 (defn view-memory

    38   ([^SaveState state mem]

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

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

    41                         (binary-str val) val val)))

    42      state)

    43   ([mem]

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

    45 

    46 (defn print-listing

    47   ([^SaveState state begin end]

    48      (dorun (map 

    49              (fn [opcode line]

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

    51                                 line

    52                                 opcode (binary-str opcode)

    53                                 opcode)))

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

    55              (range begin end)))

    56      state)

    57   ([begin end]

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

    59 

    60 (defn print-pc

    61   ([^SaveState state]

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

    63      state)

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

    65 

    66 (defn print-op

    67   ([^SaveState state]

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

    69      state)

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

    71 

    72 (defn d-tick

    73   ([state]

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

    75 

    76 (defn print-interrupt

    77   [^SaveState state]

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

    79   state)

    80 

    81 (defn set-memory

    82   ([state location value]

    83      (set-state! state)

    84      (let [mem (memory state)]

    85        (aset mem location value)

    86        (write-memory! mem)

    87        (update-state)))

    88   ([location value]

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

    90 

    91 (defn set-memory-range

    92   ([state start values]

    93      (set-state! state)

    94      (let [mem (memory state)]

    95   

    96        (dorun (map (fn [index val]

    97                      (aset mem index val))

    98                    (range start

    99                           (+ start (count values))) values))

   100     (write-memory! mem)

   101     (update-state)))

   102   ([start values]

   103      (set-memory-range

   104       @current-state start values)))

   105 

   106 (defn common-differences [& seqs]

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

   108     (filter

   109      (comp (partial apply distinct?) second)

   110      (zipmap backbone

   111              (apply (partial map list) seqs)))))

   112 

   113 (defn temporal-compare [& states]

   114   (apply common-differences

   115          (map (comp vec memory)

   116               states)))

   117 

   118 (defn mid-game []

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

   120 

   121 

   122 

   123 (defn disect-bytes-2

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

   125    integer expressed as two 8 bit nimbers (inside an integer)

   126    in the form [high-bits low-bits."

   127   [num]

   128   [(bit-shift-right

   129     (bit-and num 0xFF00) 8)

   130    (bit-and num 0xFF)])

   131 

   132 (defn disect-bytes-3

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

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

   135   [num]

   136   (vec

   137    (concat 

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

   139     (disect-bytes-2 num))))

   140 

   141 (defn glue-bytes

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

   143    combine them into the integer number that they together

   144    represent."

   145   ([h l]

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

   147 

   148   ([h m l]

   149      (+ (glue-bytes m l)

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

   151 

   152 (def cartography

   153   (File. user-home

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

   155 

   156 

   157 

   158 (defn print-D-memory

   159   ([^SaveState state]

   160      

   161      (let [descriptions

   162            (clojure.string/split-lines

   163             (slurp cartography))]

   164        (dorun

   165         (map

   166          (fn [line data desc]

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

   168                    line data (apply str

   169                                     (drop 20 desc))))

   170          (range pokemon-record-begin

   171                 (inc D-memory-end))

   172          

   173          (subvec (vec (memory state))

   174                  pokemon-record-begin

   175                  (inc D-memory-end))

   176          descriptions))))

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

   178
author	Robert McIntyre <rlm@mit.edu>
date	Tue, 27 Mar 2012 12:36:48 -0500
parents	22f58fa47c3c
children	69184558fcf3