> module Euterpea.IO.MIDI.MEvent where
> import Euterpea.Music
> data MEvent = MEvent {
> MEvent -> PTime
eTime :: PTime,
> MEvent -> InstrumentName
eInst :: InstrumentName,
> MEvent -> Volume
ePitch :: AbsPitch,
> MEvent -> PTime
eDur :: DurT,
> MEvent -> Volume
eVol :: Volume,
> MEvent -> [Double]
eParams :: [Double]}
> 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}
>
> 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
> musicToMEvents MContext
c (Modify (Custom String
x) Music1
m) = MContext -> Music1 -> ([MEvent], PTime)
musicToMEvents MContext
c Music1
m
> 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
> 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
> Orn Ornament
_ -> ([MEvent], PTime)
pfd