\subsubsection{Reading Midi files} \seclabel{Haskore.Interface.MIDI.Read} Now that we have translated a raw Midi file into a \code{MidiFile.T} data type, we can translate that \code{MidiFile.T} into a \code{MidiMusic.T} object. \begin{haskelllisting} 
> module Haskore.Interface.MIDI.Read (toRhyMusic, toGMMusic,
>  {- debugging -} retrieveTracks)
>   where
>
> import qualified Haskore.Interface.MIDI.Note          as MidiNote
> import qualified Haskore.Interface.MIDI.InstrumentMap as InstrMap
> import           Sound.MIDI.File                  as MidiFile
> import qualified Sound.MIDI.File.Event            as MidiFileEvent
> import qualified Sound.MIDI.File.Event.Meta       as MetaEvent
> import qualified Sound.MIDI.Message.Channel       as ChannelMsg
> import qualified Sound.MIDI.Message.Channel.Voice as Voice
> import qualified Sound.MIDI.General               as GeneralMidi
> import Sound.MIDI.File.Event (T(MIDIEvent, MetaEvent), ElapsedTime, )
> import Sound.MIDI.File.Event.Meta (T(SetTempo), ElapsedTime, Tempo, defltST, defltDurT, )
> import Sound.MIDI.Message.Channel (Body(Voice), Channel, )
> import Sound.MIDI.Message.Channel.Voice (Program, )
>
> import Haskore.Basic.Duration ((%+))
> import qualified Data.EventList.Relative.TimeBody  as TimeList
> import qualified Data.EventList.Relative.MixedBody as TimeList
> import qualified Haskore.Music             as Music
> import qualified Haskore.Music.GeneralMIDI as MidiMusic
> import qualified Haskore.Music.Rhythmic    as RhyMusic
> import qualified Haskore.Performance.Context  as Context
> import qualified Haskore.Performance.BackEnd  as PfBE
> import qualified Haskore.Performance.Default  as DefltPf
> import qualified Haskore.Process.Optimization as Optimization

> import qualified Numeric.NonNegative.Class as NonNeg

> import Haskore.Music
>              (line, chord, changeTempo, Dur, DurRatio)
> import Data.Tuple.HT (mapPair, mapSnd, )
> import qualified Data.List.HT as ListHT
>
> import Haskore.General.Map (Map)
> import qualified Haskore.General.Map as Map
> import Data.Maybe (mapMaybe, fromMaybe)
\end{haskelllisting} The main function. Note that we need drum and instrument maps in order to restore a \code{Context.T} as well as a \code{RhyMusic.T} object. \begin{haskelllisting} 
> toRhyMusic ::
>    (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
>    InstrMap.ChannelProgramPitchTable drum ->
>    InstrMap.ChannelProgramTable instr ->
>    MidiFile.T ->
>       (Context.T time dyn (RhyMusic.Note drum instr), RhyMusic.T drum instr)
> toRhyMusic dMap iMap mf@(MidiFile.Cons _ d trks) =
>   let cpm = makeCPM trks
>       m   = Music.mapNote
>                (MidiNote.toRhyNote
>                   (InstrMap.reverseLookupMaybe dMap)
>                   (InstrMap.reverseLookupMaybe iMap))
>                (format (readFullTrack d cpm) (MidiFile.explicitNoteOff mf))
>   in (context, m)

> toGMMusic ::
>    (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
>    MidiFile.T -> (InstrMap.ChannelTable MidiMusic.Instr,
>                   Context.T time dyn MidiMusic.Note, MidiMusic.T)
> toGMMusic mf@(MidiFile.Cons _ d trks) =
>   let cpm     = makeCPM trks
>       upm     = map (\(ch, progNum) ->
>                       (GeneralMidi.instrumentFromProgram progNum, ch))
>                     (Map.toList cpm)
>       m       = Music.mapNote MidiNote.toGMNote
>                    (format (readFullTrack d cpm)
>                            (MidiFile.explicitNoteOff mf))
>   in (upm, context, m)

> context ::
>    (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
>    Context.T time dyn note
> context =
>    Context.setPlayer DefltPf.player $
>    Context.setDur 1 $
>    DefltPf.context

> retrieveTracks :: MidiFile.T -> [[MidiMusic.T]]
> retrieveTracks (MidiFile.Cons _ d trks) =
>   let cpm = makeCPM trks
>   in  map (map (Music.mapNote MidiNote.toGMNote
>                  . readTrack (tDiv d) cpm . fst)
>              . prepareTrack) trks

> type ChannelProgramMap = Map ChannelMsg.Channel Voice.Program

> readFullTrack ::
>    Division -> ChannelProgramMap -> Track -> Music.T MidiNote.T
> readFullTrack dv cpm =
>   let readTempoTrack (t,r) =
>           changeTempo r (readTrack (tDiv dv) cpm t)
>   in  Optimization.all . line . map readTempoTrack . prepareTrack

> prepareTrack :: Track -> [(RichTrack, DurRatio)]
> prepareTrack =
>    map (extractTempo defltST) . segmentBeforeSetTempo .
>    mergeNotes defltST . moveTempoToHead
\end{haskelllisting} Make one big music out of the individual tracks of a MidiFile, using different composition types depending on the format of the MidiFile. \begin{haskelllisting} 
> format :: (Track -> Music.T note) -> MidiFile.T -> Music.T note
> format tm (MidiFile.Cons typ _ trks) =
>    let trks' = map tm trks
>    in  case typ of
>           MidiFile.Mixed ->
>              case trks' of
>                 [trk] -> trk
>                 _ -> error ("toRhyMusic: Only one track allowed for MIDI file type 0.")
>           MidiFile.Parallel -> chord trks'
>           MidiFile.Serial   -> line  trks'
\end{haskelllisting} Look for Program Changes in the given tracks, in order to make a \code{ChannelProgramMap}. \begin{haskelllisting} 
> makeCPM :: [Track] -> ChannelProgramMap
> makeCPM =
>    Map.fromList . concatMap (mapMaybe getPC . TimeList.getBodies)
>
> getPC :: MidiFileEvent.T -> Maybe (Channel, Program)
> getPC ev =
>    do (ch, Voice.ProgramChange num) <- MidiFileEvent.maybeVoice ev
>       Just (ch, num)
\end{haskelllisting} Translate \code{Divisions} into the number of ticks per quarter note. \begin{haskelllisting} 
> tDiv :: Division -> Tempo
> tDiv (Ticks x) = x
> tDiv (SMPTE _ _) = error "Sorry, SMPTE not yet implemented."
\end{haskelllisting} \code{moveTempoToHead} gets the information that occurs at the beginning of the piece: the default tempo and the default key signature. A \code{SetTempo} in the middle of the piece should translate to a tempo change (\code{Tempo r m}), but a \code{SetTempo} at time 0 should set the default tempo for the entire piece, by translating to \code{Context.T} tempo. It remains a matter of taste which tempo of several parallel tracks to use for the whole music. \code{moveTempoToHead} takes care of all events that occur at time 0 so that if any \code{SetTempo} appears at time 0, it is moved to the front of the list, so that it can be easily retrieved from the result of \code{segmentBeforeSetTempo}. \begin{haskelllisting} 
> moveTempoToHead :: Track -> Track
> moveTempoToHead es =
>    let (tempo, track) = getHeadTempo es
>    in  TimeList.cons 0 (MetaEvent (SetTempo tempo)) track

> getHeadTempo :: Track -> (Tempo, Track)
> getHeadTempo es =
>    maybe
>       (defltST, es)
>       (\ ~(me,rest) ->
>           case me of
>              MetaEvent (SetTempo tempo) -> (tempo, rest)
>              _ -> mapSnd (TimeList.cons 0 me) (getHeadTempo rest))
>       (do ((0,me),rest) <- TimeList.viewL es
>           return (me,rest))
\end{haskelllisting} Manages the tempo changes in the piece. It translates each MidiFile \code{SetTempo} into a ratio between the new tempo and the tempo at the beginning. \begin{haskelllisting} 
> extractTempo :: Tempo -> RichTrack -> (RichTrack, DurRatio)
> extractTempo d trk =
>    fromMaybe
>       (trk, 1)
>       (do ((_, Event (MetaEvent (SetTempo tempo))), rest) <- TimeList.viewL trk
>           return (rest, toInteger d %+ toInteger tempo))
\end{haskelllisting} \code{segmentBefore} is used to split a track into sub-tracks by tempo. We do not want to add this function to the \code{event-list} package, because the precise type would be \type{AlternatingList.Disparate (TimeList.T time body) (TimeList.Event time body)} and that's inconvenient for our application. \begin{haskelllisting} 
> segmentBefore ::
>    (body -> Bool) -> TimeList.T time body -> [TimeList.T time body]
> segmentBefore p =
>    map TimeList.fromPairList .
>    ListHT.segmentBefore (p . snd) .
>    TimeList.toPairList
\end{haskelllisting} \begin{haskelllisting} 
> isSetTempo :: RichEvent -> Bool
> isSetTempo (Event (MetaEvent (SetTempo _))) = True
> isSetTempo _                                = False

> segmentBeforeSetTempo :: RichTrack -> [RichTrack]
> segmentBeforeSetTempo = segmentBefore isSetTempo
\end{haskelllisting} \code{readTrack} is the heart of the \code{toRhyMusic} operation. It reads a track that has been processed by \code{mergeNotes}, and returns the track as \code{StdMusic.T}. A \code{RichEvent} consists either of a normal \code{MIDIEvent} or of a note, which in contrast to normal \code{MIDIEvent}s contains the information of corresponding \code{NoteOn} and \code{NoteOff} events. \begin{haskelllisting} 
> type RichTrack = TimeList.T ElapsedTime RichEvent
> data RichEvent =
>      Event MidiFileEvent.T
>    | Note  ElapsedTime MidiNote.T

> readTrack :: Tempo -> ChannelProgramMap ->
>    RichTrack -> Music.T MidiNote.T
> readTrack ticks cpm =
>    PfBE.toMusic . trackTimeToStd ticks
>     . richTrackToBE . applyProgChanges cpm
\end{haskelllisting} Take the division in ticks and a duration value and converts that to a common note duration (such as quarter note, eighth note, etc.). \begin{haskelllisting} 
> fromTicks :: Tempo -> ElapsedTime -> Dur
> fromTicks ticks d =
>    toInteger d %+ (toInteger ticks * toInteger defltDurT)
d %+ (fromIntegral ticks * defltDurT)) 
> trackTimeToStd :: Tempo ->
>    PfBE.T ElapsedTime note -> PfBE.T Dur note
> trackTimeToStd ticks =
>    TimeList.mapBody (\(PfBE.Event d n) -> PfBE.Event (fromTicks ticks d) n)
>       . TimeList.mapTime (fromTicks ticks)
\end{haskelllisting} Look up an instrument name from a \code{ChannelProgramMap} given its channel number. \begin{haskelllisting} 
> lookupChannelProg :: ChannelProgramMap -> Channel -> Program
> lookupChannelProg cpm =
>    Map.findWithDefault cpm
>       (error "Invalid channel in user patch map")
\end{haskelllisting} Implement a \keyword{Program Change}: a change in the \code{ChannelProgramMap} in which a channel changes from one instrument to another. \begin{haskelllisting} 
> progChange :: Channel -> Program -> ChannelProgramMap -> ChannelProgramMap
> progChange = Map.insert
> -- progChange ch num cpm = Map.insert ch num cpm
\end{haskelllisting} Process all \code{ProgramChange} events in a track. That is, manage a patch map and insert in the appropriate program numbers into the \type{MidiNote.T}s. The function works the following way: Split the track into pieces, each beginning with a program change. Compute the patch maps that are active after each program change. Apply these patch maps to the track parts. \begin{haskelllisting} 
> isProgChange :: RichEvent -> Bool
> isProgChange (Event ev) =
>    maybe False (const True) (getPC ev)
> isProgChange _ = False

> applyProgChanges :: ChannelProgramMap -> RichTrack -> RichTrack
> applyProgChanges cpm track =
>    let parts@(_:pcParts) = segmentBefore isProgChange track
> {-
>        updateCPM (Event (MIDIEvent ch (ProgramChange prog))) =
>           progChange ch prog
>        updateCPM _  =  error "TimeList.collectCoincident is buggy"
> -}
>        updateCPM =
>           TimeList.switchL
>              (error "TimeList.collectCoincident is buggy")
>              (\ (_, Event ev) _ ->
>                  maybe
>                     (error "after segmentation, each part should start with ProgramChange event")
>                     (uncurry progChange)
>                     (getPC ev))
>        cpms =
>           scanl (flip id) cpm (map updateCPM pcParts)
>        setProg localCPM (Note d n) =
>           Note d (n{MidiNote.program =
>                        lookupChannelProg localCPM (MidiNote.channel n)})
>        setProg _ e = e
>    in  TimeList.concat (zipWith (TimeList.mapBody . setProg) cpms parts)
\end{haskelllisting} Remove meta events from \type{RichTrack}, thus converting to a back-end performance. \begin{haskelllisting} 
> richNoteToBE :: RichEvent -> PfBE.Event ElapsedTime MidiNote.T
> richNoteToBE (Note d n) = PfBE.Event d n
> richNoteToBE _ = error "richNoteToBE: only Note constructor allowed"

> isRichNote :: RichEvent -> Bool
> isRichNote (Note _ _) = True
> isRichNote _          = False

> richTrackToBE :: RichTrack -> PfBE.T ElapsedTime MidiNote.T
> richTrackToBE =
>    TimeList.mapBody richNoteToBE . fst
>       . TimeList.partition isRichNote
\end{haskelllisting} The \code{mergeNotes} function changes the order of the events in a track so that they can be handled by readTrack: each \code{NoteOff} is put directly after its corresponding \code{NoteOn}. Its first and second arguments are the elapsed time and value (in microseconds per quarter note) of the \code{SetTempo} currently in effect. \begin{haskelllisting} 
> mergeNotes :: Tempo -> Track -> RichTrack
> mergeNotes stv =
>    TimeList.mapTimeTail
>       (TimeList.switchBodyL $ \ e rest ->
>            uncurry TimeList.consBody $
>            let deflt = (Event e, mergeNotes stv rest)
>            in  case e of
>                   MetaEvent (SetTempo newStv) ->
>                      (Event e, mergeNotes newStv rest)
>                   MIDIEvent chmsg@(ChannelMsg.Cons _ (Voice msg)) ->
>                      if Voice.isNoteOn msg
>                        then mapPair
>                                (uncurry Note, mergeNotes stv)
>                                (searchNoteOff 0 stv 1 chmsg rest)
>                        else
>                          if Voice.isNoteOff msg
>                            then error "NoteOff before NoteOn"
>                            else deflt
>                   _ -> deflt)
\end{haskelllisting} The function \code{searchNoteOff} takes a track and looks through the list of events to find the \code{NoteOff} corresponding to the given \code{NoteOn}. A \code{NoteOff} corresponds to an earlier \code{NoteOn} if it is the first in the track to have the same channel and pitch. If between \code{NoteOn} and \code{NoteOff} are \code{SetTempo} events, it calculates what the elapsed-time is, expressed in the current tempo. This function takes a ridiculous number of arguments, I know, but I don't think it can do without any of the information. Maybe there is a simpler way. \begin{haskelllisting} 
> searchNoteOff ::
>       Double          {- ^ time interval between NoteOn and now,
>                            in terms of the tempo at the NoteOn -}
>    -> Tempo -> Double {- ^ SetTempo values: the one at the NoteOn and
>                            the ratio between the current tempo and the first one. -}
>    -> ChannelMsg.T    {- ^ channel and pitch of NoteOn (NoteOff must match) -}
>    -> Track           {- ^ the track to be searched -}
>    -> ((ElapsedTime, MidiNote.T), Track)
>                       -- ^ the needed event and the remainder of the track
>
> searchNoteOff int ost str chm0 =
>    TimeList.switchL
>       (error "ReadMidi.searchNoteOff: no corresponding NoteOff")
>       (\(t1, mev1) es ->
>           maybe
>              -- if MIDI events don't match, then recourse
>              (mapSnd (TimeList.cons t1 mev1) $
>               searchNoteOff (addInterval str t1 int) ost
>                  (case mev1 of
>                     -- respect tempo changes
>                     MetaEvent (SetTempo nst) ->
>                          fromIntegral ost / fromIntegral nst
>                     _ -> str)
>                  chm0 es)
>              -- if MIDI events match, construct a MidiNote.T
>              (\note ->
>                 let d = round (addInterval str t1 int)
>                 in  ((d, note), TimeList.delay t1 es))
>              -- check whether NoteOn and NoteOff matches
>              (do chm1 <- MidiFileEvent.maybeMIDIEvent mev1
>                  MidiNote.fromMIDIEvents (chm0, chm1)))

> addInterval :: Double -> ElapsedTime -> Double -> Double
> addInterval str t int = int + fromIntegral t * str
\end{haskelllisting}