{- |
MIDI-File Datatype
Taken from Haskore.
-}moduleSound.MIDI.File(T(..),Division(..),Track,Type(..),empty,ElapsedTime,fromElapsedTime,toElapsedTime,Tempo,fromTempo,toTempo,explicitNoteOff,implicitNoteOff,getTracks,mergeTracks,secondsFromTicks,ticksPerQuarterNote,showLines,changeVelocity,resampleTime,showEvent,showTime,sortEvents,progChangeBeforeSetTempo,)whereimportqualifiedSound.MIDI.Message.Channel.VoiceasVoiceMsgimportqualifiedSound.MIDI.Message.ChannelasChannelMsgimportqualifiedSound.MIDI.File.Event.MetaasMetaEventimportqualifiedSound.MIDI.File.EventasEventimportSound.MIDI.File.Event.Meta(ElapsedTime,fromElapsedTime,toElapsedTime,Tempo,fromTempo,toTempo,)importqualifiedData.EventList.Relative.TimeBodyasEventListimportqualifiedNumeric.NonNegative.WrapperasNonNegWimportqualifiedNumeric.NonNegative.ClassasNonNegimportTest.QuickCheck(Arbitrary(arbitrary),)importqualifiedTest.QuickCheckasQCimportqualifiedControl.Monad.Trans.StateasMSimportControl.Monad(liftM,liftM2,)-- import Sound.MIDI.IO(ByteList)importSound.MIDI.String(rightS,)importData.Ratio((%))importData.Ix(Ix)importData.List(groupBy,sort)importData.Maybe(fromMaybe){- |
The datatypes for MIDI Files and MIDI Events
-}dataT=ConsTypeDivision[Track]deriving(Show,Eq)dataType=Mixed|Parallel|Serialderiving(Show,Eq,Ord,Ix,Enum,Bounded)dataDivision=TicksTempo|SMPTEIntIntderiving(Show,Eq)typeTrack=EventList.TElapsedTimeEvent.T{- |
An empty MIDI file.
Tempo is set to one tick per quarter note.
-}empty::Tempty=ConsMixed(Ticks1)[EventList.empty]instanceArbitraryTwherearbitrary=do(typ,content)<-QC.oneof$fmap(\track->(Mixed,[track]))arbitrary:fmap(\tracks->(Parallel,tracks))arbitrary:fmap(\tracks->(Serial,tracks))arbitrary:[]division<-arbitraryreturn(Constypdivisioncontent)instanceArbitraryDivisionwherearbitrary=QC.oneof$liftM(Ticks.(1+))arbitrary:liftM2(\xy->SMPTE(1+absx)(1+absy))arbitraryarbitrary:[]{- * Processing -}{- |
Apply a function to each track.
-}mapTrack::(Track->Track)->T->TmapTrackf(ConsmfTypedivisiontracks)=ConsmfTypedivision(mapftracks){- |
Convert all @NoteOn p 0@ to @NoteOff p 64@.
The latter one is easier to process.
-}explicitNoteOff::T->TexplicitNoteOff=mapTrack(EventList.mapBody(Event.mapVoiceVoiceMsg.explicitNoteOff)){- |
Convert all @NoteOff p 64@ to @NoteOn p 0@.
The latter one can be encoded more efficiently using the running status.
-}implicitNoteOff::T->TimplicitNoteOff=mapTrack(EventList.mapBody(Event.mapVoiceVoiceMsg.implicitNoteOff))getTracks::T->[Track]getTracks(Cons__trks)=trks{- |
Merge all tracks into a single track
according to the MIDI file type.
-}mergeTracks::(NonNeg.Ctime)=>Type->[EventList.Ttimeevent]->EventList.TtimeeventmergeTrackstyptracks=casetypofMixed->foldr(EventList.mergeBy(\__->True))EventList.emptytracksParallel->foldr(EventList.mergeBy(\__->True))EventList.emptytracksSerial->EventList.concattracks{- |
Process and remove all @SetTempo@ events.
The result is an event list where the times are measured in seconds.
-}secondsFromTicks::Division->EventList.TElapsedTimeEvent.T->EventList.TNonNegW.RationalEvent.TsecondsFromTicksdivision=EventList.catMaybes.flipMS.evalStateMetaEvent.defltST.EventList.mapM(\ticks->domicrosPerQN<-MS.get-- cf. Standard MIDI Files 1.0, page 14return$NonNegW.fromNumberMsg"MIDI.File.processTempo"$fromElapsedTimeticks*fromIntegral(NonNegW.toNumbermicrosPerQN)%(1000000*fromIntegral(NonNegW.toNumber(ticksPerQuarterNotedivision))))(\ev->caseevofEvent.MetaEvent(MetaEvent.SetTempomicrosPerQN)->MS.putmicrosPerQN>>returnNothing_->return$Justev)ticksPerQuarterNote::Division->TempoticksPerQuarterNotedivision=casedivisionofTicksticksPerQN->ticksPerQNSMPTEframesPerSecondticksPerFrames->{-
I am uncertain, whether this is correct.
The "Standard MIDI File 1.0" is unprecise
with respect to the question,
whether SetTempo is relevant also in SMPTE mode.
TiMidity-2.13.2 interprets this kind of division as we do
and qualifies it as "totally untested".
-}NonNegW.fromNumberMsg"MIDI.File.ticksPerQuarterNote"$framesPerSecond*ticksPerFrames{- * Debugging -}{-# DEPRECATED
showLines, changeVelocity, resampleTime,
showEvent, showTime,
sortEvents, progChangeBeforeSetTempo
"only use this for debugging" #-}{- |
Show the 'T' with one event per line,
suited for comparing MIDIFiles with @diff@.
Can this be replaced by 'Sound.MIDI.Load.showFile'?
-}showLines::T->StringshowLines(ConsmfTypedivisiontracks)=letshowTracktrack=unlines(" (":map(\event->" "++showevent++" :")(EventList.toPairListtrack)++" []) :":[])in"MIDIFile.Cons "++showmfType++" ("++showdivision++") (\n"++concatMapshowTracktracks++" [])"showTime::ElapsedTime->ShowSshowTimet=rightS10(showst).showString" : "showEvent::Event.T->ShowSshowEvent(Event.MIDIEvente)=showString"Event.MIDIEvent ".showseshowEvent(Event.MetaEvente)=showString"Event.MetaEvent ".showseshowEvent(Event.SystemExclusives)=showString"SystemExclusive ".showss{- |
A hack that changes the velocities by a rational factor.
-}changeVelocity::Double->T->TchangeVelocityr=letmultVelvel=VoiceMsg.toVelocity$round(r*fromIntegral(VoiceMsg.fromVelocityvel))procVoice(VoiceMsg.NoteOnpitchvel)=VoiceMsg.NoteOnpitch(multVelvel)procVoice(VoiceMsg.NoteOffpitchvel)=VoiceMsg.NoteOffpitch(multVelvel)procVoiceme=meinmapTrack(EventList.mapBody(Event.mapVoiceprocVoice)){- |
Change the time base.
-}resampleTime::Double->T->TresampleTimer=letdivTimetime=round(fromIntegraltime/r)newTempotmp=round(fromIntegraltmp*r)procEventev=caseevofEvent.MetaEvent(MetaEvent.SetTempotmp)->Event.MetaEvent(MetaEvent.SetTempo(newTempotmp))_->evinmapTrack(EventList.mapBodyprocEvent.EventList.mapTimedivTime){- |
Sort MIDI note events lexicographically.
This is to make MIDI files unique
and robust against changes in the computation.
In principle Performance.merge should handle this
but due to rounding errors in Float
the order of note events still depends on some internal issues.
The sample rate of MIDI events should be coarse enough
to assert unique results.
-}sortEvents::T->TsortEvents=letcoincideNoteev0ev1=fromMaybeFalse$do(_,x0)<-Event.maybeVoiceev0(_,x1)<-Event.maybeVoiceev1return(VoiceMsg.isNotex0&&VoiceMsg.isNotex1){-
coincideNote
(Event.MIDIEvent (ChannelMsg.Cons _ (ChannelMsg.Voice x0)))
(Event.MIDIEvent (ChannelMsg.Cons _ (ChannelMsg.Voice x1))) =
VoiceMsg.isNote x0 && VoiceMsg.isNote x1
coincideNote _ _ = False
-}sortTrack=EventList.flatten.EventList.mapBodysort.EventList.mapCoincident(groupBycoincideNote)inmapTracksortTrack{- |
Old versions of "Haskore.Interface.MIDI.Write"
wrote 'MIDIEvent.ProgramChange' and 'MetaEvent.SetTempo'
once at the beginning of a file in that order.
The current version supports multiple 'MIDIEvent.ProgramChange's in a track and
thus a 'MIDIEvent.ProgramChange' is set immediately before a note.
Because of this a 'MIDIEvent.ProgramChange' is now always after a 'MetaEvent.SetTempo'.
For checking equivalence with old MIDI files we can switch this back.
-}progChangeBeforeSetTempo::T->TprogChangeBeforeSetTempo=letsortTrackevs=do((t0,st@(Event.MetaEvent(MetaEvent.SetTempo_))),rest0)<-EventList.viewLevs((t1,pc@(Event.MIDIEvent(ChannelMsg.Cons_(ChannelMsg.Voice(VoiceMsg.ProgramChange_))))),rest1)<-EventList.viewLrest0return$EventList.const0pc$EventList.cons0st$EventList.delayt1rest1inmapTrack(\track->fromMaybetrack(sortTracktrack))