content: -- ==========================================================================================
  -- Conversion to MEvent datatype
  
  > module Euterpea.IO.MIDI.MEvent where
  > import Euterpea.Music
  
  > data MEvent = MEvent {  
  >     eTime    :: PTime, -- onset time
  >     eInst    :: InstrumentName, -- instrument
  >     ePitch   :: AbsPitch, -- pitch number
  >     eDur     :: DurT, -- note duration
  >     eVol     :: Volume, -- volume
  >     eParams  :: [Double]} -- optional other parameters 
  >     deriving (Show,Eq,Ord)
  
  > type Performance = [MEvent]
  
  > type PTime = Rational
  > type DurT = Rational
  
  > merge :: Performance -> Performance -> Performance
  > merge []          es2         =  es2
  > merge es1         []          =  es1
  > merge a@(e1:es1)  b@(e2:es2)  =  
  >   if eTime e1 < eTime e2  then  e1  : merge es1 b
  >                           else  e2  : merge a es2
  
  > data MContext = MContext {mcTime    :: PTime, 
  >                           mcInst    :: InstrumentName, 
  >                           mcDur     :: DurT,
  >                           mcVol     :: Volume}
  >     deriving Show
  
  > perform :: (ToMusic1 a) => Music a -> Performance
  > perform = perform1 . toMusic1
  
  > perform1 :: Music1 -> Performance
  > perform1 = fst . perform1Dur
  
  > perform1Dur :: Music1 -> (Performance, DurT)
  > perform1Dur = musicToMEvents defCon . applyControls where
  >     defCon  = MContext {mcTime = 0, mcInst = AcousticGrandPiano, mcDur = metro 120 qn, mcVol=127}
  >     -- timing musicToMEventss
  >     metro :: Int -> Dur -> DurT
  >     metro setting dur  = 60 / (fromIntegral setting * dur)
  
  > applyControls :: Music1 -> Music1
  > applyControls (Modify (Tempo r) m) = scaleDurations r $ applyControls m
  > applyControls (Modify (Transpose k) m) = shiftPitches1 k $ applyControls m
  > applyControls (Modify x m) = Modify x $ applyControls m
  > applyControls (m1 :+: m2) = applyControls m1 :+: applyControls m2
  > applyControls (m1 :=: m2) = applyControls m1 :=: applyControls m2
  > applyControls x = x
  
  > musicToMEvents :: MContext -> Music1 -> (Performance, DurT)
  > musicToMEvents c@MContext{mcTime=t, mcDur=dt} (Prim (Note d p)) = ([noteToMEvent c d p], d*dt)
  > musicToMEvents c@MContext{mcTime=t, mcDur=dt}  (Prim (Rest d)) = ([], d*dt)
  > musicToMEvents c@MContext{mcTime=t, mcDur=dt} (m1 :+: m2) = 
  >     let (evs1, d1) = musicToMEvents c m1
  >         (evs2, d2) = musicToMEvents c{mcTime = t+d1} m2
  >     in  (evs1 ++ evs2, d1+d2)
  > musicToMEvents c@MContext{mcTime=t, mcDur=dt} (m1 :=: m2) = 
  >     let (evs1, d1) = musicToMEvents c m1
  >         (evs2, d2) = musicToMEvents c m2
  >     in  (merge evs1 evs2, max d1 d2)
  > musicToMEvents c (Modify (Instrument i) m) = musicToMEvents c{mcInst=i} m
  > musicToMEvents c (Modify (Phrase pas) m) = phraseToMEvents c pas m
  > musicToMEvents c (Modify (KeySig x y) m) = musicToMEvents c m -- KeySig causes no change
  > musicToMEvents c (Modify (Custom x) m) = musicToMEvents c m -- Custom cuases no change
  > musicToMEvents c m@(Modify x m') = musicToMEvents c $ applyControls m -- Transpose and Tempo addressed by applyControls
  
  > noteToMEvent :: MContext -> Dur -> (Pitch, [NoteAttribute]) -> MEvent
  > noteToMEvent c@(MContext ct ci cdur cvol) d (p, nas) = 
  >     let e0 = MEvent{eTime=ct, ePitch=absPitch p, eInst=ci, eDur=d*cdur, eVol=cvol, eParams=[]}
  >     in  foldr nasFun e0 nas where
  >     nasFun :: NoteAttribute -> MEvent -> MEvent
  >     nasFun (Volume v) ev = ev {eVol = v}
  >     nasFun (Params pms) ev = ev {eParams = pms}
  >     nasFun _ ev = ev
  
  > phraseToMEvents :: MContext -> [PhraseAttribute] -> Music1 -> (Performance, DurT)
  > phraseToMEvents c [] m = musicToMEvents c m
  > phraseToMEvents c@MContext{mcTime=t, mcInst=i, mcDur=dt} (pa:pas) m =
  >  let  pfd@(pf,dur)  =  phraseToMEvents c pas m
  >       loud x        =  phraseToMEvents c (Dyn (Loudness x) : pas) m
  >       stretch x     =  let  t0 = eTime (head pf);  r  = x/dur
  >                             upd (e@MEvent {eTime = t, eDur = d}) = 
  >                               let  dt  = t-t0
  >                                    t'  = (1+dt*r)*dt + t0
  >                                    d'  = (1+(2*dt+d)*r)*d
  >                               in e {eTime = t', eDur = d'}
  >                        in (map upd pf, (1+x)*dur)
  >       inflate x     =  let  t0  = eTime (head pf);  
  >                             r   = x/dur
  >                             upd (e@MEvent {eTime = t, eVol = v}) = 
  >                                 e {eVol =  round ( (1+(t-t0)*r) * 
  >                                            fromIntegral v)}
  >                        in (map upd pf, dur)
  >  in case pa of
  >    Dyn (Accent x) ->
  >        ( map (\e-> e {eVol = round (x * fromIntegral (eVol e))}) pf, dur)
  >    Dyn (StdLoudness l) -> 
  >        case l of 
  >           PPP  -> loud 40;       PP -> loud 50;   P    -> loud 60
  >           MP   -> loud 70;       SF -> loud 80;   MF   -> loud 90
  >           NF   -> loud 100;      FF -> loud 110;  FFF  -> loud 120
  >    Dyn (Loudness x)     ->  phraseToMEvents c{mcVol = round x} pas m
  >    Dyn (Crescendo x)    ->  inflate   x ; Dyn (Diminuendo x)  -> inflate (-x)
  >    Tmp (Ritardando x)   ->  stretch   x ; Tmp (Accelerando x) -> stretch (-x)
  >    Art (Staccato x)     ->  (map (\e-> e {eDur = x * eDur e}) pf, dur)
  >    Art (Legato x)       ->  (map (\e-> e {eDur = x * eDur e}) pf, dur)
  >    Art (Slurred x)      -> 
  >        let  lastStartTime  = foldr (\e t -> max (eTime e) t) 0 pf
  >             setDur e       =   if eTime e < lastStartTime
  >                                then e {eDur = x * eDur e}
  >                                else e
  >        in (map setDur pf, dur) 
  >    Art _                -> pfd -- not supported
  >    Orn _                -> pfd -- not supported
  