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 

    66 ;; mini-midi syntax

    67 

    68 ;; codes

    69 ;; note-code == 0x00

    70 ;; change-duty-code = 0x01

    71 ;; silence-code = 0x02

    72 

    73 ;; silence format

    74 ;;  2 bytes

    75 ;;  [silence-code (0x02)]

    76 ;;  [duration-8-bits]

    77 

    78 ;; note data format

    79 ;;  4 bytes

    80 ;;  [note-code (0x00)]

    81 ;;  [volume-4-bits 0 frequency-high-3-bits]

    82 ;;  [frequengy-low-8-bits]

    83 ;;  [duration-8-bits]

    84 

    85 ;; change-duty-format

    86 ;;  2 bytes

    87 ;;  [change-duty-code (0x01)]

    88 ;;  [new-duty]

    89 

    90 (def note-code 0x00)

    91 (def change-duty-code 0x01)

    92 (def silence-code 0x02)

    93   

    94 

    95 (defn do-message

    96   "Read the message which starts at the current value of HL and do

    97    what it says. Duration is left in A, and HL is advanced

    98    appropraitely."

    99   []

   100   (let [switch

   101         [0x2A ;; load message code into A, increment HL

   102          

   103          ;; switch on message

   104          0xFE

   105          note-code

   106          

   107          0x20

   108          :note-length]

   109 

   110         play-note

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

   112          0xF5   ;; push A

   113          0xE6

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

   115          0xE0

   116          0x17   ;; set volume

   117          0xF1   ;; pop A

   118          0xE6

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

   120          0xE0   

   121          0x19   ;; set frequency-high

   122          

   123          0x2A   ;; load frequency low-bits

   124          0xE0

   125          0x18   ;; set frequency-low-bits

   126          

   127          0x2A]]   ;; load duration

   128     (replace

   129      {:note-length (count play-note)}

   130      (concat switch play-note))))

   131 

   132 (defn play-note

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

   134    Leaves desired-duration in A."

   135   []

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

   137    0xF5   ;; push A

   138    0xE6

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

   140    0xE0

   141    0x17   ;; set volume

   142    0xF1   ;; pop A

   143    0xE6

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

   145    0xE0   

   146    0x19   ;; set frequency-high

   147    

   148    0x2A   ;; load frequency low-bits

   149    0xE0

   150    0x18   ;; set frequency-low-bits

   151 

   152    0x2A   ;; load duration

   153    ]) 

   154 

   155 (defn music-step []

   156   (flatten

   157    [

   158     0xF5 ;; push A

   159     0xF0

   160     0x05 ;; load current ticks

   161     0xB8 ;; B holds previous sub-ticks, subtract it from A

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

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

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

   165     ;; timer counter HAS overflowed.

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

   167     0x01

   168     0x0C

   169 

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

   171 

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

   173 

   174     0xB9 ;; compare with current ticks

   175 

   176     ;; if desired-ticks = current ticks

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

   178 

   179     0x20

   180     (+ (count (do-message)) 2)

   181 

   182     (do-message)

   183     

   184     0x0E

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

   186 

   187 (defn music-kernel []

   188   (flatten

   189    [(clear-music-registers)

   190 

   191     0x21

   192     0x00

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

   194     0x0E

   195     0x00 ;; 0->C

   196     0x06

   197     0x00 ;; 0->B

   198 

   199     0x3E

   200     0x01

   201     0xE0

   202     0x06 ;; set TMA to 0

   203     

   204     0x3E

   205     (Integer/parseInt "00000110" 2)

   206     0xE0

   207     0x07 ;; set TAC to 65536 Hz and activate timer

   208 

   209 

   210     0xAF ;; initialiaze A to zero

   211 

   212 

   213     (music-step)

   214     0x18

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

   216                        -2))]))

   217 

   218 (defn frequency-code->frequency

   219   [code]

   220   (assert (<= 0 code 2047))

   221   (/ 131072 (- 2048 code)))

   222 

   223 (defn clamp [x low high]

   224   (cond  (> x high) high

   225          (< x low)  low

   226          true x))

   227 

   228 (defn frequency->frequency-code

   229   [frequency]

   230   (clamp

   231    (Math/round

   232     (float

   233      (/ (- (* 2048 frequency) 131072) frequency)))

   234    0x00 2048))

   235     

   236 (defn note-codes [frequency volume duration]

   237   (assert (<= 0 volume 0xF))

   238   (assert (<= 0 duration 0xFF))

   239   (let [frequency-code

   240         (frequency->frequency-code frequency)

   241         volume&high-frequency

   242         (+ (bit-shift-left volume 4)

   243            (bit-shift-right frequency-code 8))

   244         low-frequency

   245         (bit-and 0xFF frequency-code)]

   246     [note-code

   247      volume&high-frequency

   248      low-frequency

   249      duration]))

   250 

   251 (def C4 (partial note-codes 261.63))

   252 (def D4 (partial note-codes 293.66))

   253 (def E4 (partial note-codes 329.63))

   254 (def F4 (partial note-codes 349.23))

   255 (def G4 (partial note-codes 392))

   256 (def A4 (partial note-codes 440))

   257 (def B4 (partial note-codes 493.88))

   258 (def C5 (partial note-codes 523.3))

   259 

   260 (def scale

   261   (flatten

   262    [(C4 0xF 0x40)

   263     (D4 0xF 0x40)

   264     (E4 0xF 0x40)

   265     (F4 0xF 0x40)

   266     (G4 0xF 0x40)

   267     (A4 0xF 0x40)

   268     (B4 0xF 0x40)

   269     (C5 0xF 0x40)]))

   270                  

   271 (defn play-music [music-bytes]

   272   (let [program-target 0xC000

   273         music-target 0xD000]

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

   275                           program-target (music-kernel))

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

   277         (PC! program-target))))

   278 

   279 

   280 (defn test-note [music-bytes]

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

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

   283                                        (play-note)

   284                                        (infinite-loop)))

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

   286       (PC! 0xC000)

   287       (HL! 0xD000)

   288       ))

   289 

   290 

   291 (defn run-program

   292   ([program]

   293      (let [target 0xC000]

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

   295                              target program)

   296            (PC! target)))))

   297 

   298 (defn trippy []

   299   (run-moves (play-music many-notes ) (repeat 8000 [])))

   300 

   301 (defn test-timer []

   302   (flatten

   303    [0x3E

   304     0x01

   305     0xE0

   306     0x06 ;; set TMA to 0

   307     

   308     0x3E

   309     (Integer/parseInt "00000100" 2)

   310     0xE0

   311     0x07 ;; set TAC to 16384 Hz and activate timer

   312     

   313     (repeat

   314      500

   315      [0xF0

   316       0x05])]))
author	Robert McIntyre <rlm@mit.edu>
date	Mon, 23 Apr 2012 05:45:25 -0500
parents	7bd806c4dbb6
children	c03f28aa98d9