-- ==========================================================================================

-- Conversion to MEvent datatype


> module Euterpea.IO.MIDI.MEvent where
> import Euterpea.Music

> data MEvent = MEvent {  
>     MEvent -> PTime
eTime    :: PTime, -- onset time

>     MEvent -> InstrumentName
eInst    :: InstrumentName, -- instrument

>     MEvent -> Volume
ePitch   :: AbsPitch, -- pitch number

>     MEvent -> PTime
eDur     :: DurT, -- note duration

>     MEvent -> Volume
eVol     :: Volume, -- volume

>     MEvent -> [Double]
eParams  :: [Double]} -- optional other parameters 

>     deriving (Volume -> MEvent -> ShowS
[MEvent] -> ShowS
MEvent -> String
(Volume -> MEvent -> ShowS)
-> (MEvent -> String) -> ([MEvent] -> ShowS) -> Show MEvent
forall a.
(Volume -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Volume -> MEvent -> ShowS
showsPrec :: Volume -> MEvent -> ShowS
$cshow :: MEvent -> String
show :: MEvent -> String
$cshowList :: [MEvent] -> ShowS
showList :: [MEvent] -> ShowS
Show,MEvent -> MEvent -> Bool
(MEvent -> MEvent -> Bool)
-> (MEvent -> MEvent -> Bool) -> Eq MEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MEvent -> MEvent -> Bool
== :: MEvent -> MEvent -> Bool
$c/= :: MEvent -> MEvent -> Bool
/= :: MEvent -> MEvent -> Bool
Eq,Eq MEvent
Eq MEvent =>
(MEvent -> MEvent -> Ordering)
-> (MEvent -> MEvent -> Bool)
-> (MEvent -> MEvent -> Bool)
-> (MEvent -> MEvent -> Bool)
-> (MEvent -> MEvent -> Bool)
-> (MEvent -> MEvent -> MEvent)
-> (MEvent -> MEvent -> MEvent)
-> Ord MEvent
MEvent -> MEvent -> Bool
MEvent -> MEvent -> Ordering
MEvent -> MEvent -> MEvent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MEvent -> MEvent -> Ordering
compare :: MEvent -> MEvent -> Ordering
$c< :: MEvent -> MEvent -> Bool
< :: MEvent -> MEvent -> Bool
$c<= :: MEvent -> MEvent -> Bool
<= :: MEvent -> MEvent -> Bool
$c> :: MEvent -> MEvent -> Bool
> :: MEvent -> MEvent -> Bool
$c>= :: MEvent -> MEvent -> Bool
>= :: MEvent -> MEvent -> Bool
$cmax :: MEvent -> MEvent -> MEvent
max :: MEvent -> MEvent -> MEvent
$cmin :: MEvent -> MEvent -> MEvent
min :: MEvent -> MEvent -> MEvent
Ord)

> type Performance = [MEvent]

> type PTime = Rational
> type DurT = Rational

> merge :: Performance -> Performance -> Performance
> merge :: [MEvent] -> [MEvent] -> [MEvent]
merge []          [MEvent]
es2         =  [MEvent]
es2
> merge [MEvent]
es1         []          =  [MEvent]
es1
> merge a :: [MEvent]
a@(MEvent
e1:[MEvent]
es1)  b :: [MEvent]
b@(MEvent
e2:[MEvent]
es2)  =  
>   if MEvent -> PTime
eTime MEvent
e1 PTime -> PTime -> Bool
forall a. Ord a => a -> a -> Bool
< MEvent -> PTime
eTime MEvent
e2  then  MEvent
e1  MEvent -> [MEvent] -> [MEvent]
forall a. a -> [a] -> [a]
: [MEvent] -> [MEvent] -> [MEvent]
merge [MEvent]
es1 [MEvent]
b
>                           else  MEvent
e2  MEvent -> [MEvent] -> [MEvent]
forall a. a -> [a] -> [a]
: [MEvent] -> [MEvent] -> [MEvent]
merge [MEvent]
a [MEvent]
es2

> data MContext = MContext {MContext -> PTime
mcTime    :: PTime, 
>                           MContext -> InstrumentName
mcInst    :: InstrumentName, 
>                           MContext -> PTime
mcDur     :: DurT,
>                           MContext -> Volume
mcVol     :: Volume}
>     deriving Volume -> MContext -> ShowS
[MContext] -> ShowS
MContext -> String
(Volume -> MContext -> ShowS)
-> (MContext -> String) -> ([MContext] -> ShowS) -> Show MContext
forall a.
(Volume -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Volume -> MContext -> ShowS
showsPrec :: Volume -> MContext -> ShowS
$cshow :: MContext -> String
show :: MContext -> String
$cshowList :: [MContext] -> ShowS
showList :: [MContext] -> ShowS
Show

> perform :: (ToMusic1 a) => Music a -> Performance
> perform :: forall a. ToMusic1 a => Music a -> [MEvent]
perform = Music1 -> [MEvent]
perform1 (Music1 -> [MEvent]) -> (Music a -> Music1) -> Music a -> [MEvent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Music a -> Music1
forall a. ToMusic1 a => Music a -> Music1
toMusic1

> perform1 :: Music1 -> Performance
> perform1 :: Music1 -> [MEvent]
perform1 = ([MEvent], PTime) -> [MEvent]
forall a b. (a, b) -> a
fst (([MEvent], PTime) -> [MEvent])
-> (Music1 -> ([MEvent], PTime)) -> Music1 -> [MEvent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Music1 -> ([MEvent], PTime)
perform1Dur

> perform1Dur :: Music1 -> (Performance, DurT)
> perform1Dur :: Music1 -> ([MEvent], PTime)
perform1Dur = MContext -> Music1 -> ([MEvent], PTime)
musicToMEvents MContext
defCon (Music1 -> ([MEvent], PTime))
-> (Music1 -> Music1) -> Music1 -> ([MEvent], PTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Music1 -> Music1
applyControls where
>     defCon :: MContext
defCon  = MContext {mcTime :: PTime
mcTime = PTime
0, mcInst :: InstrumentName
mcInst = InstrumentName
AcousticGrandPiano, mcDur :: PTime
mcDur = Volume -> PTime -> PTime
metro Volume
120 PTime
qn, mcVol :: Volume
mcVol=Volume
127}
>     -- timing musicToMEventss

>     metro :: Int -> Dur -> DurT
>     metro :: Volume -> PTime -> PTime
metro Volume
setting PTime
dur  = PTime
60 PTime -> PTime -> PTime
forall a. Fractional a => a -> a -> a
/ (Volume -> PTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Volume
setting PTime -> PTime -> PTime
forall a. Num a => a -> a -> a
* PTime
dur)

> applyControls :: Music1 -> Music1
> applyControls :: Music1 -> Music1
applyControls (Modify (Tempo PTime
r) Music1
m) = PTime -> Music1 -> Music1
forall a. PTime -> Music a -> Music a
scaleDurations PTime
r (Music1 -> Music1) -> Music1 -> Music1
forall a b. (a -> b) -> a -> b
$ Music1 -> Music1
applyControls Music1
m
> applyControls (Modify (Transpose Volume
k) Music1
m) = Volume -> Music1 -> Music1
forall b. Volume -> Music (Pitch, b) -> Music (Pitch, b)
shiftPitches1 Volume
k (Music1 -> Music1) -> Music1 -> Music1
forall a b. (a -> b) -> a -> b
$ Music1 -> Music1
applyControls Music1
m
> applyControls (Modify Control
x Music1
m) = Control -> Music1 -> Music1
forall a. Control -> Music a -> Music a
Modify Control
x (Music1 -> Music1) -> Music1 -> Music1
forall a b. (a -> b) -> a -> b
$ Music1 -> Music1
applyControls Music1
m
> applyControls (Music1
m1 :+: Music1
m2) = Music1 -> Music1
applyControls Music1
m1 Music1 -> Music1 -> Music1
forall a. Music a -> Music a -> Music a
:+: Music1 -> Music1
applyControls Music1
m2
> applyControls (Music1
m1 :=: Music1
m2) = Music1 -> Music1
applyControls Music1
m1 Music1 -> Music1 -> Music1
forall a. Music a -> Music a -> Music a
:=: Music1 -> Music1
applyControls Music1
m2
> applyControls Music1
x = Music1
x

> musicToMEvents :: MContext -> Music1 -> (Performance, DurT)
> musicToMEvents :: MContext -> Music1 -> ([MEvent], PTime)
musicToMEvents c :: MContext
c@MContext{mcTime :: MContext -> PTime
mcTime=PTime
t, mcDur :: MContext -> PTime
mcDur=PTime
dt} (Prim (Note PTime
d Note1
p)) = ([MContext -> PTime -> Note1 -> MEvent
noteToMEvent MContext
c PTime
d Note1
p], PTime
dPTime -> PTime -> PTime
forall a. Num a => a -> a -> a
*PTime
dt)
> musicToMEvents c :: MContext
c@MContext{mcTime :: MContext -> PTime
mcTime=PTime
t, mcDur :: MContext -> PTime
mcDur=PTime
dt}  (Prim (Rest PTime
d)) = ([], PTime
dPTime -> PTime -> PTime
forall a. Num a => a -> a -> a
*PTime
dt)
> musicToMEvents c :: MContext
c@MContext{mcTime :: MContext -> PTime
mcTime=PTime
t, mcDur :: MContext -> PTime
mcDur=PTime
dt} (Music1
m1 :+: Music1
m2) = 
>     let ([MEvent]
evs1, PTime
d1) = MContext -> Music1 -> ([MEvent], PTime)
musicToMEvents MContext
c Music1
m1
>         ([MEvent]
evs2, PTime
d2) = MContext -> Music1 -> ([MEvent], PTime)
musicToMEvents MContext
c{mcTime = t+d1} Music1
m2
>     in  ([MEvent]
evs1 [MEvent] -> [MEvent] -> [MEvent]
forall a. [a] -> [a] -> [a]
++ [MEvent]
evs2, PTime
d1PTime -> PTime -> PTime
forall a. Num a => a -> a -> a
+PTime
d2)
> musicToMEvents c :: MContext
c@MContext{mcTime :: MContext -> PTime
mcTime=PTime
t, mcDur :: MContext -> PTime
mcDur=PTime
dt} (Music1
m1 :=: Music1
m2) = 
>     let ([MEvent]
evs1, PTime
d1) = MContext -> Music1 -> ([MEvent], PTime)
musicToMEvents MContext
c Music1
m1
>         ([MEvent]
evs2, PTime
d2) = MContext -> Music1 -> ([MEvent], PTime)
musicToMEvents MContext
c Music1
m2
>     in  ([MEvent] -> [MEvent] -> [MEvent]
merge [MEvent]
evs1 [MEvent]
evs2, PTime -> PTime -> PTime
forall a. Ord a => a -> a -> a
max PTime
d1 PTime
d2)
> musicToMEvents MContext
c (Modify (Instrument InstrumentName
i) Music1
m) = MContext -> Music1 -> ([MEvent], PTime)
musicToMEvents MContext
c{mcInst=i} Music1
m
> musicToMEvents MContext
c (Modify (Phrase [PhraseAttribute]
pas) Music1
m) = MContext -> [PhraseAttribute] -> Music1 -> ([MEvent], PTime)
phraseToMEvents MContext
c [PhraseAttribute]
pas Music1
m
> musicToMEvents MContext
c (Modify (KeySig PitchClass
x Mode
y) Music1
m) = MContext -> Music1 -> ([MEvent], PTime)
musicToMEvents MContext
c Music1
m -- KeySig causes no change

> musicToMEvents MContext
c (Modify (Custom String
x) Music1
m) = MContext -> Music1 -> ([MEvent], PTime)
musicToMEvents MContext
c Music1
m -- Custom cuases no change

> musicToMEvents MContext
c m :: Music1
m@(Modify Control
x Music1
m') = MContext -> Music1 -> ([MEvent], PTime)
musicToMEvents MContext
c (Music1 -> ([MEvent], PTime)) -> Music1 -> ([MEvent], PTime)
forall a b. (a -> b) -> a -> b
$ Music1 -> Music1
applyControls Music1
m -- Transpose and Tempo addressed by applyControls


> noteToMEvent :: MContext -> Dur -> (Pitch, [NoteAttribute]) -> MEvent
> noteToMEvent :: MContext -> PTime -> Note1 -> MEvent
noteToMEvent c :: MContext
c@(MContext PTime
ct InstrumentName
ci PTime
cdur Volume
cvol) PTime
d (Pitch
p, [NoteAttribute]
nas) = 
>     let e0 :: MEvent
e0 = MEvent{eTime :: PTime
eTime=PTime
ct, ePitch :: Volume
ePitch=Pitch -> Volume
absPitch Pitch
p, eInst :: InstrumentName
eInst=InstrumentName
ci, eDur :: PTime
eDur=PTime
dPTime -> PTime -> PTime
forall a. Num a => a -> a -> a
*PTime
cdur, eVol :: Volume
eVol=Volume
cvol, eParams :: [Double]
eParams=[]}
>     in  (NoteAttribute -> MEvent -> MEvent)
-> MEvent -> [NoteAttribute] -> MEvent
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NoteAttribute -> MEvent -> MEvent
nasFun MEvent
e0 [NoteAttribute]
nas where
>     nasFun :: NoteAttribute -> MEvent -> MEvent
>     nasFun :: NoteAttribute -> MEvent -> MEvent
nasFun (Volume Volume
v) MEvent
ev = MEvent
ev {eVol = v}
>     nasFun (Params [Double]
pms) MEvent
ev = MEvent
ev {eParams = pms}
>     nasFun NoteAttribute
_ MEvent
ev = MEvent
ev

> phraseToMEvents :: MContext -> [PhraseAttribute] -> Music1 -> (Performance, DurT)
> phraseToMEvents :: MContext -> [PhraseAttribute] -> Music1 -> ([MEvent], PTime)
phraseToMEvents MContext
c [] Music1
m = MContext -> Music1 -> ([MEvent], PTime)
musicToMEvents MContext
c Music1
m
> phraseToMEvents c :: MContext
c@MContext{mcTime :: MContext -> PTime
mcTime=PTime
t, mcInst :: MContext -> InstrumentName
mcInst=InstrumentName
i, mcDur :: MContext -> PTime
mcDur=PTime
dt} (PhraseAttribute
pa:[PhraseAttribute]
pas) Music1
m =
>  let  pfd :: ([MEvent], PTime)
pfd@([MEvent]
pf,PTime
dur)  =  MContext -> [PhraseAttribute] -> Music1 -> ([MEvent], PTime)
phraseToMEvents MContext
c [PhraseAttribute]
pas Music1
m
>       loud :: PTime -> ([MEvent], PTime)
loud PTime
x        =  MContext -> [PhraseAttribute] -> Music1 -> ([MEvent], PTime)
phraseToMEvents MContext
c (Dynamic -> PhraseAttribute
Dyn (PTime -> Dynamic
Loudness PTime
x) PhraseAttribute -> [PhraseAttribute] -> [PhraseAttribute]
forall a. a -> [a] -> [a]
: [PhraseAttribute]
pas) Music1
m
>       stretch :: PTime -> ([MEvent], PTime)
stretch PTime
x     =  let  t0 :: PTime
t0 = MEvent -> PTime
eTime ([MEvent] -> MEvent
forall a. HasCallStack => [a] -> a
head [MEvent]
pf);  r :: PTime
r  = PTime
xPTime -> PTime -> PTime
forall a. Fractional a => a -> a -> a
/PTime
dur
>                             upd :: MEvent -> MEvent
upd (e :: MEvent
e@MEvent {eTime :: MEvent -> PTime
eTime = PTime
t, eDur :: MEvent -> PTime
eDur = PTime
d}) = 
>                               let  dt :: PTime
dt  = PTime
tPTime -> PTime -> PTime
forall a. Num a => a -> a -> a
-PTime
t0
>                                    t' :: PTime
t'  = (PTime
1PTime -> PTime -> PTime
forall a. Num a => a -> a -> a
+PTime
dtPTime -> PTime -> PTime
forall a. Num a => a -> a -> a
*PTime
r)PTime -> PTime -> PTime
forall a. Num a => a -> a -> a
*PTime
dt PTime -> PTime -> PTime
forall a. Num a => a -> a -> a
+ PTime
t0
>                                    d' :: PTime
d'  = (PTime
1PTime -> PTime -> PTime
forall a. Num a => a -> a -> a
+(PTime
2PTime -> PTime -> PTime
forall a. Num a => a -> a -> a
*PTime
dtPTime -> PTime -> PTime
forall a. Num a => a -> a -> a
+PTime
d)PTime -> PTime -> PTime
forall a. Num a => a -> a -> a
*PTime
r)PTime -> PTime -> PTime
forall a. Num a => a -> a -> a
*PTime
d
>                               in MEvent
e {eTime = t', eDur = d'}
>                        in ((MEvent -> MEvent) -> [MEvent] -> [MEvent]
forall a b. (a -> b) -> [a] -> [b]
map MEvent -> MEvent
upd [MEvent]
pf, (PTime
1PTime -> PTime -> PTime
forall a. Num a => a -> a -> a
+PTime
x)PTime -> PTime -> PTime
forall a. Num a => a -> a -> a
*PTime
dur)
>       inflate :: PTime -> ([MEvent], PTime)
inflate PTime
x     =  let  t0 :: PTime
t0  = MEvent -> PTime
eTime ([MEvent] -> MEvent
forall a. HasCallStack => [a] -> a
head [MEvent]
pf);  
>                             r :: PTime
r   = PTime
xPTime -> PTime -> PTime
forall a. Fractional a => a -> a -> a
/PTime
dur
>                             upd :: MEvent -> MEvent
upd (e :: MEvent
e@MEvent {eTime :: MEvent -> PTime
eTime = PTime
t, eVol :: MEvent -> Volume
eVol = Volume
v}) = 
>                                 MEvent
e {eVol =  round ( (1+(t-t0)*r) * 
>                                            fromIntegral v)}
>                        in ((MEvent -> MEvent) -> [MEvent] -> [MEvent]
forall a b. (a -> b) -> [a] -> [b]
map MEvent -> MEvent
upd [MEvent]
pf, PTime
dur)
>  in case PhraseAttribute
pa of
>    Dyn (Accent PTime
x) ->
>        ( (MEvent -> MEvent) -> [MEvent] -> [MEvent]
forall a b. (a -> b) -> [a] -> [b]
map (\MEvent
e-> MEvent
e {eVol = round (x * fromIntegral (eVol e))}) [MEvent]
pf, PTime
dur)
>    Dyn (StdLoudness StdLoudness
l) -> 
>        case StdLoudness
l of 
>           StdLoudness
PPP  -> PTime -> ([MEvent], PTime)
loud PTime
40;       StdLoudness
PP -> PTime -> ([MEvent], PTime)
loud PTime
50;   StdLoudness
P    -> PTime -> ([MEvent], PTime)
loud PTime
60
>           StdLoudness
MP   -> PTime -> ([MEvent], PTime)
loud PTime
70;       StdLoudness
SF -> PTime -> ([MEvent], PTime)
loud PTime
80;   StdLoudness
MF   -> PTime -> ([MEvent], PTime)
loud PTime
90
>           StdLoudness
NF   -> PTime -> ([MEvent], PTime)
loud PTime
100;      StdLoudness
FF -> PTime -> ([MEvent], PTime)
loud PTime
110;  StdLoudness
FFF  -> PTime -> ([MEvent], PTime)
loud PTime
120
>    Dyn (Loudness PTime
x)     ->  MContext -> [PhraseAttribute] -> Music1 -> ([MEvent], PTime)
phraseToMEvents MContext
c{mcVol = round x} [PhraseAttribute]
pas Music1
m
>    Dyn (Crescendo PTime
x)    ->  PTime -> ([MEvent], PTime)
inflate   PTime
x ; Dyn (Diminuendo PTime
x)  -> PTime -> ([MEvent], PTime)
inflate (-PTime
x)
>    Tmp (Ritardando PTime
x)   ->  PTime -> ([MEvent], PTime)
stretch   PTime
x ; Tmp (Accelerando PTime
x) -> PTime -> ([MEvent], PTime)
stretch (-PTime
x)
>    Art (Staccato PTime
x)     ->  ((MEvent -> MEvent) -> [MEvent] -> [MEvent]
forall a b. (a -> b) -> [a] -> [b]
map (\MEvent
e-> MEvent
e {eDur = x * eDur e}) [MEvent]
pf, PTime
dur)
>    Art (Legato PTime
x)       ->  ((MEvent -> MEvent) -> [MEvent] -> [MEvent]
forall a b. (a -> b) -> [a] -> [b]
map (\MEvent
e-> MEvent
e {eDur = x * eDur e}) [MEvent]
pf, PTime
dur)
>    Art (Slurred PTime
x)      -> 
>        let  lastStartTime :: PTime
lastStartTime  = (MEvent -> PTime -> PTime) -> PTime -> [MEvent] -> PTime
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\MEvent
e PTime
t -> PTime -> PTime -> PTime
forall a. Ord a => a -> a -> a
max (MEvent -> PTime
eTime MEvent
e) PTime
t) PTime
0 [MEvent]
pf
>             setDur :: MEvent -> MEvent
setDur MEvent
e       =   if MEvent -> PTime
eTime MEvent
e PTime -> PTime -> Bool
forall a. Ord a => a -> a -> Bool
< PTime
lastStartTime
>                                then MEvent
e {eDur = x * eDur e}
>                                else MEvent
e
>        in ((MEvent -> MEvent) -> [MEvent] -> [MEvent]
forall a b. (a -> b) -> [a] -> [b]
map MEvent -> MEvent
setDur [MEvent]
pf, PTime
dur) 
>    Art Articulation
_                -> ([MEvent], PTime)
pfd -- not supported

>    Orn Ornament
_                -> ([MEvent], PTime)
pfd -- not supported