Play.hs

{- |
If you have the Haskore package installed,
then you can use this module for playing Haskore songs in realtime via ALSA.
Example:

> Prelude> Sound.ALSA.Sequencer.Play.run (Sound.ALSA.Sequencer.numAddress 128 0) (Haskore.Interface.MIDI.Render.generalMidi Haskore.Example.ChildSong6.song)
-}
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)
-- import Control.Monad.Error ()  -- Monad instance for Either


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 -- print midi

      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 -- putStrLn "playing"
                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