> 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
/= :: NEvent -> NEvent -> Bool
$c/= :: NEvent -> NEvent -> Bool
== :: NEvent -> NEvent -> Bool
$c== :: NEvent -> NEvent -> Bool
Eq, Int -> NEvent -> ShowS
[NEvent] -> ShowS
NEvent -> String
(Int -> NEvent -> ShowS)
-> (NEvent -> String) -> ([NEvent] -> ShowS) -> Show NEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NEvent] -> ShowS
$cshowList :: [NEvent] -> ShowS
show :: NEvent -> String
$cshow :: NEvent -> String
showsPrec :: Int -> NEvent -> ShowS
$cshowsPrec :: Int -> 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
min :: NEvent -> NEvent -> NEvent
$cmin :: NEvent -> NEvent -> NEvent
max :: NEvent -> NEvent -> NEvent
$cmax :: NEvent -> NEvent -> NEvent
>= :: NEvent -> NEvent -> Bool
$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
compare :: NEvent -> NEvent -> Ordering
$ccompare :: NEvent -> NEvent -> Ordering
$cp1Ord :: Eq 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
/= :: SimpleMsg -> SimpleMsg -> Bool
$c/= :: SimpleMsg -> SimpleMsg -> Bool
== :: SimpleMsg -> SimpleMsg -> Bool
$c== :: SimpleMsg -> SimpleMsg -> Bool
Eq, Int -> SimpleMsg -> ShowS
[SimpleMsg] -> ShowS
SimpleMsg -> String
(Int -> SimpleMsg -> ShowS)
-> (SimpleMsg -> String)
-> ([SimpleMsg] -> ShowS)
-> Show SimpleMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleMsg] -> ShowS
$cshowList :: [SimpleMsg] -> ShowS
show :: SimpleMsg -> String
$cshow :: SimpleMsg -> String
showsPrec :: Int -> SimpleMsg -> ShowS
$cshowsPrec :: Int -> SimpleMsg -> ShowS
Show)
> instance Ord (SimpleMsg) where
>     compare :: SimpleMsg -> SimpleMsg -> Ordering
compare (SE(Rational
t,Int
p,Int
v,Int
i,NEvent
e)) (SE(Rational
t',Int
p',Int
v',Int
i',NEvent
e')) = 
>         if Rational
tRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<Rational
t' then Ordering
LT else if Rational
tRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
t' then Ordering
GT else Ordering
EQ
>     compare (T(Rational
t,Rational
x)) (SE(Rational
t',Int
p',Int
v',Int
i',NEvent
e')) = 
>         if Rational
tRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<Rational
t' then Ordering
LT else if Rational
tRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
t' then Ordering
GT else Ordering
EQ
>     compare (SE(Rational
t,Int
p,Int
v,Int
i,NEvent
e)) (T(Rational
t',Rational
x)) = 
>         if Rational
tRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<Rational
t' then Ordering
LT else if Rational
tRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
t' then Ordering
GT else Ordering
EQ
>     compare (T(Rational
t,Rational
x)) (T(Rational
t',Rational
x')) =
>         if Rational
tRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<Rational
t' then Ordering
LT else if Rational
tRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
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 :: Int -> [(Int, a)] -> [(Int, a)]
addTrackTicks Int
sum [] = []
> addTrackTicks Int
sum ((Int
t,a
x):[(Int, a)]
ts) = (Int
tInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sum,a
x) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: Int -> [(Int, a)] -> [(Int, a)]
forall a. Int -> [(Int, a)] -> [(Int, a)]
addTrackTicks (Int
tInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sum) [(Int, 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(Rational
t,Rational
i) -> (Rational, Rational) -> SimpleMsg
T(TimeDiv -> Rational -> Rational
forall a. Fractional a => TimeDiv -> a -> a
fixT TimeDiv
tdw Rational
t, Rational
i) 
>               SE(Rational
t,Int
p,Int
v,Int
i,NEvent
e) -> (Rational, Int, Int, Int, NEvent) -> SimpleMsg
SE(TimeDiv -> Rational -> Rational
forall a. Fractional a => TimeDiv -> a -> a
fixT TimeDiv
tdw Rational
t, Int
p, Int
v, Int
i, NEvent
e) where

> fixT :: TimeDiv -> a -> a
fixT TimeDiv
tdw a
t = 
>     case TimeDiv
tdw of TicksPerBeat Int
td -> a
t a -> a -> a
forall a. Fractional a => a -> a -> a
/ (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
td a -> a -> a
forall a. Num a => a -> a -> a
* a
4)
>                 TicksPerSecond Int
fps Int
tpf -> a
t a -> a -> a
forall a. Fractional a => a -> a -> a
/ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
fps Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
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 = ([(Int, Message)] -> [SimpleMsg])
-> [[(Int, Message)]] -> [[SimpleMsg]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [(Int, Message)] -> [SimpleMsg]
simplifyTrack Int
0) ([[(Int, Message)]] -> [[SimpleMsg]])
-> [[(Int, Message)]] -> [[SimpleMsg]]
forall a b. (a -> b) -> a -> b
$ ([(Int, Message)] -> [(Int, Message)])
-> [[(Int, Message)]] -> [[(Int, Message)]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [(Int, Message)] -> [(Int, Message)]
forall a. Int -> [(Int, a)] -> [(Int, a)]
addTrackTicks Int
0) (Midi -> [[(Int, 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 :: Int -> [(Int, Message)] -> [SimpleMsg]
simplifyTrack Int
icur [] = []
>   simplifyTrack Int
icur ((Int
t,Message
m):[(Int, Message)]
ts) = 
>     case Message
m of (NoteOn Int
c Int
p Int
v) -> 
>                   (Rational, Int, Int, Int, NEvent) -> SimpleMsg
SE (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
t, Int
p, Int
v, Int
icur, NEvent
On) SimpleMsg -> [SimpleMsg] -> [SimpleMsg]
forall a. a -> [a] -> [a]
: Int -> [(Int, Message)] -> [SimpleMsg]
simplifyTrack Int
icur [(Int, Message)]
ts
>               (NoteOff Int
c Int
p Int
v) -> 
>                   (Rational, Int, Int, Int, NEvent) -> SimpleMsg
SE (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
t, Int
p, Int
v, Int
icur, NEvent
Off) SimpleMsg -> [SimpleMsg] -> [SimpleMsg]
forall a. a -> [a] -> [a]
: Int -> [(Int, Message)] -> [SimpleMsg]
simplifyTrack Int
icur [(Int, Message)]
ts
>               (ProgramChange Int
c Int
p) -> Int -> [(Int, Message)] -> [SimpleMsg]
simplifyTrack (if Int
cInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
9 then (-Int
1) else Int
p) [(Int, Message)]
ts 
>               (TempoChange Int
x) -> (Rational, Rational) -> SimpleMsg
T (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
t, Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) SimpleMsg -> [SimpleMsg] -> [SimpleMsg]
forall a. a -> [a] -> [a]
: Int -> [(Int, Message)] -> [SimpleMsg]
simplifyTrack Int
icur [(Int, Message)]
ts
>               Message
_ -> Int -> [(Int, Message)] -> [SimpleMsg]
simplifyTrack Int
icur [(Int, 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]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[SimpleMsg]]
tracks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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. [a] -> a
head [[SimpleMsg]]
tracks [SimpleMsg] -> [SimpleMsg] -> [SimpleMsg]
forall a. [a] -> [a] -> [a]
++)) ([[SimpleMsg]] -> [[SimpleMsg]]
forall a. [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, Int)
eventsToMusic [[SimpleMsg]]
tracks = 
>     let tracks' :: [[SimpleMsg]]
tracks' = [[SimpleMsg]] -> [[SimpleMsg]]
splitByInstruments [[SimpleMsg]]
tracks -- handle any mid-track program changes

>         is :: [InstrumentName]
is = (Int -> InstrumentName) -> [Int] -> [InstrumentName]
forall a b. (a -> b) -> [a] -> [b]
map Int -> InstrumentName
toInstr ([Int] -> [InstrumentName]) -> [Int] -> [InstrumentName]
forall a b. (a -> b) -> a -> b
$ ([SimpleMsg] -> Int) -> [[SimpleMsg]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [SimpleMsg] -> Int
getInstrument ([[SimpleMsg]] -> [Int]) -> [[SimpleMsg]] -> [Int]
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 (t :: * -> *) a. Foldable t => t a -> Bool
null) [[SimpleMsg]]
tracks' -- instruments

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

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

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

>         n :: Music (Pitch, Int)
n = (Rational -> Music (Pitch, Int)
forall a. Rational -> Music a
rest Rational
t Music (Pitch, Int) -> Music (Pitch, Int) -> Music (Pitch, Int)
forall a. Music a -> Music a -> Music a
:+: Rational -> (Pitch, Int) -> Music (Pitch, Int)
forall a. Rational -> a -> Music a
note (Rational
t1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
t) (Int -> Pitch
pitch Int
p,Int
v)) -- create a Music note

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

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

>              else Rational -> [SimpleMsg] -> Music (Pitch, Int)
seToMusic Rational
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 Rational -> [SimpleMsg] -> Music (Pitch, Int)
seToMusic Rational
tCurr [SimpleMsg]
es
>   seToMusic Rational
tCurr (e1 :: SimpleMsg
e1@(T (Rational
t,Rational
newTempo)):[SimpleMsg]
es) = 
>     let t2 :: Rational
t2 = SimpleMsg -> Rational
getTime (SimpleMsg -> Rational) -> SimpleMsg -> Rational
forall a b. (a -> b) -> a -> b
$ [SimpleMsg] -> SimpleMsg
forall a. [a] -> a
head [SimpleMsg]
es -- find time of next event after tempo change

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

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

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



Finding the time of an event.

> getTime :: SimpleMsg -> Rational
getTime (SE(Rational
t,Int
p,Int
v,Int
i,NEvent
e)) = Rational
t
> getTime (T (Rational
t,Rational
x)) = Rational
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] -> Int
getInstrument ((SE(Rational
t,Int
p,Int
v,Int
i,NEvent
e)):[SimpleMsg]
xs) = Int
i
> getInstrument ((T (Rational, Rational)
x) : [SimpleMsg]
xs) = [SimpleMsg] -> Int
getInstrument [SimpleMsg]
xs
> getInstrument [] = -Int
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 :: Int
i = [SimpleMsg] -> Int
getInstrument [SimpleMsg]
t
>         ([SimpleMsg]
t',[SimpleMsg]
t'') = Int -> [SimpleMsg] -> ([SimpleMsg], [SimpleMsg])
splitByI Int
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 (Rational, Int, Int, Int, NEvent)
xs) = Bool
True
> isSE (T (Rational, Rational)
i) = Bool
False


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

> splitByI :: Int -> [SimpleMsg] -> ([SimpleMsg],[SimpleMsg])
> splitByI :: Int -> [SimpleMsg] -> ([SimpleMsg], [SimpleMsg])
splitByI Int
i0 [] = ([],[])
> splitByI Int
i0 (SimpleMsg
x:[SimpleMsg]
xs) = 
>     let ([SimpleMsg]
ts,[SimpleMsg]
fs) = Int -> [SimpleMsg] -> ([SimpleMsg], [SimpleMsg])
splitByI Int
i0 [SimpleMsg]
xs
>         f :: SimpleMsg -> Bool
f (SE(Rational
_,Int
_,Int
_,Int
i1,NEvent
_)) = Int
i0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i1
>         f SimpleMsg
_ = Bool
False
>     in  case SimpleMsg
x of SE (Rational, Int, Int, Int, 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 (Rational, Rational)
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(Rational
t,Int
p,Int
v,Int
ins,NEvent
e)) [] = (Rational, Int, Int, Int, NEvent) -> SimpleMsg
SE(Rational
t,Int
p,Int
v,Int
ins,NEvent
Off)
> correctOff (SE(Rational
t,Int
p,Int
v,Int
ins,NEvent
e)) [SimpleMsg]
es = 
>     let SE(Rational
t1,Int
p1,Int
v1,Int
ins1,NEvent
e1) = [SimpleMsg] -> SimpleMsg
forall a. [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  (Rational, Int, Int, Int, NEvent) -> SimpleMsg
SE(Rational
t1,Int
p,Int
v,Int
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 :: [Int]
iNums = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ ([SimpleMsg] -> Int) -> [[SimpleMsg]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [SimpleMsg] -> Int
getInstrument [[SimpleMsg]]
seList
>         upm :: UserPatchMap
upm = [InstrumentName] -> UserPatchMap
makeUPM ([InstrumentName] -> UserPatchMap)
-> [InstrumentName] -> UserPatchMap
forall a b. (a -> b) -> a -> b
$ (Int -> InstrumentName) -> [Int] -> [InstrumentName]
forall a b. (a -> b) -> [a] -> [b]
map Int -> InstrumentName
forall a. Enum a => Int -> a
toEnum [Int]
iNums
>     in  ((Pitch, Int) -> (Pitch, [NoteAttribute]))
-> Music (Pitch, Int) -> Music1
forall a b. (a -> b) -> Music a -> Music b
mMap (\(Pitch
p,Int
v) -> (Pitch
p, [Int -> NoteAttribute
Volume Int
v])) (Music (Pitch, Int) -> Music1) -> Music (Pitch, Int) -> Music1
forall a b. (a -> b) -> a -> b
$ [[SimpleMsg]] -> Music (Pitch, Int)
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 Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (InstrumentName -> InstrumentName -> Bool
forall a. Eq a => a -> a -> Bool
==InstrumentName
Percussion) [InstrumentName]
is of 
>         Maybe Int
Nothing -> [InstrumentName] -> [Int] -> UserPatchMap
forall a b. [a] -> [b] -> [(a, b)]
zip [InstrumentName]
is ([Int
0..Int
8][Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++[Int
10..]) -- no percussion

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