Mercurial > vba-clojure

comparison clojure/com/aurellem/run/music.clj @ 438:067ea3f0d951

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
can now play midi files with two tracks.
author Robert McIntyre <rlm@mit.edu>
date Wed, 25 Apr 2012 13:46:31 -0500
parents 20a9d5faf47c
children bf87b87a4ad7
comparison
equal deleted inserted replaced
437:20a9d5faf47c 438:067ea3f0d951
388 (defn silence [length] 388 (defn silence [length]
389 {:frequency 1 389 {:frequency 1
390 :duration length 390 :duration length
391 :volume 0}) 391 :volume 0})
392 392
393 (defn midi->mini-midi [#^File midi-file] 393 (defn commands
394 "return all events where #(= (:command %) command)"
395 [command s]
396 (filter #(= command (:command %)) s))
397
398 (defn midi-track->mini-midi [#^File midi-file track-num]
394 (let [midi-events (parse-midi midi-file) 399 (let [midi-events (parse-midi midi-file)
395 400
396 note-on-events 401 note-on-events (commands :Note_on_c midi-events)
397 (filter #(= :Note_on_c (:command %)) midi-events) 402 note-off-events (commands :Note_off_c midi-events)
398 note-off-events 403
399 (filter #(= :Note_off_c (:command %)) midi-events) 404 select-channel
400 405 (fn [n s]
401 channel-1-on 406 (sort-by :time (filter #(= n (:channel (:args %))) s)))
402 (sort-by :time 407
403 (filter #(= 1 (:channel (:args %))) 408 channel-on (select-channel track-num note-on-events)
404 note-on-events)) 409
405 channel-1-off 410 channel-off (select-channel track-num note-off-events)
406 (sort-by :time
407 (filter #(= 1 (:channel (:args %)))
408 note-off-events))
409 411
410 412
411 tempo (:args (first (filter #(= :Tempo (:command %)) midi-events))) 413 tempo (:args (first (commands :Tempo midi-events)))
412 division (:division 414 division
413 (:args (first (filter #(= :Header (:command %)) midi-events)))) 415 (:division (:args (first (commands :Header midi-events))))
414 416
415 notes 417 notes
416 (map 418 (map
417 (fn [note-on note-off] 419 (fn [note-on note-off]
418 {:frequency (midi-code->frequency (:note (:args note-on))) 420 {:frequency (midi-code->frequency (:note (:args note-on)))
421 (- (:time note-off) (:time note-on))) 423 (- (:time note-off) (:time note-on)))
422 1e6) ;; convert clock-pulses into seconds 424 1e6) ;; convert clock-pulses into seconds
423 :volume (int (/ (:velocity (:args note-on)) 10)) 425 :volume (int (/ (:velocity (:args note-on)) 10))
424 :time-stamp (/ (* (/ tempo division) 426 :time-stamp (/ (* (/ tempo division)
425 (:time note-on)) 1e6)}) 427 (:time note-on)) 1e6)})
426 channel-1-on channel-1-off) 428 channel-on channel-off)
427 429
428 silences 430 silences
429 (map (fn [note-1 note-2] 431 (map (fn [note-1 note-2]
430 (let [note-1-space (- (:time-stamp note-2) 432 (let [note-1-space (- (:time-stamp note-2)
431 (:time-stamp note-1)) 433 (:time-stamp note-1))
435 (concat [(assoc (silence 0) 437 (concat [(assoc (silence 0)
436 :time-stamp 0)] notes) 438 :time-stamp 0)] notes)
437 notes) 439 notes)
438 440
439 notes-with-silence 441 notes-with-silence
440 (filter (comp not zero? :duration) (interleave silences notes)) 442 (filter (comp not zero? :duration)
441 ] 443 (interleave silences notes))]
442
443 (map 444 (map
444 (fn [note-event] 445 (fn [note-event]
445 (note-codes (:frequency note-event) 446 (note-codes (:frequency note-event)
446 (:volume note-event) 447 (:volume note-event)
447 (int (* (:duration note-event) 0x100)))) 448 (int (* (:duration note-event) 0x100))))
448 notes-with-silence))) 449 notes-with-silence)))
449 450
451 (defn midi->mini-midi [#^File midi-file]
452 {:track-1 (flatten (midi-track->mini-midi midi-file 1))
453 :track-2 (flatten (midi-track->mini-midi midi-file 2))})
454
455 (defn play-midi [#^File midi-file]
456 (let [track-1-target 0xA000
457 track-2-target 0xB000
458 program-target 0xC000
459 mini-midi (midi->mini-midi midi-file)
460 long-silence (flatten (note-codes 20 0 9001))]
461
462 (-> (second (music-base))
463 (set-memory-range track-1-target long-silence)
464 (set-memory-range track-2-target long-silence)
465 (set-memory-range track-1-target (:track-1 mini-midi))
466 (set-memory-range track-2-target (:track-2 mini-midi))
467 (set-memory-range program-target (music-kernel))
468 (PC! program-target))))
469
470
471
450 472
451 (def C4 (partial note-codes 261.63)) 473 (def C4 (partial note-codes 261.63))
452 (def D4 (partial note-codes 293.66)) 474 (def D4 (partial note-codes 293.66))
453 (def E4 (partial note-codes 329.63)) 475 (def E4 (partial note-codes 329.63))
454 (def F4 (partial note-codes 349.23)) 476 (def F4 (partial note-codes 349.23))
475 program-target (music-kernel)) 497 program-target (music-kernel))
476 (set-memory-range music-target music-bytes) 498 (set-memory-range music-target music-bytes)
477 (PC! program-target)))) 499 (PC! program-target))))
478 500
479 501
502
480 ;; (defn test-note [music-bytes] 503 ;; (defn test-note [music-bytes]
481 ;; (-> (set-memory-range (second (music-base)) 504 ;; (-> (set-memory-range (second (music-base))
482 ;; 0xC000 (concat (clear-music-registers) 505 ;; 0xC000 (concat (clear-music-registers)
483 ;; (play-note) 506 ;; (play-note)
484 ;; (infinite-loop))) 507 ;; (infinite-loop)))