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 (defn do-message

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

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

    93    appropraitely."

    94   []

    95 

    96   )

    97 

    98 

    99 

   100 

   101 

   102 

   103 (defn play-note

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

   105    Leaves desired-duration in A."

   106   []

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

   108    0xF5   ;; push A

   109    0xE6

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

   111    0xE0

   112    0x17   ;; set volume

   113    0xF1   ;; pop A

   114    0xE6

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

   116    0xE0   

   117    0x19   ;; set frequency-high

   118    

   119    0x2A   ;; load frequency low-bits

   120    0xE0

   121    0x18   ;; set frequency-low-bits

   122 

   123    0x2A   ;; load duration

   124    ]) 

   125 

   126 (defn music-step []

   127   (flatten

   128    [

   129     0xF5 ;; push A

   130     0xF0

   131     0x05 ;; load current ticks

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

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

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

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

   136     ;; timer counter HAS overflowed.

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

   138     0x01

   139     0x0C

   140 

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

   142 

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

   144 

   145     0xB9 ;; compare with current ticks

   146 

   147     ;; if desired-ticks = current ticks

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

   149 

   150     0x20

   151     (+ (count (play-note)) 2)

   152 

   153     (play-note)

   154     

   155     0x0E

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

   157 

   158 (defn music-kernel []

   159   (flatten

   160    [(clear-music-registers)

   161 

   162     0x21

   163     0x00

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

   165     0x0E

   166     0x00 ;; 0->C

   167     0x06

   168     0x00 ;; 0->B

   169 

   170     0x3E

   171     0x01

   172     0xE0

   173     0x06 ;; set TMA to 0

   174     

   175     0x3E

   176     (Integer/parseInt "00000110" 2)

   177     0xE0

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

   179 

   180 

   181     0xAF ;; initialiaze A to zero

   182 

   183 

   184     (music-step)

   185     0x18

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

   187                        -2))]))

   188 

   189 (def one-note

   190   [0xA0 0x00 0xFF])

   191 

   192 (def many-notes

   193   (flatten (repeat 10 one-note)))

   194 

   195 (def increasing-notes

   196   [0xA0 0x00 0x55

   197    0xA1 0x00 0x55

   198    0xA2 0x00 0x55

   199    0xA3 0x00 0x55

   200    0xA4 0x00 0x55

   201    0xA5 0x00 0x55

   202    0xA6 0x00 0x55

   203    0xA6 0x55 0xFF

   204    0xA6 0x55 0xFF

   205    0xA6 0x55 0xFF

   206    0x00 0x00 0xFF

   207    ])

   208 

   209 (defn frequency-code->frequency

   210   [code]

   211   (assert (<= 0 code 2047))

   212   (/ 131072 (- 2048 code)))

   213 

   214 (defn clamp [x low high]

   215   (cond  (> x high) high

   216          (< x low)  low

   217          true x))

   218 

   219 (defn frequency->frequency-code

   220   [frequency]

   221   (clamp

   222    (Math/round

   223     (float

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

   225    0x00 2048))

   226     

   227 (defn note-codes [frequency volume duration]

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

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

   230   (let [frequency-code

   231         (frequency->frequency-code frequency)

   232         volume&high-frequency

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

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

   235         low-frequency

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

   237     [volume&high-frequency

   238      low-frequency

   239      duration]))

   240 

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

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

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

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

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

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

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

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

   249 

   250 (def scale

   251   (flatten

   252    [(C4 0xF 0x40)

   253     (D4 0xF 0x40)

   254     (E4 0xF 0x40)

   255     (F4 0xF 0x40)

   256     (G4 0xF 0x40)

   257     (A4 0xF 0x40)

   258     (B4 0xF 0x40)

   259     (C5 0xF 0x40)]))

   260                  

   261 (defn play-music [music-bytes]

   262   (let [program-target 0xC000

   263         music-target 0xD000]

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

   265                           program-target (music-kernel))

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

   267         (PC! program-target))))

   268 

   269 

   270 (defn test-note [music-bytes]

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

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

   273                                        (play-note)

   274                                        (infinite-loop)))

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

   276       (PC! 0xC000)

   277       (HL! 0xD000)

   278       ))

   279 

   280 

   281 (defn run-program

   282   ([program]

   283      (let [target 0xC000]

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

   285                              target program)

   286            (PC! target)))))

   287 

   288 (defn trippy []

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

   290 

   291 (defn test-timer []

   292   (flatten

   293    [0x3E

   294     0x01

   295     0xE0

   296     0x06 ;; set TMA to 0

   297     

   298     0x3E

   299     (Integer/parseInt "00000100" 2)

   300     0xE0

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

   302     

   303     (repeat

   304      500

   305      [0xF0

   306       0x05])]))
author	Robert McIntyre <rlm@mit.edu>
date	Mon, 23 Apr 2012 04:45:55 -0500
parents	971bd1774eab
children	df4e03672b05