Mercurial > vba-clojure

annotate clojure/com/aurellem/run/music.clj @ 476:2d419f7f999c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
shortened song.
author Robert McIntyre <rlm@mit.edu>
date Fri, 04 May 2012 06:34:00 -0500
parents f28a3baa4c56
children ee000791ab4e
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@426 7 (:require clojure.string)
rlm@426 8 (:import [com.aurellem.gb.gb_driver SaveState])
rlm@426 9 (:import java.io.File))
rlm@417 10
rlm@427 11 (def third-kind
rlm@427 12 (File. "/home/r/proj/midi/third-kind.mid"))
rlm@417 13
rlm@455 14 (def pony
rlm@455 15 (File. "/home/r/proj/vba-clojure/music/pony-title.mid"))
rlm@455 16
rlm@455 17 (def sync-test
rlm@455 18 (File. "/home/r/proj/vba-clojure/music/sync-test.mid"))
rlm@455 19
rlm@468 20 (def drum-test
rlm@468 21 (File. "/home/r/proj/vba-clojure/music/drum-test.mid"))
rlm@468 22
rlm@454 23
rlm@427 24 (defn raw-midi-text [#^File midi-file]
rlm@427 25 (:out
rlm@427 26 (clojure.java.shell/sh
rlm@427 27 "midicsv"
rlm@427 28 (.getCanonicalPath midi-file)
rlm@427 29 "-")))
rlm@427 30
rlm@427 31 (def command-line #"^(\d+), (\d+), ([^,]+)(.*)$")
rlm@427 32
rlm@427 33 (defmulti parse-command :command)
rlm@427 34
rlm@427 35 (defn discard-args [command] (dissoc command :args))
rlm@427 36
rlm@427 37 (defmethod parse-command :Start_track
rlm@427 38 [command] (discard-args command))
rlm@427 39
rlm@427 40 (defmethod parse-command :End_track
rlm@427 41 [command] (discard-args command))
rlm@427 42
rlm@427 43 (defmethod parse-command :default
rlm@427 44 [command] command)
rlm@427 45
rlm@427 46 (defn parse-number-list
rlm@427 47 [number-list-str]
rlm@427 48 (map #(Integer/parseInt %)
rlm@427 49 (clojure.string/split number-list-str #", ")))
rlm@427 50
rlm@427 51 (defmethod parse-command :Tempo
rlm@427 52 [command]
rlm@427 53 (update-in command [:args] #(Integer/parseInt %)))
rlm@427 54
rlm@427 55 (defn parse-midi-note-list
rlm@427 56 [midi-note-list-str]
rlm@427 57 (let [[channel note velocity]
rlm@427 58 (parse-number-list midi-note-list-str)]
rlm@427 59 {:channel channel :note note :velocity velocity}))
rlm@427 60
rlm@427 61 (defmethod parse-command :Note_on_c
rlm@427 62 [command]
rlm@427 63 (update-in command [:args] parse-midi-note-list))
rlm@427 64
rlm@427 65 (defmethod parse-command :Note_off_c
rlm@427 66 [command]
rlm@427 67 (update-in command [:args] parse-midi-note-list))
rlm@427 68
rlm@427 69 (defmethod parse-command :Header
rlm@427 70 [command]
rlm@427 71 (let [args (:args command)
rlm@427 72 [format num-tracks division] (parse-number-list args)]
rlm@427 73 (assoc command :args
rlm@427 74 {:format format
rlm@427 75 :num-tracks num-tracks
rlm@427 76 :division division})))
rlm@427 77
rlm@427 78 (defmethod parse-command :Program_c
rlm@427 79 [command]
rlm@427 80 (let [args (:args command)
rlm@427 81 [channel program-num] (parse-number-list args)]
rlm@427 82 (assoc command :args
rlm@427 83 {:channel channel
rlm@427 84 :program-num program-num})))
rlm@427 85
rlm@427 86 (defn parse-midi [#^File midi-file]
rlm@427 87 (map
rlm@427 88 (comp parse-command
rlm@427 89 (fn [line]
rlm@427 90 (let [[[_ channel time command args]]
rlm@427 91 (re-seq command-line line)]
rlm@427 92 {:channel (Integer/parseInt channel)
rlm@427 93 :time (Integer/parseInt time)
rlm@427 94 :command (keyword command)
rlm@427 95 :args (apply str (drop 2 args))})))
rlm@427 96 (drop-last
rlm@427 97 (clojure.string/split-lines
rlm@427 98 (raw-midi-text midi-file)))))
rlm@427 99
rlm@417 100 (def music-base new-kernel)
rlm@417 101
rlm@417 102 (defn store [n address]
rlm@417 103 (flatten
rlm@417 104 [0xF5
rlm@417 105 0xE5
rlm@417 106
rlm@417 107 0x3E
rlm@417 108 n
rlm@417 109
rlm@417 110 0x21
rlm@417 111 (reverse (disect-bytes-2 address))
rlm@417 112
rlm@417 113 0x77
rlm@417 114
rlm@417 115 0xE1
rlm@417 116 0xF1]))
rlm@417 117
rlm@417 118 (defn infinite-loop []
rlm@417 119 [0x18 0xFE])
rlm@417 120
rlm@417 121 (def divider-register 0xFF04)
rlm@417 122
rlm@417 123 (defrecord Bit-Note [frequency volume duration duty])
rlm@417 124
rlm@417 125 (defn clear-music-registers []
rlm@417 126 (flatten
rlm@433 127 [(store (Integer/parseInt "00000000" 2) 0xFF10) ;; sweep
rlm@433 128 (store (Integer/parseInt "00000000" 2) 0xFF11) ;; pattern duty
rlm@433 129 (store (Integer/parseInt "00000000" 2) 0xFF12) ;; volume
rlm@433 130 (store (Integer/parseInt "00000000" 2) 0xFF13) ;; frequency-low
rlm@433 131 (store (Integer/parseInt "00000000" 2) 0xFF14) ;; frequency-high
rlm@417 132
rlm@417 133 (store (Integer/parseInt "00000000" 2) 0xFF16) ;; pattern duty 000000
rlm@417 134 (store (Integer/parseInt "00000000" 2) 0xFF17) ;; volume 0000
rlm@417 135 (store (Integer/parseInt "00000000" 2) 0xFF18) ;; frequency-low
rlm@417 136 (store (Integer/parseInt "00000000" 2) 0xFF19) ;; 00000 frequency-high
rlm@417 137
rlm@417 138 (store (Integer/parseInt "00000000" 2) 0xFF1A)
rlm@417 139 (store (Integer/parseInt "00000000" 2) 0xFF1B)
rlm@417 140 (store (Integer/parseInt "00000000" 2) 0xFF1C)
rlm@417 141 (store (Integer/parseInt "00000000" 2) 0xFF1D)
rlm@417 142 (store (Integer/parseInt "00000000" 2) 0xFF1E)
rlm@417 143
rlm@433 144 (store (Integer/parseInt "00000000" 2) 0xFF20) ;; length
rlm@433 145 (store (Integer/parseInt "00000000" 2) 0xFF21) ;; volume
rlm@433 146 (store (Integer/parseInt "00000000" 2) 0xFF22) ;; noise-frequency
rlm@433 147 (store (Integer/parseInt "00000000" 2) 0xFF23) ;; control
rlm@433 148 ]))
rlm@417 149
rlm@424 150
rlm@424 151 ;; mini-midi syntax
rlm@424 152
rlm@424 153 ;; codes
rlm@424 154 ;; note-code == 0x00
rlm@424 155 ;; change-duty-code = 0x01
rlm@424 156 ;; silence-code = 0x02
rlm@424 157
rlm@424 158 ;; silence format
rlm@424 159 ;; 2 bytes
rlm@424 160 ;; [silence-code (0x02)]
rlm@424 161 ;; [duration-8-bits]
rlm@424 162
rlm@424 163 ;; note data format
rlm@424 164 ;; 4 bytes
rlm@424 165 ;; [note-code (0x00)]
rlm@424 166 ;; [volume-4-bits 0 frequency-high-3-bits]
rlm@424 167 ;; [frequengy-low-8-bits]
rlm@424 168 ;; [duration-8-bits]
rlm@424 169
rlm@424 170 ;; change-duty-format
rlm@424 171 ;; 2 bytes
rlm@424 172 ;; [change-duty-code (0x01)]
rlm@424 173 ;; [new-duty]
rlm@424 174
rlm@425 175 (def note-code 0x00)
rlm@425 176 (def change-duty-code 0x01)
rlm@425 177 (def silence-code 0x02)
rlm@425 178
rlm@424 179 (defn do-message
rlm@424 180 "Read the message which starts at the current value of HL and do
rlm@424 181 what it says. Duration is left in A, and HL is advanced
rlm@424 182 appropraitely."
rlm@461 183 ([] (do-message 0x16 1))
rlm@461 184 ([sound-base-address wave-duty]
rlm@461 185 (assert (<= 0 wave-duty 3))
rlm@433 186 (let [switch
rlm@433 187 [0x2A ;; load message code into A, increment HL
rlm@433 188
rlm@433 189 ;; switch on message
rlm@433 190 0xFE
rlm@433 191 note-code
rlm@433 192
rlm@433 193 0x20
rlm@433 194 :note-length]
rlm@424 195
rlm@433 196 play-note
rlm@461 197 [0x3E ;; set wave-duty
rlm@461 198 (bit-shift-left wave-duty 6)
rlm@461 199 0xE0
rlm@461 200 sound-base-address
rlm@461 201 0x2A ;; load volume/frequency-high info
rlm@433 202 0xF5 ;; push A
rlm@433 203 0xE6
rlm@433 204 (Integer/parseInt "11110000" 2) ;; volume mask
rlm@433 205 0xE0
rlm@433 206 (inc sound-base-address) ;;0x17 ;; set volume
rlm@433 207 0xF1 ;; pop A
rlm@433 208 0xE6
rlm@433 209 (Integer/parseInt "00000111" 2) ;; frequency-high mask
rlm@433 210 0xE0
rlm@433 211 (+ 3 sound-base-address) ;;0x19 ;; set frequency-high
rlm@433 212
rlm@433 213 0x2A ;; load frequency low-bits
rlm@433 214 0xE0
rlm@433 215 (+ 2 sound-base-address) ;;0x18 ;; set frequency-low-bits
rlm@433 216 0x2A]] ;; load duration
rlm@433 217 (replace
rlm@433 218 {:note-length (count play-note)}
rlm@433 219 (concat switch play-note)))))
rlm@424 220
rlm@466 221 (defn play-noise
rlm@467 222 "read [noise-code, volume, duration] and play the noise. Duration is left in
rlm@466 223 A, and HL is advanced appropraitely."
rlm@466 224 ([]
rlm@466 225 [0x2A ;; load noise-code into A
rlm@466 226 0xE0
rlm@466 227 0x22 ;; write noise-code
rlm@467 228
rlm@467 229 0x2A ;; load volume
rlm@467 230 0xE0
rlm@467 231 0x21 ;; write volume
rlm@467 232
rlm@466 233 0x2A] ;; load duration into A
rlm@466 234 ))
rlm@466 235
rlm@466 236
rlm@433 237 ;; (defn play-note
rlm@433 238 ;; "Play the note referenced by HL in the appropiate channel.
rlm@433 239 ;; Leaves desired-duration in A."
rlm@433 240
rlm@433 241 ;; [0x2A ;; load volume/frequency-high info
rlm@433 242 ;; 0xF5 ;; push A
rlm@433 243 ;; 0xE6
rlm@433 244 ;; (Integer/parseInt "11110000" 2) ;; volume mask
rlm@433 245 ;; 0xE0
rlm@433 246 ;; 0x17 ;; set volume
rlm@433 247 ;; 0xF1 ;; pop A
rlm@433 248 ;; 0xE6
rlm@433 249 ;; (Integer/parseInt "00000111" 2) ;; frequency-high mask
rlm@433 250 ;; 0xE0
rlm@433 251 ;; 0x19 ;; set frequency-high
rlm@417 252
rlm@433 253 ;; 0x2A ;; load frequency low-bits
rlm@433 254 ;; 0xE0
rlm@433 255 ;; 0x18 ;; set frequency-low-bits
rlm@417 256
rlm@433 257 ;; 0x2A ;; load duration
rlm@433 258 ;; ])
rlm@417 259
rlm@466 260 (defn music-step [sound-base-address wave-duty noise?]
rlm@432 261 ;; C == current-ticks
rlm@432 262 ;; A == desired-ticks
rlm@435 263
rlm@435 264 (flatten
rlm@435 265 [;; restore variables from stack
rlm@435 266 0xE1 ;; pop HL
rlm@435 267 0xC1 ;; pop CB
rlm@435 268 0xF1 ;; pop AF
rlm@432 269
rlm@435 270
rlm@435 271 0xF5 ;; push A
rlm@417 272 0xF0
rlm@432 273 0x05 ;; load current ticks from 0xF005
rlm@431 274 0xB8 ;;
rlm@417 275 0x30 ;; increment C only if last result caused carry
rlm@417 276 0x01
rlm@418 277 0x0C
rlm@417 278
rlm@417 279 0x47 ;; update sub-ticks (A->B)
rlm@417 280
rlm@417 281 0xF1 ;; pop AF, now A contains desired-ticks
rlm@417 282
rlm@417 283 0xB9 ;; compare with current ticks
rlm@417 284
rlm@417 285 ;; if desired-ticks = current ticks
rlm@417 286 ;; go to next note ; set current set ticks to 0.
rlm@417 287
rlm@466 288 (if noise?
rlm@466 289 [0x20
rlm@466 290 (+ 2 (count (play-noise)))
rlm@466 291 (play-noise)]
rlm@466 292
rlm@466 293 [0x20
rlm@466 294 (+ (count (do-message 0 0)) 2)
rlm@466 295 (do-message sound-base-address wave-duty)])
rlm@417 296
rlm@417 297 0x0E
rlm@435 298 0x00 ;; 0->C (current-ticks)
rlm@417 299
rlm@435 300 ;; save variables to stack
rlm@435 301 0xF5 ;; push AF
rlm@435 302 0xC5 ;; push CB
rlm@435 303 0xE5 ;; push HL
rlm@435 304
rlm@435 305
rlm@435 306 ]))
rlm@435 307
rlm@435 308 (def music-1 0x11)
rlm@434 309 (def music-2 0x16)
rlm@434 310
rlm@461 311 (defn music-kernel [wave-duty-1 wave-duty-2]
rlm@417 312 (flatten
rlm@432 313 [;; global initilization section
rlm@432 314 (clear-music-registers)
rlm@432 315
rlm@417 316 0x3E
rlm@418 317 0x01
rlm@417 318 0xE0
rlm@417 319 0x06 ;; set TMA to 0
rlm@417 320
rlm@417 321 0x3E
rlm@423 322 (Integer/parseInt "00000110" 2)
rlm@417 323 0xE0
rlm@423 324 0x07 ;; set TAC to 65536 Hz and activate timer
rlm@417 325
rlm@435 326 ;; initialize frame 1
rlm@432 327 0x21
rlm@432 328 0x00
rlm@437 329 0xA0 ;; set HL to 0xA000 == music-start 1
rlm@432 330 0x0E
rlm@432 331 0x00 ;; 0->C
rlm@432 332 0x06
rlm@432 333 0x00 ;; 0->B
rlm@435 334
rlm@433 335 0xAF ;; 0->A
rlm@432 336
rlm@435 337 0xF5 ;; push AF
rlm@435 338 0xC5 ;; push CB
rlm@435 339 0xE5 ;; push HL
rlm@432 340
rlm@435 341 ;; initialize frame 2
rlm@436 342 0x21
rlm@436 343 0x00
rlm@437 344 0xB0 ;; set HL to 0xB000 == music-start 2
rlm@436 345
rlm@436 346 0xF5 ;; push AF
rlm@436 347 0xC5 ;; push CB
rlm@436 348 0xE5 ;; push HL
rlm@436 349
rlm@436 350
rlm@466 351 ;; initialize frame 3 (noise)
rlm@466 352 0x21
rlm@466 353 0x00
rlm@466 354 0xA9 ;; 0xA9OO -> HL
rlm@466 355
rlm@466 356 0xF5 ;; push AF
rlm@466 357 0xC5 ;; push CB
rlm@466 358 0xE5 ;; push HL
rlm@466 359
rlm@437 360 ;; main music loop
rlm@437 361
rlm@466 362 0xE8 ;; SP + 12; activate frame 1
rlm@466 363 12
rlm@466 364 (music-step music-1 wave-duty-1 false)
rlm@435 365
rlm@437 366 0xE8 ;; SP - 6; activate frame 2
rlm@437 367 (->signed-8-bit -6)
rlm@466 368 (music-step music-2 wave-duty-2 false)
rlm@466 369
rlm@466 370 0xE8 ;; SP - 6; activate frame 3
rlm@466 371 (->signed-8-bit -6)
rlm@466 372 (music-step nil nil true)
rlm@424 373
rlm@417 374 0x18
rlm@437 375 (->signed-8-bit (+
rlm@437 376 ;; two music-steps
rlm@466 377 (- (* 2 (count (music-step 0 0 false))))
rlm@466 378 (- (count (music-step nil nil true)))
rlm@437 379 -2 ;; this jump instruction
rlm@437 380 -2 ;; activate frame 1
rlm@437 381 -2 ;; activate frame 2
rlm@466 382 -2 ;; activate frame 3
rlm@437 383 ))]))
rlm@417 384
rlm@424 385 (defn frequency-code->frequency
rlm@424 386 [code]
rlm@424 387 (assert (<= 0 code 2047))
rlm@424 388 (/ 131072 (- 2048 code)))
rlm@424 389
rlm@424 390 (defn clamp [x low high]
rlm@424 391 (cond (> x high) high
rlm@424 392 (< x low) low
rlm@424 393 true x))
rlm@424 394
rlm@424 395 (defn frequency->frequency-code
rlm@424 396 [frequency]
rlm@424 397 (clamp
rlm@424 398 (Math/round
rlm@424 399 (float
rlm@424 400 (/ (- (* 2048 frequency) 131072) frequency)))
rlm@424 401 0x00 2048))
rlm@424 402
rlm@424 403 (defn note-codes [frequency volume duration]
rlm@424 404 (assert (<= 0 volume 0xF))
rlm@430 405 (if (<= duration 0xFF)
rlm@430 406 (let [frequency-code
rlm@430 407 (frequency->frequency-code frequency)
rlm@430 408 volume&high-frequency
rlm@430 409 (+ (bit-shift-left volume 4)
rlm@430 410 (bit-shift-right frequency-code 8))
rlm@430 411 low-frequency
rlm@430 412 (bit-and 0xFF frequency-code)]
rlm@430 413 [note-code
rlm@430 414 volume&high-frequency
rlm@430 415 low-frequency
rlm@430 416 duration])
rlm@430 417 (vec
rlm@430 418 (flatten
rlm@430 419 [(note-codes frequency volume 0xFF)
rlm@430 420 (note-codes frequency volume (- duration 0xFF))]))))
rlm@430 421
rlm@424 422
rlm@427 423 (defn midi-code->frequency
rlm@427 424 [midi-code]
rlm@427 425 (* 8.1757989156
rlm@427 426 (Math/pow 2 (* (float (/ 12)) midi-code))))
rlm@427 427
rlm@427 428 ;; division == clock-pulses / quarter-note
rlm@427 429 ;; tempo == microseconds / quarter-note
rlm@427 430
rlm@427 431 ;; have: clock-pulses
rlm@427 432 ;; want: seconds
rlm@427 433
rlm@427 434
rlm@428 435 (defn silence [length]
rlm@428 436 {:frequency 1
rlm@428 437 :duration length
rlm@428 438 :volume 0})
rlm@427 439
rlm@466 440 (defn commands
rlm@466 441 "return all events where #(= (:command %) command)"
rlm@466 442 [command s]
rlm@466 443 (filter #(= command (:command %)) s))
rlm@466 444
rlm@462 445 (defn track-info [#^File midi-file]
rlm@462 446 (let [events (parse-midi midi-file)
rlm@462 447 track-titles (commands :Title_t events)
rlm@462 448 track-info
rlm@462 449 (map #(read-string (read-string (:args %))) track-titles)
rlm@462 450 track-map
rlm@462 451 (zipmap track-info track-titles)]
rlm@462 452 track-map))
rlm@462 453
rlm@462 454 (defn target-tracks
rlm@462 455 "return the track-numbers in the form [voice-0 voice-1 noise]"
rlm@462 456 [#^File midi-file]
rlm@462 457 (let [track-data (track-info midi-file)
rlm@462 458 track-order
rlm@462 459 (zipmap (map :out (keys track-data))
rlm@462 460 (vals track-data))
rlm@462 461 channel-nums (map (comp :channel track-order) (range 3))]
rlm@462 462 channel-nums))
rlm@438 463
rlm@467 464 (defn midi-track->abstract-mini-midi
rlm@467 465 [#^File midi-file track-num]
rlm@467 466 (let [midi-events (parse-midi midi-file)
rlm@427 467
rlm@438 468 note-on-events (commands :Note_on_c midi-events)
rlm@438 469 note-off-events (commands :Note_off_c midi-events)
rlm@427 470
rlm@438 471 select-channel
rlm@438 472 (fn [n s]
rlm@462 473 (sort-by :time (filter #(= n (:channel %)) s)))
rlm@438 474
rlm@438 475 channel-on (select-channel track-num note-on-events)
rlm@427 476
rlm@438 477 channel-off (select-channel track-num note-off-events)
rlm@427 478
rlm@438 479
rlm@438 480 tempo (:args (first (commands :Tempo midi-events)))
rlm@438 481 division
rlm@438 482 (:division (:args (first (commands :Header midi-events))))
rlm@428 483
rlm@428 484 notes
rlm@428 485 (map
rlm@428 486 (fn [note-on note-off]
rlm@428 487 {:frequency (midi-code->frequency (:note (:args note-on)))
rlm@467 488 :midi-code (:note (:args note-on))
rlm@428 489 :duration
rlm@428 490 (/ (* (/ tempo division)
rlm@428 491 (- (:time note-off) (:time note-on)))
rlm@428 492 1e6) ;; convert clock-pulses into seconds
rlm@428 493 :volume (int (/ (:velocity (:args note-on)) 10))
rlm@428 494 :time-stamp (/ (* (/ tempo division)
rlm@428 495 (:time note-on)) 1e6)})
rlm@438 496 channel-on channel-off)
rlm@428 497
rlm@428 498 silences
rlm@428 499 (map (fn [note-1 note-2]
rlm@428 500 (let [note-1-space (- (:time-stamp note-2)
rlm@428 501 (:time-stamp note-1))
rlm@428 502 note-1-length (:duration note-1)]
rlm@428 503 (silence (- note-1-space note-1-length))))
rlm@428 504 ;; to handle silence at the beginning.
rlm@428 505 (concat [(assoc (silence 0)
rlm@428 506 :time-stamp 0)] notes)
rlm@428 507 notes)
rlm@428 508
rlm@428 509 notes-with-silence
rlm@456 510 (concat
rlm@456 511 (filter (comp not zero? :duration)
rlm@456 512 (interleave silences notes))
rlm@456 513 [(silence 3)])]
rlm@467 514 notes-with-silence))
rlm@467 515
rlm@467 516 (defn midi-track->mini-midi-voice [#^File midi-file track-num]
rlm@467 517 (let [abstract-mini-midi
rlm@467 518 (midi-track->abstract-mini-midi midi-file track-num)]
rlm@456 519 (map
rlm@456 520 (fn [note-event]
rlm@456 521 (note-codes (:frequency note-event)
rlm@456 522 (:volume note-event)
rlm@456 523 (int (* (:duration note-event) 0x100))))
rlm@467 524 abstract-mini-midi)))
rlm@467 525
rlm@468 526 (def midi-code->gb-noise-code
rlm@468 527 {nil 0xFF
rlm@468 528 35 87
rlm@468 529 38 20
rlm@468 530 39 0
rlm@468 531 })
rlm@468 532
rlm@467 533 (defn noise-codes [code volume duration]
rlm@467 534 (assert (<= 0 volume 0xF))
rlm@467 535 (if (<= duration 0xFF)
rlm@468 536 [(midi-code->gb-noise-code code code)
rlm@467 537 (bit-shift-left volume 4)
rlm@467 538 duration]
rlm@467 539 (vec
rlm@467 540 (flatten
rlm@467 541 [(noise-codes code volume 0xFF)
rlm@467 542 (noise-codes code volume (- duration 0xFF))]))))
rlm@467 543
rlm@467 544 (defn midi-track->mini-midi-noise [#^File midi-file track-num]
rlm@467 545 (let [abstract-mini-midi
rlm@467 546 (midi-track->abstract-mini-midi midi-file track-num)]
rlm@467 547 (map
rlm@467 548 (fn [noise-event]
rlm@467 549 (noise-codes (:midi-code noise-event)
rlm@467 550 (:volume noise-event)
rlm@467 551 (int (* (:duration noise-event) 0x100))))
rlm@467 552 abstract-mini-midi)))
rlm@467 553
rlm@467 554
rlm@438 555 (defn midi->mini-midi [#^File midi-file]
rlm@462 556 (let [targets (target-tracks midi-file)
rlm@463 557 duty-info (keys (track-info midi-file))]
rlm@463 558
rlm@467 559 {:voice-1 (midi-track->mini-midi-voice midi-file (nth targets 0))
rlm@467 560 :voice-2 (midi-track->mini-midi-voice midi-file (nth targets 1))
rlm@467 561 :noise (midi-track->mini-midi-noise midi-file (nth targets 2))
rlm@463 562 :duty (zipmap (map :out duty-info)
rlm@464 563 (map #(get % :duty 0) duty-info))}))
rlm@438 564
rlm@438 565 (defn play-midi [#^File midi-file]
rlm@467 566 (let [voice-1-target 0xA000
rlm@467 567 voice-2-target 0xB000
rlm@467 568 noise-target 0xA900
rlm@438 569 program-target 0xC000
rlm@438 570 mini-midi (midi->mini-midi midi-file)
rlm@467 571 long-silence (flatten (note-codes 20 0 20001))
rlm@467 572 long-noise-silence
rlm@467 573 (interleave (range 500) (repeat 0x00) (repeat 255))
rlm@467 574
rlm@463 575 voice-1 (flatten (:voice-1 mini-midi))
rlm@464 576 wave-duty-1 ((:duty mini-midi) 0 0)
rlm@463 577
rlm@463 578 voice-2 (flatten (:voice-2 mini-midi))
rlm@464 579 wave-duty-2 ((:duty mini-midi) 1 0)
rlm@466 580
rlm@466 581 noise (flatten (:noise mini-midi))
rlm@461 582 ]
rlm@438 583
rlm@438 584 (-> (second (music-base))
rlm@467 585 (set-memory-range voice-1-target long-silence)
rlm@467 586 (set-memory-range voice-2-target long-silence)
rlm@467 587 (set-memory-range noise-target long-noise-silence)
rlm@467 588 (set-memory-range voice-1-target voice-1)
rlm@467 589 (set-memory-range voice-2-target voice-2)
rlm@467 590 (set-memory-range noise-target noise)
rlm@461 591 (set-memory-range
rlm@461 592 program-target
rlm@461 593 (music-kernel wave-duty-1 wave-duty-2))
rlm@438 594 (PC! program-target))))
rlm@438 595
rlm@467 596 (defn test-noise []
rlm@467 597 (let [noise-pattern
rlm@467 598 (concat (interleave (range 0x100) (repeat 0xF0) (repeat 255))
rlm@467 599 (interleave (range 10) (repeat 0x00) (repeat 255)))]
rlm@467 600
rlm@467 601 (-> (second (music-base))
rlm@467 602 (set-memory-range 0xA900 (flatten noise-pattern))
rlm@467 603 (set-memory-range 0xC000 (music-kernel 0 0))
rlm@467 604 (PC! 0xC000))))
rlm@467 605
rlm@467 606 (defn test-play-noise [noise-code]
rlm@468 607 (Thread/sleep 300)
rlm@468 608 (println "playing noise:" noise-code)
rlm@467 609 (run-moves
rlm@467 610 (let [noise-pattern
rlm@467 611 (interleave (repeat 10 noise-code) (repeat 0xF0) (repeat 255))]
rlm@467 612 (-> (second (music-base))
rlm@467 613 (set-memory-range 0xA900 (flatten noise-pattern))
rlm@467 614 (set-memory-range 0xC000 (music-kernel 0 0))
rlm@467 615 (PC! 0xC000)))
rlm@468 616 (repeat 20 [])))
rlm@467 617
rlm@467 618 (defn test-all-noises []
rlm@467 619 (dorun (map test-play-noise (range 0x100))))
rlm@467 620
rlm@424 621 (def C4 (partial note-codes 261.63))
rlm@424 622 (def D4 (partial note-codes 293.66))
rlm@424 623 (def E4 (partial note-codes 329.63))
rlm@424 624 (def F4 (partial note-codes 349.23))
rlm@424 625 (def G4 (partial note-codes 392))
rlm@424 626 (def A4 (partial note-codes 440))
rlm@424 627 (def B4 (partial note-codes 493.88))
rlm@424 628 (def C5 (partial note-codes 523.3))
rlm@424 629
rlm@430 630 (def scale
rlm@430 631 (flatten
rlm@430 632 [(C4 0xF 0x40)
rlm@430 633 (D4 0xF 0x40)
rlm@430 634 (E4 0xF 0x40)
rlm@430 635 (F4 0xF 0x40)
rlm@430 636 (G4 0xF 0x40)
rlm@430 637 (A4 0xF 0x40)
rlm@430 638 (B4 0xF 0x40)
rlm@430 639 (C5 0xF 0x40)]))
rlm@424 640
rlm@418 641 (defn play-music [music-bytes]
rlm@417 642 (let [program-target 0xC000
rlm@437 643 music-target 0xA000]
rlm@417 644 (-> (set-memory-range (second (music-base))
rlm@417 645 program-target (music-kernel))
rlm@417 646 (set-memory-range music-target music-bytes)
rlm@417 647 (PC! program-target))))
rlm@417 648
rlm@417 649 (defn run-program
rlm@418 650 ([program]
rlm@417 651 (let [target 0xC000]
rlm@417 652 (-> (set-memory-range (second (music-base))
rlm@417 653 target program)
rlm@417 654 (PC! target)))))
rlm@417 655
rlm@424 656 (defn test-timer []
rlm@424 657 (flatten
rlm@424 658 [0x3E
rlm@424 659 0x01
rlm@424 660 0xE0
rlm@424 661 0x06 ;; set TMA to 0
rlm@424 662
rlm@424 663 0x3E
rlm@424 664 (Integer/parseInt "00000100" 2)
rlm@424 665 0xE0
rlm@424 666 0x07 ;; set TAC to 16384 Hz and activate timer
rlm@424 667
rlm@424 668 (repeat
rlm@424 669 500
rlm@424 670 [0xF0
rlm@424 671 0x05])]))
rlm@426 672
rlm@426 673