Mercurial > vba-clojure

     1 (ns com.aurellem.run.music

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

     3                          items vbm characters money

     4                          rlm-assembly))

     5   (:use (com.aurellem.run util title save-corruption

     6                           bootstrap-0 bootstrap-1))

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

     8 

     9 

    10 (def music-base new-kernel)

    11 

    12 

    13 

    14 

    15 (defn store [n address]

    16   (flatten

    17    [0xF5

    18     0xE5

    19     

    20     0x3E

    21     n

    22     

    23     0x21

    24     (reverse (disect-bytes-2 address))

    25 

    26     0x77

    27     

    28     0xE1

    29     0xF1]))

    30 

    31 (defn infinite-loop []

    32   [0x18 0xFE])

    33 

    34 

    35 

    36 (def divider-register 0xFF04)

    37 

    38 

    39 (defrecord Bit-Note [frequency volume duration duty])

    40 

    41 (defn clear-music-registers []

    42   (flatten

    43    [(store (Integer/parseInt "00000000" 2) 0xFF10)

    44     (store (Integer/parseInt "00000000" 2) 0xFF11)

    45     (store (Integer/parseInt "00000000" 2) 0xFF12)

    46     (store (Integer/parseInt "00000000" 2) 0xFF13)

    47     (store (Integer/parseInt "00000000" 2) 0xFF14)

    48 

    49     (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000

    50     (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000

    51     (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low

    52     (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high

    53 

    54     (store (Integer/parseInt "00000000" 2) 0xFF1A)

    55     (store (Integer/parseInt "00000000" 2) 0xFF1B)

    56     (store (Integer/parseInt "00000000" 2) 0xFF1C)

    57     (store (Integer/parseInt "00000000" 2) 0xFF1D)

    58     (store (Integer/parseInt "00000000" 2) 0xFF1E)

    59 

    60     (store (Integer/parseInt "00000000" 2) 0xFF20)

    61     (store (Integer/parseInt "00000000" 2) 0xFF21)

    62     (store (Integer/parseInt "00000000" 2) 0xFF22)

    63     (store (Integer/parseInt "00000000" 2) 0xFF23)]))

    64 

    65 (defn play-note

    66   "Play the note referenced by HL in the appropiate channel.

    67    Leaves desired-duration in A."

    68   []

    69   [0x2A   ;; load volume/frequency-high info

    70    0xF5   ;; push A

    71    0xE6

    72    (Integer/parseInt "11110000" 2) ;; volume mask

    73    0xE0

    74    0x17   ;; set volume

    75    0xF1   ;; pop A

    76    0xE6

    77    (Integer/parseInt "00000111" 2) ;; frequency-high mask

    78    0xE0   

    79    0x19   ;; set frequency-high

    80    

    81    0x2A   ;; load frequency low-bits

    82    0xE0

    83    0x18   ;; set frequency-low-bits

    84 

    85    0x7E   ;; load duration

    86    ;;0x2B   ;; 

    87    ;;0x2B

    88    ]) ;; HL-2 -> HL

    89 

    90 (defn music-step []

    91   (flatten

    92    [(play-note)

    93     0xF5 ;; push A

    94     0xF0

    95     0x05 ;; load current ticks

    96     0x90 ;; B holds previous sub-ticks, subtract it from A

    97     ;; if A-B caused a carry, then (B > A) is true, and

    98     ;; A = current-sub-tics, B = previous-sub-ticks, so

    99     ;; current-sub-ticks < previous-sub-ticks, which means that the

   100     ;; timer counter HAS overflowed.

   101     0x30 ;; increment C only if last result caused carry

   102     0x01

   103     0x00;;0x0C

   104 

   105     0x47 ;; update sub-ticks (A->B)

   106 

   107     0xF1 ;; pop AF, now A contains desired-ticks

   108 

   109     0xB9 ;; compare with current ticks

   110 

   111     ;; if desired-ticks = current ticks

   112     ;;   go to next note ; set current set ticks to 0.

   113 

   114     0x20

   115     0x05

   116 

   117     0x23

   118     0x23

   119     0x23 ;; HL + 3 -> HL

   120     

   121     0x0E

   122     0x00])) ;; 0->C (current-ticks)

   123 

   124 (defn music-kernel []

   125   (flatten

   126    [(clear-music-registers)

   127     0x21

   128     0x00

   129     0xD0 ;; set HL to 0xD000 == music-start

   130     0x0E

   131     0x00 ;; 0->C

   132     0x06

   133     0x00 ;; 0->B

   134 

   135     0x3E

   136     0x00

   137     0xE0

   138     0x06 ;; set TMA to 0

   139     

   140     0x3E

   141     (Integer/parseInt "00000111" 2)

   142     0xE0

   143     0x07 ;; set TAC to 16384 Hz

   144 

   145     (music-step)

   146     0x18

   147     (->signed-8-bit (+ (- (count (music-step)))

   148                        -2))]))

   149 

   150 

   151 (defn play-music [steps music-bytes]

   152   (let [program-target 0xC000

   153         music-target 0xD000]

   154     (-> (set-memory-range (second (music-base))

   155                           program-target (music-kernel))

   156         (set-memory-range music-target music-bytes)

   157         (PC! program-target))))

   158 

   159 

   160 (defn test-note [music-bytes]

   161   (-> (set-memory-range (second (music-base))

   162                         0xC000 (concat (clear-music-registers)

   163                                        (play-note)

   164                                        (infinite-loop)))

   165       (set-memory-range 0xD000 music-bytes)

   166       (PC! 0xC000)

   167       (HL! 0xD000)

   168       ))

   169 

   170 

   171 (defn run-program

   172   ([program] (run-program program 90))

   173   ([program steps]

   174      (let [target 0xC000]

   175        (-> (set-memory-range (second (music-base))

   176                              target program)

   177            (PC! target)))))

   178 

   179
author	Robert McIntyre <rlm@mit.edu>
date	Mon, 16 Apr 2012 14:08:56 -0500
parents
children	f211cd655ccb