> module Euterpea.IO.MIDI.FromMidi (fromMidi) where
> import Euterpea.Music
> import Euterpea.IO.MIDI.ToMidi
> import Euterpea.IO.MIDI.GeneralMidi
> import Data.List
> import Codec.Midi


Donya Quick
Last updated 15-Oct-2013.

Changes since last major version (15-Jan-2013):
- makeUPM: (is !! i, 10) changed to (is !! i, 9) for Percussion.
- Instrument numbers <0 are interpreted as Percussion.
- ProgChange 10 x is now assigned (-1) as an instrument number.

KNOWN ISSUES:
- Tempo changes occuring between matching note on/off events may not be 
  interpreted optimally. A performance-correct representation rather 
  than a score-correct representation could be accomplished by looking 
  for these sorts of between-on-off tempo changes when calculating a 
  note's duration. 
  
This code was originally developed for research purposes and then 
adapted for CPSC 431/531 to overcome some problems exhibited by the
original implementation of fromMidi. 

This code has functions to read Midi values into an intermediate type,
SimpleMsg, before conversion to Music (Pitch, Volume) to make processing 
instrument changes easier. The following features will be retained from 
the input file:
- Placement of notes relative to the beat (assumed to be quarternotes).
- The pitch, volume, and instrument of each note.
- Tempo changes indicated by TempoChange MIDI events

Other MIDI controller information is currently not supported. This includes 
events such as pitch bends and modulations. For these controllers, there is 
no simple way to capture the information in a Music data structure.

The following datatype is for a simplification of MIDI events into simple 
On/off events for pitches occurring at different times. There are two 
types of events considered: tempo changes and note events. The note events
are represented by tuples of:
- exact onset time, Rational
- absolute pitch, AbsPitch
- volume from 0-127, Volume
- instrument number, Int. The value (-1) is used for Percussion.
- on/off type, NEvent

> data NEvent = On | Off
>   deriving (NEvent -> NEvent -> Bool
(NEvent -> NEvent -> Bool)
-> (NEvent -> NEvent -> Bool) -> Eq NEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NEvent -> NEvent -> Bool
== :: NEvent -> NEvent -> Bool
$c/= :: NEvent -> NEvent -> Bool
/= :: NEvent -> NEvent -> Bool
Eq, Channel -> NEvent -> ShowS
[NEvent] -> ShowS
NEvent -> String
(Channel -> NEvent -> ShowS)
-> (NEvent -> String) -> ([NEvent] -> ShowS) -> Show NEvent
forall a.
(Channel -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Channel -> NEvent -> ShowS
showsPrec :: Channel -> NEvent -> ShowS
$cshow :: NEvent -> String
show :: NEvent -> String
$cshowList :: [NEvent] -> ShowS
showList :: [NEvent] -> ShowS
Show, Eq NEvent
Eq NEvent =>
(NEvent -> NEvent -> Ordering)
-> (NEvent -> NEvent -> Bool)
-> (NEvent -> NEvent -> Bool)
-> (NEvent -> NEvent -> Bool)
-> (NEvent -> NEvent -> Bool)
-> (NEvent -> NEvent -> NEvent)
-> (NEvent -> NEvent -> NEvent)
-> Ord NEvent
NEvent -> NEvent -> Bool
NEvent -> NEvent -> Ordering
NEvent -> NEvent -> NEvent
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 :: NEvent -> NEvent -> Ordering
compare :: NEvent -> NEvent -> Ordering
$c< :: NEvent -> NEvent -> Bool
< :: NEvent -> NEvent -> Bool
$c<= :: NEvent -> NEvent -> Bool
<= :: NEvent -> NEvent -> Bool
$c> :: NEvent -> NEvent -> Bool
> :: NEvent -> NEvent -> Bool
$c>= :: NEvent -> NEvent -> Bool
>= :: NEvent -> NEvent -> Bool
$cmax :: NEvent -> NEvent -> NEvent
max :: NEvent -> NEvent -> NEvent
$cmin :: NEvent -> NEvent -> NEvent
min :: NEvent -> NEvent -> NEvent
Ord)

> data SimpleMsg = SE (Rational, AbsPitch, Volume, Int, NEvent) |
>               T (Rational, Rational)
>   deriving (SimpleMsg -> SimpleMsg -> Bool
(SimpleMsg -> SimpleMsg -> Bool)
-> (SimpleMsg -> SimpleMsg -> Bool) -> Eq SimpleMsg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimpleMsg -> SimpleMsg -> Bool
== :: SimpleMsg -> SimpleMsg -> Bool
$c/= :: SimpleMsg -> SimpleMsg -> Bool
/= :: SimpleMsg -> SimpleMsg -> Bool
Eq, Channel -> SimpleMsg -> ShowS
[SimpleMsg] -> ShowS
SimpleMsg -> String
(Channel -> SimpleMsg -> ShowS)
-> (SimpleMsg -> String)
-> ([SimpleMsg] -> ShowS)
-> Show SimpleMsg
forall a.
(Channel -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Channel -> SimpleMsg -> ShowS
showsPrec :: Channel -> SimpleMsg -> ShowS
$cshow :: SimpleMsg -> String
show :: SimpleMsg -> String
$cshowList :: [SimpleMsg] -> ShowS
showList :: [SimpleMsg] -> ShowS
Show)
> instance Ord (SimpleMsg) where
>     compare :: SimpleMsg -> SimpleMsg -> Ordering
compare (SE(Dur
t,Channel
p,Channel
v,Channel
i,NEvent
e)) (SE(Dur
t',Channel
p',Channel
v',Channel
i',NEvent
e')) = 
>         if Dur
tDur -> Dur -> Bool
forall a. Ord a => a -> a -> Bool
<Dur
t' then Ordering
LT else if Dur
tDur -> Dur -> Bool
forall a. Ord a => a -> a -> Bool
>Dur
t' then Ordering
GT else Ordering
EQ
>     compare (T(Dur
t,Dur
x)) (SE(Dur
t',Channel
p',Channel
v',Channel
i',NEvent
e')) = 
>         if Dur
tDur -> Dur -> Bool
forall a. Ord a => a -> a -> Bool
<Dur
t' then Ordering
LT else if Dur
tDur -> Dur -> Bool
forall a. Ord a => a -> a -> Bool
>Dur
t' then Ordering
GT else Ordering
EQ
>     compare (SE(Dur
t,Channel
p,Channel
v,Channel
i,NEvent
e)) (T(Dur
t',Dur
x)) = 
>         if Dur
tDur -> Dur -> Bool
forall a. Ord a => a -> a -> Bool
<Dur
t' then Ordering
LT else if Dur
tDur -> Dur -> Bool
forall a. Ord a => a -> a -> Bool
>Dur
t' then Ordering
GT else Ordering
EQ
>     compare (T(Dur
t,Dur
x)) (T(Dur
t',Dur
x')) =
>         if Dur
tDur -> Dur -> Bool
forall a. Ord a => a -> a -> Bool
<Dur
t' then Ordering
LT else if Dur
tDur -> Dur -> Bool
forall a. Ord a => a -> a -> Bool
>Dur
t' then Ordering
GT else Ordering
EQ

The importFile function places track ticks (Ticks) in a format where 
each value attached to a message represents the number of ticks that 
have passed SINCE THE LAST MESSAGE. The following function will convert 
input in that format into a list of pairs where the ticks are absolute. 
In otherwords, ticks in the output will represent the exact point in 
time of an event. This means that unsupported events (e.g. pitch bend) 
can later be filtered out without affecting the timing of support events.

> addTrackTicks :: Int -> [(Ticks, a)] -> [(Ticks, a)]
> addTrackTicks :: forall a. Channel -> [(Channel, a)] -> [(Channel, a)]
addTrackTicks Channel
sum [] = []
> addTrackTicks Channel
sum ((Channel
t,a
x):[(Channel, a)]
ts) = (Channel
tChannel -> Channel -> Channel
forall a. Num a => a -> a -> a
+Channel
sum,a
x) (Channel, a) -> [(Channel, a)] -> [(Channel, a)]
forall a. a -> [a] -> [a]
: Channel -> [(Channel, a)] -> [(Channel, a)]
forall a. Channel -> [(Channel, a)] -> [(Channel, a)]
addTrackTicks (Channel
tChannel -> Channel -> Channel
forall a. Num a => a -> a -> a
+Channel
sum) [(Channel, a)]
ts

The following function addresses a ticks to Music duration conversion.

> applyTD :: TimeDiv -> SimpleMsg -> SimpleMsg
> applyTD :: TimeDiv -> SimpleMsg -> SimpleMsg
applyTD TimeDiv
tdw SimpleMsg
x = 
>     case SimpleMsg
x of T(Dur
t,Dur
i) -> (Dur, Dur) -> SimpleMsg
T(TimeDiv -> Dur -> Dur
forall {a}. Fractional a => TimeDiv -> a -> a
fixT TimeDiv
tdw Dur
t, Dur
i) 
>               SE(Dur
t,Channel
p,Channel
v,Channel
i,NEvent
e) -> (Dur, Channel, Channel, Channel, NEvent) -> SimpleMsg
SE(TimeDiv -> Dur -> Dur
forall {a}. Fractional a => TimeDiv -> a -> a
fixT TimeDiv
tdw Dur
t, Channel
p, Channel
v, Channel
i, NEvent
e) where

> fixT :: TimeDiv -> a -> a
fixT TimeDiv
tdw a
t = 
>     case TimeDiv
tdw of TicksPerBeat Channel
td -> a
t a -> a -> a
forall a. Fractional a => a -> a -> a
/ (Channel -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Channel
td a -> a -> a
forall a. Num a => a -> a -> a
* a
4)
>                 TicksPerSecond Channel
fps Channel
tpf -> a
t a -> a -> a
forall a. Fractional a => a -> a -> a
/ Channel -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Channel
fps Channel -> Channel -> Channel
forall a. Num a => a -> a -> a
* Channel
tpf)


The midiToEvents function will take a Midi structure (from importFile, 
for example) and convert it to a list of lists of SimpleMsgs. Each outer 
list represents a track in the original Midi. 

> midiToEvents :: Midi -> [[SimpleMsg]]
> midiToEvents :: Midi -> [[SimpleMsg]]
midiToEvents Midi
m = 
>     let ts :: [[SimpleMsg]]
ts = ([(Channel, Message)] -> [SimpleMsg])
-> [[(Channel, Message)]] -> [[SimpleMsg]]
forall a b. (a -> b) -> [a] -> [b]
map (Channel -> [(Channel, Message)] -> [SimpleMsg]
simplifyTrack Channel
0) ([[(Channel, Message)]] -> [[SimpleMsg]])
-> [[(Channel, Message)]] -> [[SimpleMsg]]
forall a b. (a -> b) -> a -> b
$ ([(Channel, Message)] -> [(Channel, Message)])
-> [[(Channel, Message)]] -> [[(Channel, Message)]]
forall a b. (a -> b) -> [a] -> [b]
map (Channel -> [(Channel, Message)] -> [(Channel, Message)]
forall a. Channel -> [(Channel, a)] -> [(Channel, a)]
addTrackTicks Channel
0) (Midi -> [[(Channel, Message)]]
tracks Midi
m) 
>     in  [[SimpleMsg]] -> [[SimpleMsg]]
distributeTempos ([[SimpleMsg]] -> [[SimpleMsg]]) -> [[SimpleMsg]] -> [[SimpleMsg]]
forall a b. (a -> b) -> a -> b
$ ([SimpleMsg] -> [SimpleMsg]) -> [[SimpleMsg]] -> [[SimpleMsg]]
forall a b. (a -> b) -> [a] -> [b]
map ((SimpleMsg -> SimpleMsg) -> [SimpleMsg] -> [SimpleMsg]
forall a b. (a -> b) -> [a] -> [b]
map (TimeDiv -> SimpleMsg -> SimpleMsg
applyTD (TimeDiv -> SimpleMsg -> SimpleMsg)
-> TimeDiv -> SimpleMsg -> SimpleMsg
forall a b. (a -> b) -> a -> b
$ Midi -> TimeDiv
timeDiv Midi
m)) [[SimpleMsg]]
ts where 
>   simplifyTrack :: Int -> [(Ticks, Message)] -> [SimpleMsg]
>   simplifyTrack :: Channel -> [(Channel, Message)] -> [SimpleMsg]
simplifyTrack Channel
icur [] = []
>   simplifyTrack Channel
icur ((Channel
t,Message
m):[(Channel, Message)]
ts) = 
>     case Message
m of (NoteOn Channel
c Channel
p Channel
v) -> 
>                   (Dur, Channel, Channel, Channel, NEvent) -> SimpleMsg
SE (Channel -> Dur
forall a b. (Integral a, Num b) => a -> b
fromIntegral Channel
t, Channel
p, Channel
v, Channel
icur, NEvent
On) SimpleMsg -> [SimpleMsg] -> [SimpleMsg]
forall a. a -> [a] -> [a]
: Channel -> [(Channel, Message)] -> [SimpleMsg]
simplifyTrack Channel
icur [(Channel, Message)]
ts
>               (NoteOff Channel
c Channel
p Channel
v) -> 
>                   (Dur, Channel, Channel, Channel, NEvent) -> SimpleMsg
SE (Channel -> Dur
forall a b. (Integral a, Num b) => a -> b
fromIntegral Channel
t, Channel
p, Channel
v, Channel
icur, NEvent
Off) SimpleMsg -> [SimpleMsg] -> [SimpleMsg]
forall a. a -> [a] -> [a]
: Channel -> [(Channel, Message)] -> [SimpleMsg]
simplifyTrack Channel
icur [(Channel, Message)]
ts
>               (ProgramChange Channel
c Channel
p) -> Channel -> [(Channel, Message)] -> [SimpleMsg]
simplifyTrack (if Channel
cChannel -> Channel -> Bool
forall a. Eq a => a -> a -> Bool
==Channel
9 then (-Channel
1) else Channel
p) [(Channel, Message)]
ts 
>               (TempoChange Channel
x) -> (Dur, Dur) -> SimpleMsg
T (Channel -> Dur
forall a b. (Integral a, Num b) => a -> b
fromIntegral Channel
t, Channel -> Dur
forall a b. (Integral a, Num b) => a -> b
fromIntegral Channel
x) SimpleMsg -> [SimpleMsg] -> [SimpleMsg]
forall a. a -> [a] -> [a]
: Channel -> [(Channel, Message)] -> [SimpleMsg]
simplifyTrack Channel
icur [(Channel, Message)]
ts
>               Message
_ -> Channel -> [(Channel, Message)] -> [SimpleMsg]
simplifyTrack Channel
icur [(Channel, Message)]
ts 


The first track is the tempo track. It's events need to be distributed
across the other tracks. This function below is called for that purpose
in midiToEvents above.

> distributeTempos :: [[SimpleMsg]] -> [[SimpleMsg]]
> distributeTempos :: [[SimpleMsg]] -> [[SimpleMsg]]
distributeTempos [[SimpleMsg]]
tracks = 
>     if [[SimpleMsg]] -> Channel
forall a. [a] -> Channel
forall (t :: * -> *) a. Foldable t => t a -> Channel
length [[SimpleMsg]]
tracks Channel -> Channel -> Bool
forall a. Ord a => a -> a -> Bool
> Channel
1 then ([SimpleMsg] -> [SimpleMsg]) -> [[SimpleMsg]] -> [[SimpleMsg]]
forall a b. (a -> b) -> [a] -> [b]
map ([SimpleMsg] -> [SimpleMsg]
forall a. Ord a => [a] -> [a]
sort ([SimpleMsg] -> [SimpleMsg])
-> ([SimpleMsg] -> [SimpleMsg]) -> [SimpleMsg] -> [SimpleMsg]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[SimpleMsg]] -> [SimpleMsg]
forall a. HasCallStack => [a] -> a
head [[SimpleMsg]]
tracks [SimpleMsg] -> [SimpleMsg] -> [SimpleMsg]
forall a. [a] -> [a] -> [a]
++)) ([[SimpleMsg]] -> [[SimpleMsg]]
forall a. HasCallStack => [a] -> [a]
tail [[SimpleMsg]]
tracks)
>     else [[SimpleMsg]]
tracks -- must be a single-track file with embedded tempo changes.



The eventsToMusic function will convert a list of lists of SimpleMsgs 
(output from midiToEvents) to a Music(Pitch,Volume) structure. All 
notes will be connected together using the (:=:) constructor. For 
example, the first line of "Frere Jaque", which would normally be
written as:

c 5 qn :+: d 5 qn :+: e 5 qn :+: c 5 qn

would actually get represented like this when read in from a MIDI:

	(rest 0 :+: c 5 qn) :=:
      (rest qn :+: d 5 qn) :=:
      (rest hn :+: e 5 qn) :=:
      (rest dhn :+: c 5 qn)

This structure is clearly more complicated than it needs to be.
However, identifying melodic lines and phrases inorder to group the
events in a more musically appropriate manor is non-trivial, since
it requires both phrase and voice identification within an instrument 
To see why this is the case, consider a Piano, which may have right 
and lef thand lines that might be best separated by :=: at the 
outermost level. In a MIDI, however, we are likely to get all of the
events for both hands lumped into the same track. 

The parallelized structure is also required for keeping tempo changes
syced between instruments. While MIDI files allow tempo changes to 
occur in the middle of a note, Euterpea's Music values do not.
      
Instruments will be grouped at the outermost level. For example, if 
there are 2 instruments with music values m1 and m2 repsectively, the
structure would be:

    (instrument i1 m1) :=: (instrument i2 m1)
	
Tempo changes are processed within each instrument.

> eventsToMusic :: [[SimpleMsg]] -> Music (Pitch, Volume)
> eventsToMusic :: [[SimpleMsg]] -> Music (Pitch, Channel)
eventsToMusic [[SimpleMsg]]
tracks = 
>     let tracks' :: [[SimpleMsg]]
tracks' = [[SimpleMsg]] -> [[SimpleMsg]]
splitByInstruments [[SimpleMsg]]
tracks -- handle any mid-track program changes

>         is :: [InstrumentName]
is = (Channel -> InstrumentName) -> [Channel] -> [InstrumentName]
forall a b. (a -> b) -> [a] -> [b]
map Channel -> InstrumentName
toInstr ([Channel] -> [InstrumentName]) -> [Channel] -> [InstrumentName]
forall a b. (a -> b) -> a -> b
$ ([SimpleMsg] -> Channel) -> [[SimpleMsg]] -> [Channel]
forall a b. (a -> b) -> [a] -> [b]
map [SimpleMsg] -> Channel
getInstrument ([[SimpleMsg]] -> [Channel]) -> [[SimpleMsg]] -> [Channel]
forall a b. (a -> b) -> a -> b
$ ([SimpleMsg] -> Bool) -> [[SimpleMsg]] -> [[SimpleMsg]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> ([SimpleMsg] -> Bool) -> [SimpleMsg] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[SimpleMsg] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[SimpleMsg]]
tracks' -- instruments

>         tDef :: Dur
tDef = Dur
500000 -- current tempo, 120bpm as microseconds per qn

>     in  [Music (Pitch, Channel)] -> Music (Pitch, Channel)
forall a. [Music a] -> Music a
chord ([Music (Pitch, Channel)] -> Music (Pitch, Channel))
-> [Music (Pitch, Channel)] -> Music (Pitch, Channel)
forall a b. (a -> b) -> a -> b
$ (InstrumentName
 -> Music (Pitch, Channel) -> Music (Pitch, Channel))
-> [InstrumentName]
-> [Music (Pitch, Channel)]
-> [Music (Pitch, Channel)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith InstrumentName -> Music (Pitch, Channel) -> Music (Pitch, Channel)
forall a. InstrumentName -> Music a -> Music a
instrument [InstrumentName]
is ([Music (Pitch, Channel)] -> [Music (Pitch, Channel)])
-> [Music (Pitch, Channel)] -> [Music (Pitch, Channel)]
forall a b. (a -> b) -> a -> b
$ ([SimpleMsg] -> Music (Pitch, Channel))
-> [[SimpleMsg]] -> [Music (Pitch, Channel)]
forall a b. (a -> b) -> [a] -> [b]
map (Dur -> [SimpleMsg] -> Music (Pitch, Channel)
seToMusic Dur
tDef) [[SimpleMsg]]
tracks' where
>   
>   toInstr :: Int -> InstrumentName
>   toInstr :: Channel -> InstrumentName
toInstr Channel
i = if Channel
iChannel -> Channel -> Bool
forall a. Ord a => a -> a -> Bool
<Channel
0 then InstrumentName
Percussion else Channel -> InstrumentName
forall a. Enum a => Channel -> a
toEnum Channel
i 
>
>   seToMusic :: Rational -> [SimpleMsg] -> Music (Pitch, Volume)
>   seToMusic :: Dur -> [SimpleMsg] -> Music (Pitch, Channel)
seToMusic Dur
tCurr [] = Dur -> Music (Pitch, Channel)
forall a. Dur -> Music a
rest Dur
0
>   seToMusic Dur
tCurr (e1 :: SimpleMsg
e1@(SE(Dur
t,Channel
p,Channel
v,Channel
ins,NEvent
On)):[SimpleMsg]
es) = 
>     let piMatch :: SimpleMsg -> Bool
piMatch (SE(Dur
t1,Channel
p1,Channel
v1,Channel
ins1,NEvent
e1)) = (Channel
p1Channel -> Channel -> Bool
forall a. Eq a => a -> a -> Bool
==Channel
p Bool -> Bool -> Bool
&& Channel
ins1Channel -> Channel -> Bool
forall a. Eq a => a -> a -> Bool
==Channel
ins) Bool -> Bool -> Bool
&& NEvent
e1NEvent -> NEvent -> Bool
forall a. Eq a => a -> a -> Bool
==NEvent
Off
>         piMatch (T(Dur
t1,Dur
x)) = Bool
False
>         is :: [Channel]
is = (SimpleMsg -> Bool) -> [SimpleMsg] -> [Channel]
forall a. (a -> Bool) -> [a] -> [Channel]
findIndices SimpleMsg -> Bool
piMatch [SimpleMsg]
es -- find mactching note-offs

>         SE(Dur
t1,Channel
p1,Channel
v1,Channel
ins1, NEvent
e) = [SimpleMsg]
es [SimpleMsg] -> Channel -> SimpleMsg
forall a. HasCallStack => [a] -> Channel -> a
!! ([Channel]
is [Channel] -> Channel -> Channel
forall a. HasCallStack => [a] -> Channel -> a
!! Channel
0) -- pick the first matching note-off

>         n :: Music (Pitch, Channel)
n = (Dur -> Music (Pitch, Channel)
forall a. Dur -> Music a
rest Dur
t Music (Pitch, Channel)
-> Music (Pitch, Channel) -> Music (Pitch, Channel)
forall a. Music a -> Music a -> Music a
:+: Dur -> (Pitch, Channel) -> Music (Pitch, Channel)
forall a. Dur -> a -> Music a
note (Dur
t1Dur -> Dur -> Dur
forall a. Num a => a -> a -> a
-Dur
t) (Channel -> Pitch
pitch Channel
p,Channel
v)) -- create a Music note

>     in  if Channel
v Channel -> Channel -> Bool
forall a. Ord a => a -> a -> Bool
> Channel
0 then -- a zero volume note is silence

>              if [Channel] -> Channel
forall a. [a] -> Channel
forall (t :: * -> *) a. Foldable t => t a -> Channel
length [Channel]
is Channel -> Channel -> Bool
forall a. Ord a => a -> a -> Bool
> Channel
0 then Music (Pitch, Channel)
n Music (Pitch, Channel)
-> Music (Pitch, Channel) -> Music (Pitch, Channel)
forall a. Music a -> Music a -> Music a
:=: Dur -> [SimpleMsg] -> Music (Pitch, Channel)
seToMusic Dur
tCurr [SimpleMsg]
es -- found an off

>              else Dur -> [SimpleMsg] -> Music (Pitch, Channel)
seToMusic Dur
tCurr ((SimpleMsg
e1SimpleMsg -> [SimpleMsg] -> [SimpleMsg]
forall a. a -> [a] -> [a]
:[SimpleMsg]
es)[SimpleMsg] -> [SimpleMsg] -> [SimpleMsg]
forall a. [a] -> [a] -> [a]
++[SimpleMsg -> [SimpleMsg] -> SimpleMsg
correctOff SimpleMsg
e1 [SimpleMsg]
es]) -- missing off case

>         else Dur -> [SimpleMsg] -> Music (Pitch, Channel)
seToMusic Dur
tCurr [SimpleMsg]
es
>   seToMusic Dur
tCurr (e1 :: SimpleMsg
e1@(T (Dur
t,Dur
newTempo)):[SimpleMsg]
es) = 
>     let t2 :: Dur
t2 = SimpleMsg -> Dur
getTime (SimpleMsg -> Dur) -> SimpleMsg -> Dur
forall a b. (a -> b) -> a -> b
$ [SimpleMsg] -> SimpleMsg
forall a. HasCallStack => [a] -> a
head [SimpleMsg]
es -- find time of next event after tempo change

>         tfact :: Dur
tfact = Dur
tCurr Dur -> Dur -> Dur
forall a. Fractional a => a -> a -> a
/ Dur
newTempo -- calculate tempo change factor

>         es' :: [SimpleMsg]
es' = (SimpleMsg -> SimpleMsg) -> [SimpleMsg] -> [SimpleMsg]
forall a b. (a -> b) -> [a] -> [b]
map ((Dur -> Dur) -> SimpleMsg -> SimpleMsg
changeTime (Dur -> Dur -> Dur
forall a. Num a => a -> a -> a
subtract Dur
t)) [SimpleMsg]
es -- adjust start times

>         m :: Music (Pitch, Channel)
m = Dur -> Music (Pitch, Channel)
forall a. Dur -> Music a
rest Dur
t Music (Pitch, Channel)
-> Music (Pitch, Channel) -> Music (Pitch, Channel)
forall a. Music a -> Music a -> Music a
:+: Dur -> Music (Pitch, Channel) -> Music (Pitch, Channel)
forall a. Dur -> Music a -> Music a
tempo Dur
tfact (Dur -> [SimpleMsg] -> Music (Pitch, Channel)
seToMusic Dur
newTempo [SimpleMsg]
es')  
>     in  if [SimpleMsg] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SimpleMsg]
es then Dur -> Music (Pitch, Channel)
forall a. Dur -> Music a
rest Dur
0 else Music (Pitch, Channel)
m where
>         changeTime :: (Dur -> Dur) -> SimpleMsg -> SimpleMsg
changeTime Dur -> Dur
f (SE (Dur
t,Channel
p,Channel
v,Channel
i,NEvent
e)) = (Dur, Channel, Channel, Channel, NEvent) -> SimpleMsg
SE (Dur -> Dur
f Dur
t,Channel
p,Channel
v,Channel
i,NEvent
e)
>         changeTime Dur -> Dur
f (T (Dur
t,Dur
x)) = (Dur, Dur) -> SimpleMsg
T (Dur -> Dur
f Dur
t, Dur
x)
>   seToMusic Dur
tCurr (SimpleMsg
_:[SimpleMsg]
es) = Dur -> [SimpleMsg] -> Music (Pitch, Channel)
seToMusic Dur
tCurr [SimpleMsg]
es -- ignore note-offs (already handled)



Finding the time of an event.

> getTime :: SimpleMsg -> Dur
getTime (SE(Dur
t,Channel
p,Channel
v,Channel
i,NEvent
e)) = Dur
t
> getTime (T (Dur
t,Dur
x)) = Dur
t


Finding the instrument associated with a track. Only the first
instrument label to appear is chosen. If a program change happens
mid-track, it will not be counted.

> getInstrument :: [SimpleMsg] -> Channel
getInstrument ((SE(Dur
t,Channel
p,Channel
v,Channel
i,NEvent
e)):[SimpleMsg]
xs) = Channel
i
> getInstrument ((T (Dur, Dur)
x) : [SimpleMsg]
xs) = [SimpleMsg] -> Channel
getInstrument [SimpleMsg]
xs
> getInstrument [] = -Channel
1 -- No instrument assigned



The following function ensure that only one instrument appears in 
each list of SimpleMsgs. This is necessary in order to ensure that 
instrument assignments occur at the outermost level of the Music.

> splitByInstruments :: [[SimpleMsg]] -> [[SimpleMsg]] 
> splitByInstruments :: [[SimpleMsg]] -> [[SimpleMsg]]
splitByInstruments [] = []
> splitByInstruments ([SimpleMsg]
t:[[SimpleMsg]]
ts) = 
>     let i :: Channel
i = [SimpleMsg] -> Channel
getInstrument [SimpleMsg]
t
>         ([SimpleMsg]
t',[SimpleMsg]
t'') = Channel -> [SimpleMsg] -> ([SimpleMsg], [SimpleMsg])
splitByI Channel
i [SimpleMsg]
t
>         ts' :: [[SimpleMsg]]
ts' = if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (SimpleMsg -> Bool) -> [SimpleMsg] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map SimpleMsg -> Bool
isSE [SimpleMsg]
t'' then [[SimpleMsg]] -> [[SimpleMsg]]
splitByInstruments ([SimpleMsg]
t''[SimpleMsg] -> [[SimpleMsg]] -> [[SimpleMsg]]
forall a. a -> [a] -> [a]
:[[SimpleMsg]]
ts) 
>               else [[SimpleMsg]] -> [[SimpleMsg]]
splitByInstruments [[SimpleMsg]]
ts
>     in  if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (SimpleMsg -> Bool) -> [SimpleMsg] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map SimpleMsg -> Bool
isSE [SimpleMsg]
t' then [SimpleMsg]
t' [SimpleMsg] -> [[SimpleMsg]] -> [[SimpleMsg]]
forall a. a -> [a] -> [a]
: [[SimpleMsg]]
ts' else [[SimpleMsg]]
ts'

> isSE :: SimpleMsg -> Bool
> isSE :: SimpleMsg -> Bool
isSE (SE (Dur, Channel, Channel, Channel, NEvent)
xs) = Bool
True
> isSE (T (Dur, Dur)
i) = Bool
False


The splitByI function partitions a stream to select a specific instrument's events.

> splitByI :: Int -> [SimpleMsg] -> ([SimpleMsg],[SimpleMsg])
> splitByI :: Channel -> [SimpleMsg] -> ([SimpleMsg], [SimpleMsg])
splitByI Channel
i0 [] = ([],[])
> splitByI Channel
i0 (SimpleMsg
x:[SimpleMsg]
xs) = 
>     let ([SimpleMsg]
ts,[SimpleMsg]
fs) = Channel -> [SimpleMsg] -> ([SimpleMsg], [SimpleMsg])
splitByI Channel
i0 [SimpleMsg]
xs
>         f :: SimpleMsg -> Bool
f (SE(Dur
_,Channel
_,Channel
_,Channel
i1,NEvent
_)) = Channel
i0 Channel -> Channel -> Bool
forall a. Eq a => a -> a -> Bool
== Channel
i1
>         f SimpleMsg
_ = Bool
False
>     in  case SimpleMsg
x of SE (Dur, Channel, Channel, Channel, NEvent)
x' -> if SimpleMsg -> Bool
f SimpleMsg
x then (SimpleMsg
xSimpleMsg -> [SimpleMsg] -> [SimpleMsg]
forall a. a -> [a] -> [a]
:[SimpleMsg]
ts,[SimpleMsg]
fs) else ([SimpleMsg]
ts,SimpleMsg
xSimpleMsg -> [SimpleMsg] -> [SimpleMsg]
forall a. a -> [a] -> [a]
:[SimpleMsg]
fs)
>                   T (Dur, Dur)
i -> (SimpleMsg
xSimpleMsg -> [SimpleMsg] -> [SimpleMsg]
forall a. a -> [a] -> [a]
:[SimpleMsg]
ts, SimpleMsg
xSimpleMsg -> [SimpleMsg] -> [SimpleMsg]
forall a. a -> [a] -> [a]
:[SimpleMsg]
fs) -- add tempos to both streams



This function is an error-handling method for MIDI files which have 
mismatched note on/off events. This seems to be common in output from 
some software. The solution used here is to assume that the note lasts 
until the the time of the last event in the list. 

> correctOff :: SimpleMsg -> [SimpleMsg] -> SimpleMsg
correctOff (SE(Dur
t,Channel
p,Channel
v,Channel
ins,NEvent
e)) [] = (Dur, Channel, Channel, Channel, NEvent) -> SimpleMsg
SE(Dur
t,Channel
p,Channel
v,Channel
ins,NEvent
Off)
> correctOff (SE(Dur
t,Channel
p,Channel
v,Channel
ins,NEvent
e)) [SimpleMsg]
es = 
>     let SE(Dur
t1,Channel
p1,Channel
v1,Channel
ins1,NEvent
e1) = [SimpleMsg] -> SimpleMsg
forall a. HasCallStack => [a] -> a
last ([SimpleMsg] -> SimpleMsg) -> [SimpleMsg] -> SimpleMsg
forall a b. (a -> b) -> a -> b
$ (SimpleMsg -> Bool) -> [SimpleMsg] -> [SimpleMsg]
forall a. (a -> Bool) -> [a] -> [a]
filter SimpleMsg -> Bool
isSE [SimpleMsg]
es
>     in  (Dur, Channel, Channel, Channel, NEvent) -> SimpleMsg
SE(Dur
t1,Channel
p,Channel
v,Channel
ins,NEvent
Off) 


The fromMidi function wraps the combination of midiToEvents and 
eventsToMusic and performs the final conversion to Music1.

> fromMidi :: Midi -> Music1
> fromMidi :: Midi -> Music1
fromMidi Midi
m = 
>     let seList :: [[SimpleMsg]]
seList = Midi -> [[SimpleMsg]]
midiToEvents Midi
m
>         iNums :: [Channel]
iNums = (Channel -> Bool) -> [Channel] -> [Channel]
forall a. (a -> Bool) -> [a] -> [a]
filter (Channel -> Channel -> Bool
forall a. Ord a => a -> a -> Bool
>Channel
0) ([Channel] -> [Channel]) -> [Channel] -> [Channel]
forall a b. (a -> b) -> a -> b
$ ([SimpleMsg] -> Channel) -> [[SimpleMsg]] -> [Channel]
forall a b. (a -> b) -> [a] -> [b]
map [SimpleMsg] -> Channel
getInstrument [[SimpleMsg]]
seList
>         upm :: UserPatchMap
upm = [InstrumentName] -> UserPatchMap
makeUPM ([InstrumentName] -> UserPatchMap)
-> [InstrumentName] -> UserPatchMap
forall a b. (a -> b) -> a -> b
$ (Channel -> InstrumentName) -> [Channel] -> [InstrumentName]
forall a b. (a -> b) -> [a] -> [b]
map Channel -> InstrumentName
forall a. Enum a => Channel -> a
toEnum [Channel]
iNums
>     in  ((Pitch, Channel) -> Note1) -> Music (Pitch, Channel) -> Music1
forall a b. (a -> b) -> Music a -> Music b
mMap (\(Pitch
p,Channel
v) -> (Pitch
p, [Channel -> NoteAttribute
Volume Channel
v])) (Music (Pitch, Channel) -> Music1)
-> Music (Pitch, Channel) -> Music1
forall a b. (a -> b) -> a -> b
$ [[SimpleMsg]] -> Music (Pitch, Channel)
eventsToMusic [[SimpleMsg]]
seList


This function is to correct for the fact that channel 10 is
traditionally reserved for percussion. If there is no percussion,
then channel 10 must remain empty. Channels are indexed from zero 
in this representation, so channel 1 is 0, channel 10 is 9, etc.

> makeUPM :: [InstrumentName] -> UserPatchMap
> makeUPM :: [InstrumentName] -> UserPatchMap
makeUPM [InstrumentName]
is = 
>     case (InstrumentName -> Bool) -> [InstrumentName] -> Maybe Channel
forall a. (a -> Bool) -> [a] -> Maybe Channel
findIndex (InstrumentName -> InstrumentName -> Bool
forall a. Eq a => a -> a -> Bool
==InstrumentName
Percussion) [InstrumentName]
is of 
>         Maybe Channel
Nothing -> [InstrumentName] -> [Channel] -> UserPatchMap
forall a b. [a] -> [b] -> [(a, b)]
zip [InstrumentName]
is ([Channel
0..Channel
8][Channel] -> [Channel] -> [Channel]
forall a. [a] -> [a] -> [a]
++[Channel
10..]) -- no percussion

>         Just Channel
i -> ([InstrumentName]
is [InstrumentName] -> Channel -> InstrumentName
forall a. HasCallStack => [a] -> Channel -> a
!! Channel
i, Channel
9) (InstrumentName, Channel) -> UserPatchMap -> UserPatchMap
forall a. a -> [a] -> [a]
: 
>                   [InstrumentName] -> [Channel] -> UserPatchMap
forall a b. [a] -> [b] -> [(a, b)]
zip (Channel -> [InstrumentName] -> [InstrumentName]
forall a. Channel -> [a] -> [a]
take Channel
i [InstrumentName]
is [InstrumentName] -> [InstrumentName] -> [InstrumentName]
forall a. [a] -> [a] -> [a]
++ Channel -> [InstrumentName] -> [InstrumentName]
forall a. Channel -> [a] -> [a]
drop (Channel
iChannel -> Channel -> Channel
forall a. Num a => a -> a -> a
+Channel
1) [InstrumentName]
is) ([Channel
0..Channel
8][Channel] -> [Channel] -> [Channel]
forall a. [a] -> [a] -> [a]
++[Channel
10..])