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 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 ->
   MIDIFile.Event -> SndSeqFFI.Event
mkEvent queue srcAddress dstAddress ev =
   let (typ, dat) = SndSeq.eventFromMIDIEvent queue ev
   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
                                 MIDIFile.MetaEvent (MIDIFile.SetTempo _) ->
                                      seqEv{SndSeqFFI.dest = SndSeqFFI.addressTimer}
                                 _ -> seqEv)
                         >> SndSeq.drainOutput client)
                   track