Mercurial > vba-clojure

annotate clojure/com/aurellem/run/music.clj @ 424:7bd806c4dbb6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
changed assembly to handle mini-midi messages of different lengths.
author Robert McIntyre <rlm@mit.edu>
date Mon, 23 Apr 2012 04:45:55 -0500
parents 971bd1774eab
children df4e03672b05
rev   line source
rlm@417 1 (ns com.aurellem.run.music
rlm@417 2 (:use (com.aurellem.gb saves gb-driver util constants
rlm@417 3 items vbm characters money
rlm@417 4 rlm-assembly))
rlm@417 5 (:use (com.aurellem.run util title save-corruption
rlm@417 6 bootstrap-0 bootstrap-1))
rlm@417 7 (:import [com.aurellem.gb.gb_driver SaveState]))
rlm@417 8
rlm@417 9
rlm@417 10 (def music-base new-kernel)
rlm@417 11
rlm@417 12
rlm@417 13
rlm@417 14
rlm@417 15 (defn store [n address]
rlm@417 16 (flatten
rlm@417 17 [0xF5
rlm@417 18 0xE5
rlm@417 19
rlm@417 20 0x3E
rlm@417 21 n
rlm@417 22
rlm@417 23 0x21
rlm@417 24 (reverse (disect-bytes-2 address))
rlm@417 25
rlm@417 26 0x77
rlm@417 27
rlm@417 28 0xE1
rlm@417 29 0xF1]))
rlm@417 30
rlm@417 31 (defn infinite-loop []
rlm@417 32 [0x18 0xFE])
rlm@417 33
rlm@417 34
rlm@417 35
rlm@417 36 (def divider-register 0xFF04)
rlm@417 37
rlm@417 38
rlm@417 39 (defrecord Bit-Note [frequency volume duration duty])
rlm@417 40
rlm@417 41 (defn clear-music-registers []
rlm@417 42 (flatten
rlm@417 43 [(store (Integer/parseInt "00000000" 2) 0xFF10)
rlm@417 44 (store (Integer/parseInt "00000000" 2) 0xFF11)
rlm@417 45 (store (Integer/parseInt "00000000" 2) 0xFF12)
rlm@417 46 (store (Integer/parseInt "00000000" 2) 0xFF13)
rlm@417 47 (store (Integer/parseInt "00000000" 2) 0xFF14)
rlm@417 48
rlm@417 49 (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000
rlm@417 50 (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000
rlm@417 51 (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low
rlm@417 52 (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high
rlm@417 53
rlm@417 54 (store (Integer/parseInt "00000000" 2) 0xFF1A)
rlm@417 55 (store (Integer/parseInt "00000000" 2) 0xFF1B)
rlm@417 56 (store (Integer/parseInt "00000000" 2) 0xFF1C)
rlm@417 57 (store (Integer/parseInt "00000000" 2) 0xFF1D)
rlm@417 58 (store (Integer/parseInt "00000000" 2) 0xFF1E)
rlm@417 59
rlm@417 60 (store (Integer/parseInt "00000000" 2) 0xFF20)
rlm@417 61 (store (Integer/parseInt "00000000" 2) 0xFF21)
rlm@417 62 (store (Integer/parseInt "00000000" 2) 0xFF22)
rlm@417 63 (store (Integer/parseInt "00000000" 2) 0xFF23)]))
rlm@417 64
rlm@424 65
rlm@424 66 ;; mini-midi syntax
rlm@424 67
rlm@424 68 ;; codes
rlm@424 69 ;; note-code == 0x00
rlm@424 70 ;; change-duty-code = 0x01
rlm@424 71 ;; silence-code = 0x02
rlm@424 72
rlm@424 73 ;; silence format
rlm@424 74 ;; 2 bytes
rlm@424 75 ;; [silence-code (0x02)]
rlm@424 76 ;; [duration-8-bits]
rlm@424 77
rlm@424 78 ;; note data format
rlm@424 79 ;; 4 bytes
rlm@424 80 ;; [note-code (0x00)]
rlm@424 81 ;; [volume-4-bits 0 frequency-high-3-bits]
rlm@424 82 ;; [frequengy-low-8-bits]
rlm@424 83 ;; [duration-8-bits]
rlm@424 84
rlm@424 85 ;; change-duty-format
rlm@424 86 ;; 2 bytes
rlm@424 87 ;; [change-duty-code (0x01)]
rlm@424 88 ;; [new-duty]
rlm@424 89
rlm@424 90 (defn do-message
rlm@424 91 "Read the message which starts at the current value of HL and do
rlm@424 92 what it says. Duration is left in A, and HL is advanced
rlm@424 93 appropraitely."
rlm@424 94 []
rlm@424 95
rlm@424 96 )
rlm@424 97
rlm@424 98
rlm@424 99
rlm@424 100
rlm@424 101
rlm@424 102
rlm@417 103 (defn play-note
rlm@417 104 "Play the note referenced by HL in the appropiate channel.
rlm@417 105 Leaves desired-duration in A."
rlm@417 106 []
rlm@417 107 [0x2A ;; load volume/frequency-high info
rlm@417 108 0xF5 ;; push A
rlm@417 109 0xE6
rlm@417 110 (Integer/parseInt "11110000" 2) ;; volume mask
rlm@417 111 0xE0
rlm@417 112 0x17 ;; set volume
rlm@417 113 0xF1 ;; pop A
rlm@417 114 0xE6
rlm@417 115 (Integer/parseInt "00000111" 2) ;; frequency-high mask
rlm@417 116 0xE0
rlm@417 117 0x19 ;; set frequency-high
rlm@417 118
rlm@417 119 0x2A ;; load frequency low-bits
rlm@417 120 0xE0
rlm@417 121 0x18 ;; set frequency-low-bits
rlm@417 122
rlm@424 123 0x2A ;; load duration
rlm@418 124 ])
rlm@417 125
rlm@417 126 (defn music-step []
rlm@417 127 (flatten
rlm@424 128 [
rlm@417 129 0xF5 ;; push A
rlm@417 130 0xF0
rlm@417 131 0x05 ;; load current ticks
rlm@418 132 0xB8 ;; B holds previous sub-ticks, subtract it from A
rlm@417 133 ;; if A-B caused a carry, then (B > A) is true, and
rlm@417 134 ;; A = current-sub-tics, B = previous-sub-ticks, so
rlm@417 135 ;; current-sub-ticks < previous-sub-ticks, which means that the
rlm@417 136 ;; timer counter HAS overflowed.
rlm@417 137 0x30 ;; increment C only if last result caused carry
rlm@417 138 0x01
rlm@418 139 0x0C
rlm@417 140
rlm@417 141 0x47 ;; update sub-ticks (A->B)
rlm@417 142
rlm@417 143 0xF1 ;; pop AF, now A contains desired-ticks
rlm@417 144
rlm@417 145 0xB9 ;; compare with current ticks
rlm@417 146
rlm@417 147 ;; if desired-ticks = current ticks
rlm@417 148 ;; go to next note ; set current set ticks to 0.
rlm@417 149
rlm@417 150 0x20
rlm@424 151 (+ (count (play-note)) 2)
rlm@417 152
rlm@424 153 (play-note)
rlm@417 154
rlm@417 155 0x0E
rlm@417 156 0x00])) ;; 0->C (current-ticks)
rlm@417 157
rlm@417 158 (defn music-kernel []
rlm@417 159 (flatten
rlm@417 160 [(clear-music-registers)
rlm@418 161
rlm@417 162 0x21
rlm@417 163 0x00
rlm@417 164 0xD0 ;; set HL to 0xD000 == music-start
rlm@417 165 0x0E
rlm@417 166 0x00 ;; 0->C
rlm@417 167 0x06
rlm@417 168 0x00 ;; 0->B
rlm@417 169
rlm@417 170 0x3E
rlm@418 171 0x01
rlm@417 172 0xE0
rlm@417 173 0x06 ;; set TMA to 0
rlm@417 174
rlm@417 175 0x3E
rlm@423 176 (Integer/parseInt "00000110" 2)
rlm@417 177 0xE0
rlm@423 178 0x07 ;; set TAC to 65536 Hz and activate timer
rlm@417 179
rlm@424 180
rlm@424 181 0xAF ;; initialiaze A to zero
rlm@424 182
rlm@424 183
rlm@417 184 (music-step)
rlm@417 185 0x18
rlm@417 186 (->signed-8-bit (+ (- (count (music-step)))
rlm@417 187 -2))]))
rlm@417 188
rlm@418 189 (def one-note
rlm@418 190 [0xA0 0x00 0xFF])
rlm@417 191
rlm@418 192 (def many-notes
rlm@418 193 (flatten (repeat 10 one-note)))
rlm@418 194
rlm@418 195 (def increasing-notes
rlm@418 196 [0xA0 0x00 0x55
rlm@418 197 0xA1 0x00 0x55
rlm@418 198 0xA2 0x00 0x55
rlm@418 199 0xA3 0x00 0x55
rlm@418 200 0xA4 0x00 0x55
rlm@418 201 0xA5 0x00 0x55
rlm@418 202 0xA6 0x00 0x55
rlm@423 203 0xA6 0x55 0xFF
rlm@423 204 0xA6 0x55 0xFF
rlm@423 205 0xA6 0x55 0xFF
rlm@423 206 0x00 0x00 0xFF
rlm@423 207 ])
rlm@424 208
rlm@424 209 (defn frequency-code->frequency
rlm@424 210 [code]
rlm@424 211 (assert (<= 0 code 2047))
rlm@424 212 (/ 131072 (- 2048 code)))
rlm@424 213
rlm@424 214 (defn clamp [x low high]
rlm@424 215 (cond (> x high) high
rlm@424 216 (< x low) low
rlm@424 217 true x))
rlm@424 218
rlm@424 219 (defn frequency->frequency-code
rlm@424 220 [frequency]
rlm@424 221 (clamp
rlm@424 222 (Math/round
rlm@424 223 (float
rlm@424 224 (/ (- (* 2048 frequency) 131072) frequency)))
rlm@424 225 0x00 2048))
rlm@424 226
rlm@424 227 (defn note-codes [frequency volume duration]
rlm@424 228 (assert (<= 0 volume 0xF))
rlm@424 229 (assert (<= 0 duration 0xFF))
rlm@424 230 (let [frequency-code
rlm@424 231 (frequency->frequency-code frequency)
rlm@424 232 volume&high-frequency
rlm@424 233 (+ (bit-shift-left volume 4)
rlm@424 234 (bit-shift-right frequency-code 8))
rlm@424 235 low-frequency
rlm@424 236 (bit-and 0xFF frequency-code)]
rlm@424 237 [volume&high-frequency
rlm@424 238 low-frequency
rlm@424 239 duration]))
rlm@424 240
rlm@424 241 (def C4 (partial note-codes 261.63))
rlm@424 242 (def D4 (partial note-codes 293.66))
rlm@424 243 (def E4 (partial note-codes 329.63))
rlm@424 244 (def F4 (partial note-codes 349.23))
rlm@424 245 (def G4 (partial note-codes 392))
rlm@424 246 (def A4 (partial note-codes 440))
rlm@424 247 (def B4 (partial note-codes 493.88))
rlm@424 248 (def C5 (partial note-codes 523.3))
rlm@424 249
rlm@424 250 (def scale
rlm@424 251 (flatten
rlm@424 252 [(C4 0xF 0x40)
rlm@424 253 (D4 0xF 0x40)
rlm@424 254 (E4 0xF 0x40)
rlm@424 255 (F4 0xF 0x40)
rlm@424 256 (G4 0xF 0x40)
rlm@424 257 (A4 0xF 0x40)
rlm@424 258 (B4 0xF 0x40)
rlm@424 259 (C5 0xF 0x40)]))
rlm@424 260
rlm@418 261 (defn play-music [music-bytes]
rlm@417 262 (let [program-target 0xC000
rlm@417 263 music-target 0xD000]
rlm@417 264 (-> (set-memory-range (second (music-base))
rlm@417 265 program-target (music-kernel))
rlm@417 266 (set-memory-range music-target music-bytes)
rlm@417 267 (PC! program-target))))
rlm@417 268
rlm@417 269
rlm@417 270 (defn test-note [music-bytes]
rlm@417 271 (-> (set-memory-range (second (music-base))
rlm@417 272 0xC000 (concat (clear-music-registers)
rlm@417 273 (play-note)
rlm@417 274 (infinite-loop)))
rlm@417 275 (set-memory-range 0xD000 music-bytes)
rlm@417 276 (PC! 0xC000)
rlm@417 277 (HL! 0xD000)
rlm@417 278 ))
rlm@417 279
rlm@417 280
rlm@417 281 (defn run-program
rlm@418 282 ([program]
rlm@417 283 (let [target 0xC000]
rlm@417 284 (-> (set-memory-range (second (music-base))
rlm@417 285 target program)
rlm@417 286 (PC! target)))))
rlm@417 287
rlm@418 288 (defn trippy []
rlm@418 289 (run-moves (play-music many-notes ) (repeat 8000 [])))
rlm@417 290
rlm@424 291 (defn test-timer []
rlm@424 292 (flatten
rlm@424 293 [0x3E
rlm@424 294 0x01
rlm@424 295 0xE0
rlm@424 296 0x06 ;; set TMA to 0
rlm@424 297
rlm@424 298 0x3E
rlm@424 299 (Integer/parseInt "00000100" 2)
rlm@424 300 0xE0
rlm@424 301 0x07 ;; set TAC to 16384 Hz and activate timer
rlm@424 302
rlm@424 303 (repeat
rlm@424 304 500
rlm@424 305 [0xF0
rlm@424 306 0x05])]))