Mercurial > vba-clojure

     1 (ns com.aurellem.gb.util

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

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

     4 

     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      (println (format "mem 0x%04X = %s" mem

    40                       (binary-str (aget (memory state) mem))))

    41      state)

    42   ([mem]

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

    44 

    45 (defn print-listing

    46   ([^SaveState state begin end]

    47      (dorun (map 

    48              (fn [opcode line]

    49                (println (format "0x%04X:  0x%02X" line opcode)))

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

    51              (range begin end)))

    52      state)

    53   ([begin end]

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

    55 

    56 (defn print-pc

    57   ([^SaveState state]

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

    59      state)

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

    61 

    62 (defn print-op

    63   ([^SaveState state]

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

    65      state)

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

    67 

    68 (defn d-tick

    69   ([state]

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

    71 

    72 (defn print-interrupt

    73   [^SaveState state]

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

    75   state)

    76 

    77 (defn set-memory

    78   ([state location value]

    79      (set-state! state)

    80      (let [mem (memory state)]

    81        (aset mem location value)

    82        (write-memory! mem)

    83        (update-state)))

    84   ([location value]

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

    86 

    87 (defn set-memory-range

    88   ([state start values]

    89      (set-state! state)

    90      (let [mem (memory state)]

    91   

    92        (dorun (map (fn [index val]

    93                      (aset mem index val))

    94                    (range start

    95                           (+ start (count values))) values))

    96     (write-memory! mem)

    97     (update-state)))

    98   ([start values]

    99      (set-memory-range

   100       @current-state start values)))

   101 

   102 (defn common-differences [& seqs]

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

   104     (filter

   105      (comp (partial apply distinct?) second)

   106      (zipmap backbone

   107              (apply (partial map list) seqs)))))

   108 

   109 (defn mid-game []

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

   111 

   112 

   113 

   114 (defn disect-bytes-2

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

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

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

   118   [num]

   119   [(bit-shift-right

   120     (bit-and num 0xFF00) 8)

   121    (bit-and num 0xFF)])

   122 

   123 (defn disect-bytes-3

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

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

   126   [num]

   127   (vec

   128    (concat 

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

   130     (disect-bytes-2 num))))

   131 

   132 (defn glue-bytes

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

   134    combine them into the integer number that they together

   135    represent."

   136   ([h l]

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

   138 

   139   ([h m l]

   140      (+ (glue-bytes m l)

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

   142 

   143
author	Robert McIntyre <rlm@mit.edu>
date	Fri, 23 Mar 2012 00:14:37 -0500
parents	fd549c8f42ae
children	8523faa122b0