\section{Outputting MIDI Files}
\label{output}
The functions in this module allow {\tt MidiFile}s to be made into
Standard MIDI files (*.mid) that can be read and played by music
programs such as Cakewalk.
\begin{verbatim}
> module Haskore.OutputMidi (outputMidiFile, midiFileToString) where
> import Haskore.MidiFile
> import Haskore.IOExtensions (writeBinaryFile)
> import Haskore.Monads (Output, runO, outO)
> import Haskore.Bitops (bSplitAt, someBytes)
> import Data.Ix
\end{verbatim}
{\tt OutputMidiFile} is the main function for writing {\tt MidiFile}
values to an actual file; its first argument is the filename:
\begin{verbatim}
> outputMidiFile :: String -> MidiFile -> IO ()
> outputMidiFile fn mf = writeBinaryFile fn (midiFileToString mf)
\end{verbatim}
\begin{exercise} Take as many examples as you like from the previous
sections, create one or more {\tt UserPatchMaps}, write the examples
to a file, and play them using a conventional Midi player.
\end{exercise}
Appendix \ref{test-functions} defines some functions which should make
the above exercise easier. Appendices \ref{examples}, \ref{chick},
and \ref{self-similar} contain more extensive examples.
Midi files are first converted to a monadic string computation using
the function {\tt outMF}, and then "executed" using
{\tt runM :: MidiWriter a -> String}.
\begin{verbatim}
> midiFileToString :: MidiFile -> String
> midiFileToString = runM . outMF
>
> outMF :: MidiFile -> MidiWriter ()
> outMF (MidiFile mft divisn trks) =
> do
> outChunk "MThd" (do
> out 2 mft
> out 2 (length trks)
> outputDivision divisn)
> outputTracks trks
>
> outputDivision :: Division -> MidiWriter ()
> outputDivision (Ticks nticks) = out 2 nticks
> outputDivision (SMPTE mode nticks) = do
> out 1 (256mode)
> out 1 nticks
>
> outputTracks :: [Track] -> MidiWriter ()
> outputTracks trks = mapM_ outputTrack trks
>
> outputTrack :: Track -> MidiWriter ()
> outputTrack trk = outChunk "MTrk" (mapM_ outputEvent (delta trk))
\end{verbatim}
{\tt delta} converts a track using absolute time to one using delta time, adding
EndOfTrack if not already there.
\begin{verbatim}
> delta :: Track -> Track
> delta [] = []
> delta trk | notEOT (last trk) = trk' ++ [MetaEvent 0 EndOfTrack]
> | otherwise = trk'
> where
> (t,trk') = mscanl delta' 0 trk
> delta' :: Int ->
> MEvent ->
> (Int,
> MEvent)
> delta' t (MidiEvent dt e) = (dt , MidiEvent (dtt) e)
> delta' t (MetaEvent dt e) = (dt , MetaEvent (dtt) e)
> notEOT (MetaEvent _ EndOfTrack) = False
> notEOT _ = True
\end{verbatim}
The following functions encode various {\tt MidiFile} elements into
the raw data of a standard MIDI file.
\begin{verbatim}
> outputEvent :: MEvent -> MidiWriter ()
> outputEvent (MidiEvent dt mevent) = do
> outVar dt
> outputMidiEvent mevent
> outputEvent (MetaEvent dt mevent) = do
> outVar dt
> outputMetaEvent mevent
> outputEvent _ = outStr ""
>
> outputMidiEvent :: MidiEvent -> MidiWriter ()
> outputMidiEvent (NoteOff c p v) = outChan 128 c [p,v]
> outputMidiEvent (NoteOn c p v) = outChan 144 c [p,v]
> outputMidiEvent (PolyAfter c p pr) = outChan 160 c [p,pr]
> outputMidiEvent (Control c cn cv) = outChan 176 c [cn,cv]
> outputMidiEvent (ProgChange c pn) = outChan 192 c [pn]
> outputMidiEvent (MonoAfter c pr) = outChan 208 c [pr]
> outputMidiEvent (PitchBend c pb) = outChan 224 c [lo,hi]
> where (hi,lo) = bSplitAt 8 pb
>
>
> outChan :: Int -> MidiChannel -> [Int] -> MidiWriter ()
> outChan code chan bytes = do
> out 1 (code+chan)
> mapM_ (out 1) bytes
>
>
> outMeta :: Int -> [Int] -> MidiWriter ()
> outMeta code bytes = do
> out 1 255
> out 1 code
> outVar (length bytes)
> outList bytes
>
> outMetaStr :: Int -> String -> MidiWriter ()
> outMetaStr code bytes = do
> out 1 255
> out 1 code
> outVar (length bytes)
> outStr bytes
>
>
>
> outMetaMW :: Int -> MidiWriter a -> MidiWriter a
> outMetaMW code m = do
> out 1 255
> out 1 code
> outVar (mLength m)
> m
>
> outputMetaEvent :: MetaEvent -> MidiWriter ()
> outputMetaEvent (SequenceNum num) = outMetaMW 0 (out 2 num)
> outputMetaEvent (TextEvent s) = outMetaStr 1 s
> outputMetaEvent (Copyright s) = outMetaStr 2 s
> outputMetaEvent (TrackName s) = outMetaStr 3 s
> outputMetaEvent (InstrName s) = outMetaStr 4 s
> outputMetaEvent (Lyric s) = outMetaStr 5 s
> outputMetaEvent (Marker s) = outMetaStr 6 s
> outputMetaEvent (CuePoint s) = outMetaStr 7 s
> outputMetaEvent (MIDIPrefix c) = outMeta 32 [c]
> outputMetaEvent EndOfTrack = outMeta 47 []
>
> outputMetaEvent (SetTempo tp) = outMetaMW 81 (out 3 tp)
> outputMetaEvent (SMPTEOffset hr mn se fr ff)
> = outMeta 84 [hr,mn,se,fr,ff]
> outputMetaEvent (TimeSig n d c b) = outMeta 88 [n,d,c,b]
> outputMetaEvent (KeySig sf mi) = outMeta 89 [convert sf, fromMode mi]
> where k = index (KeyCf,KeyCs) sf 7
> convert sf = if (k >= 0) then k
> else 255+k
> outputMetaEvent (SequencerSpecific codes)
> = outMeta 127 codes
> outputMetaEvent (Unknown s) = outMetaStr 21 s
\end{verbatim}
The midiwriter accumulates a String.
For all the usual reasons, the String is represented by ShowS.
\begin{verbatim}
> type MidiWriter a = Output Char a
>
> out :: Int -> Int -> MidiWriter ()
> outVar :: Int -> MidiWriter ()
> outList :: [Int] -> MidiWriter ()
> outStr :: String -> MidiWriter ()
>
> runM :: MidiWriter a -> String
> runM m = snd (runO m)
>
> mLength :: MidiWriter a -> Int
> mLength m = length (runM m)
>
> out 1 x = outO [toEnum x]
> out a x = mapM_ (out 1) (someBytes a x)
>
> outStr cs = outO cs
>
> outList xs = outStr (map toEnum xs)
\end{verbatim}
Numbers of variable size are represented by sequences of 7-bit blocks
tagged (in the top bit) with a bit indicating:
(1) that more data follows; or
(0) that this is the last block.
\begin{verbatim}
> outVar n = do
> outVarAux leftover
> out 1 data7
> where (leftover, data7) = bSplitAt 7 n
> outVarAux 0 = return ()
> outVarAux x = do
> outVarAux leftover'
> out 1 (128+data7')
> where (leftover',data7') = bSplitAt 7 x
>
> fromMode :: Mode -> Int
> fromMode Major = 0
> fromMode Minor = 1
>
>
>
>
> outChunk :: String -> MidiWriter a -> MidiWriter a
> outChunk tag m | length tag == 4 = do
> outStr tag
> out 4 (mLength m)
> m
\end{verbatim}
Mapping scan (used in function delta):
\begin{verbatim}
x xs
| |
V V
+---+ +----------+
l -> | f | -> m -> | mscanl f | -> r
+---+ +----------+
| |
V V
y ys
> mscanl :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
> mscanl f l [] = (l,[])
> mscanl f l (x:xs) = let (m, y ) = f l x
> (r, ys) = mscanl f m xs
> in (r, y:ys)
\end{verbatim}