module Sound.MIDI.File(
T(..), Division(..), Track, Type(..),
SchedEvent, Event(..), ElapsedTime,
Tempo, SMPTEHours, SMPTEMins, SMPTESecs, SMPTEFrames, SMPTEBits,
MetaEvent(..),
maybeMIDIEvent, maybeMetaEvent,
Key(..), Mode(..),
defltST, defltDurT, empty,
showLines, changeVelocity, getTracks, resampleTime,
showEvent, showTime,
sortEvents, progChangeBeforeSetTempo,
) where
import qualified Sound.MIDI.Event as MIDIEvent
import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Numeric.NonNegative.Wrapper as NonNeg
import Sound.MIDI.IO(ByteString)
import Sound.MIDI.String (rightS, concatS)
import Data.Ix(Ix)
import Data.List(groupBy, sort)
import Data.Maybe(fromMaybe)
data T = Cons Type Division [Track] deriving (Show, Eq)
data Type = Mixed | Parallel | Serial
deriving (Show,Eq,Enum)
data Division = Ticks Tempo | SMPTE Int Int
deriving (Show,Eq)
type Track = EventList.T ElapsedTime Event
type SchedEvent = (ElapsedTime, Event)
type ElapsedTime = NonNeg.Integer
data Event =
MIDIEvent MIDIEvent.Channel MIDIEvent.T
| MetaEvent MetaEvent
| SysExStart ByteString
| SysExCont ByteString
deriving (Show,Eq,Ord)
maybeMIDIEvent :: Event -> Maybe (MIDIEvent.Channel, MIDIEvent.T)
maybeMIDIEvent (MIDIEvent ch ev) = Just (ch,ev)
maybeMIDIEvent _ = Nothing
maybeMetaEvent :: Event -> Maybe MetaEvent
maybeMetaEvent (MetaEvent mev) = Just mev
maybeMetaEvent _ = Nothing
type Tempo = NonNeg.Int
type SMPTEHours = Int
type SMPTEMins = Int
type SMPTESecs = Int
type SMPTEFrames = Int
type SMPTEBits = Int
data MetaEvent =
SequenceNum Int
| TextEvent String
| Copyright String
| TrackName String
| InstrName String
| Lyric String
| Marker String
| CuePoint String
| MIDIPrefix MIDIEvent.Channel
| EndOfTrack
| SetTempo Tempo
| SMPTEOffset SMPTEHours SMPTEMins SMPTESecs SMPTEFrames SMPTEBits
| TimeSig Int Int Int Int
| KeySig Key Mode
| SequencerSpecific ByteString
| Unknown Int ByteString
deriving (Show, Eq, Ord)
data Key = KeyCf | KeyGf | KeyDf | KeyAf | KeyEf | KeyBf | KeyF
| KeyC | KeyG | KeyD | KeyA | KeyE | KeyB | KeyFs | KeyCs
deriving (Show, Eq, Ord, Ix, Enum)
data Mode = Major | Minor
deriving (Show, Eq, Ord, Enum)
defltDurT :: ElapsedTime
defltDurT = 2
defltST :: Tempo
defltST = div 1000000 (fromIntegral defltDurT)
empty :: T
empty = Cons Mixed (Ticks 0) [EventList.empty]
showLines :: T -> String
showLines (Cons mfType division tracks) =
let showTrack track =
unlines
(" (" :
map
(\event -> " " ++ show event ++ " :")
(EventList.toPairList track) ++
" []) :" :
[])
in "MIDIFile.Cons " ++ show mfType ++ " (" ++ show division ++ ") (\n" ++
concatMap showTrack tracks ++
" [])"
showTime :: ElapsedTime -> ShowS
showTime t =
rightS 10 (shows t) . showString " : "
showEvent :: Event -> ShowS
showEvent (MIDIEvent ch e) =
showString "MIDIEvent " . shows ch . showString " " . shows e
showEvent (MetaEvent e) =
showString "MetaEvent " . shows e
showEvent (SysExStart s) =
showString "SysExStart " . concatS (map shows s)
showEvent (SysExCont s) =
showString "SysExCont " . concatS (map shows s)
changeVelocity :: Double -> T -> T
changeVelocity r (Cons mfType division tracks) =
let multVel vel = MIDIEvent.toVelocity $
round (r * fromIntegral (MIDIEvent.fromVelocity vel))
procMIDIEvent (MIDIEvent.NoteOn pitch vel) = MIDIEvent.NoteOn pitch (multVel vel)
procMIDIEvent (MIDIEvent.NoteOff pitch vel) = MIDIEvent.NoteOff pitch (multVel vel)
procMIDIEvent me = me
procEvent (MIDIEvent chan ev) = MIDIEvent chan (procMIDIEvent ev)
procEvent ev = ev
in Cons mfType division (map (EventList.mapBody procEvent) tracks)
resampleTime :: Double -> T -> T
resampleTime r (Cons mfType division tracks) =
let divTime time = round (fromIntegral time / r)
newTempo tmp = round (fromIntegral tmp * r)
procEvent ev =
case ev of
MetaEvent (SetTempo tmp) ->
MetaEvent (SetTempo (newTempo tmp))
_ -> ev
in Cons mfType division
(map (EventList.mapBody procEvent . EventList.mapTime divTime) tracks)
getTracks :: T -> [Track]
getTracks (Cons _ _ trks) = trks
sortEvents :: T -> T
sortEvents (Cons mfType division tracks) =
let coincideNote (MIDIEvent _ x0) (MIDIEvent _ x1) =
MIDIEvent.isNote x0 && MIDIEvent.isNote x1
coincideNote _ _ = False
sortTrack =
EventList.flatten . EventList.mapBody sort .
EventList.mapCoincident (groupBy coincideNote)
in Cons mfType division (map sortTrack tracks)
progChangeBeforeSetTempo :: T -> T
progChangeBeforeSetTempo (Cons mfType division tracks) =
let sortTrack evs =
do ((t0,st@(MetaEvent (SetTempo _))), rest0)
<- EventList.viewL evs
((t1,pc@(MIDIEvent _ (MIDIEvent.ProgramChange _))), rest1)
<- EventList.viewL rest0
return $
EventList.cons t0 pc $
EventList.cons 0 st $
EventList.delay t1 rest1
in Cons mfType division
(map (\track -> fromMaybe track (sortTrack track)) tracks)