\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,
> 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.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), )
> import Sound.MIDI.File.Event.Meta (T(SetTempo), defltTempo, )
> 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 2 $
> DefltPf.context
> retrieveTracks :: MidiFile.T -> [[MidiMusic.T]]
> retrieveTracks (MidiFile.Cons _ d trks) =
> let cpm = makeCPM trks
> in map (map (Music.mapNote MidiNote.toGMNote
> . readTrack (MidiFile.ticksPerQuarterNote 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 (MidiFile.ticksPerQuarterNote dv) cpm t)
> in Optimization.all . line . map readTempoTrack . prepareTrack
> prepareTrack :: Track -> [(RichTrack, DurRatio)]
> prepareTrack =
> map (extractTempo defltTempo) . segmentBeforeSetTempo .
> mergeNotes defltTempo . 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}
\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
> (defltTempo, 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 ticksPerQN cpm =
> PfBE.toMusic . trackTimeToStd ticksPerQN
> . richTrackToBE . applyProgChanges cpm
\end{haskelllisting}
Take the division in ticks per quarterNote and
a duration value in number of ticks and
converts that to a common note duration
(such as quarter note, eighth note, etc.).
\begin{haskelllisting}
> fromTicks :: Tempo -> ElapsedTime -> Dur
> fromTicks ticksPerQN d =
> toInteger d %+ (toInteger ticksPerQN * quarter)
> quarter :: Integer
> quarter = 4
> trackTimeToStd :: Tempo ->
> PfBE.T ElapsedTime note -> PfBE.T Dur note
> trackTimeToStd ticksPerQN =
> TimeList.mapBody
> (\(PfBE.Event d n) -> PfBE.Event (fromTicks ticksPerQN d) n)
> . TimeList.mapTime (fromTicks ticksPerQN)
\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
>
\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 =
> 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
> -> Tempo -> Double
> -> ChannelMsg.T
> -> Track
> -> ((ElapsedTime, MidiNote.T), Track)
>
>
> searchNoteOff int ost str chm0 =
> TimeList.switchL
> (error "ReadMidi.searchNoteOff: no corresponding NoteOff")
> (\(t1, mev1) es ->
> maybe
>
> (mapSnd (TimeList.cons t1 mev1) $
> searchNoteOff (addInterval str t1 int) ost
> (case mev1 of
>
> MetaEvent (SetTempo nst) ->
> fromIntegral ost / fromIntegral nst
> _ -> str)
> chm0 es)
>
> (\note ->
> let d = round (addInterval str t1 int)
> in ((d, note), TimeList.delay t1 es))
>
> (do chm1 <- MidiFileEvent.maybeMIDIEvent mev1
> MidiNote.fromMIDIEvents (chm0, chm1)))
> addInterval :: Double -> ElapsedTime -> Double -> Double
> addInterval str t int = int + fromIntegral t * str
\end{haskelllisting}