module Sound.ALSA.Sequencer.Play (run) where
import qualified Sound.ALSA.Sequencer as SndSeq
import qualified Sound.ALSA.Sequencer.FFI as SndSeqFFI
import qualified Sound.MIDI.File as MIDIFile
import qualified Sound.MIDI.File.Event as MIDIFileEvent
import qualified Sound.MIDI.File.Event.Meta as MetaEvent
import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Numeric.NonNegative.Wrapper as NonNeg
import Control.Concurrent (threadDelay)
import Control.Exception (bracket)
mkEvent ::
SndSeqFFI.Queue ->
SndSeqFFI.Address -> SndSeqFFI.Address ->
MIDIFileEvent.T -> SndSeqFFI.Event
mkEvent queue srcAddress dstAddress ev =
let (typ, dat) =
case ev of
MIDIFileEvent.MIDIEvent msg -> SndSeq.eventFromChannelMsg msg
MIDIFileEvent.MetaEvent msg -> SndSeq.eventFromMetaEvent queue msg
MIDIFileEvent.SystemExclusive _ -> error "SystemExclusive not implemented"
in SndSeqFFI.Event {
SndSeqFFI.typ = typ,
SndSeqFFI.tag = 0,
SndSeqFFI.queue = SndSeqFFI.queueDirect,
SndSeqFFI.time = SndSeqFFI.TimeStampTick (SndSeqFFI.TickTime 0),
SndSeqFFI.timeMode = SndSeqFFI.TimeModeRelative,
SndSeqFFI.eventLength = SndSeqFFI.EventLengthFixed,
SndSeqFFI.priority = SndSeqFFI.PriorityNormal,
SndSeqFFI.source = srcAddress,
SndSeqFFI.dest = dstAddress,
SndSeqFFI.eventData = dat}
run :: SndSeqFFI.Address -> MIDIFile.T -> IO ()
run dstAddress (MIDIFile.Cons typ _div tracks) =
do
let track =
case typ of
MIDIFile.Parallel -> foldl EventList.merge EventList.empty tracks
MIDIFile.Serial -> EventList.concat tracks
MIDIFile.Mixed -> EventList.concat tracks
bracket
(SndSeq.createClient SndSeqFFI.openOutput "midi player")
SndSeq.deleteClient $
\ client ->
SndSeq.withNamedQueue client "playmidi out queue" $
\ queue ->
do
port <- SndSeq.createOutputPort client "player output"
let srcAddress = SndSeq.portAddress client port
EventList.mapM_
(threadDelay . (5000*) . fromInteger . NonNeg.toNumber)
(\ev ->
(SndSeq.sendPlainEvent client $
let seqEv = mkEvent queue srcAddress dstAddress ev
in case ev of
MIDIFileEvent.MetaEvent (MetaEvent.SetTempo _) ->
seqEv{SndSeqFFI.dest = SndSeqFFI.addressTimer}
_ -> seqEv)
>> SndSeq.drainOutput client)
track