\subsubsection{Instrument map}
\seclabel{user-patch-map}

\begin{haskelllisting}

> module Haskore.Interface.MIDI.InstrumentMap where

> import Haskore.Music.Standard(Instr)
> import qualified Sound.MIDI.Message.Channel as ChannelMsg
> import qualified Sound.MIDI.General         as GeneralMidi

> import qualified Haskore.General.Map as Map
> import qualified Data.List as List
> import Data.Tuple.HT (swap, )
> import Data.Char (toLower, )
> import Data.Maybe (fromMaybe, )

\end{haskelllisting}

A \type{InstrumentMap.ChannelProgramTable} is a user-supplied table for mapping instrument
names (\type{Instr}s) to Midi channels and General Midi patch names.
The patch names are by default General Midi names, although the user
can also provide a \type{PatchMap} for mapping Patch Names to
unconventional Midi Program Change numbers.
\begin{haskelllisting}

> type ChannelTable instr =
>    [(instr,  ChannelMsg.Channel)]
> type ChannelProgramTable instr =
>    [(instr, (ChannelMsg.Channel, ChannelMsg.Program))]
> type ChannelProgramPitchTable instr =
>    [(instr, (ChannelMsg.Channel, ChannelMsg.Program, ChannelMsg.Pitch))]
>
> type ToChannel instr =
>    instr ->  ChannelMsg.Channel
> type ToChannelProgram instr =
>    instr -> (ChannelMsg.Channel, ChannelMsg.Program)
> type ToChannelProgramPitch instr =
>    instr -> (ChannelMsg.Channel, ChannelMsg.Program, ChannelMsg.Pitch)
>
> type FromChannel instr =
>     ChannelMsg.Channel -> Maybe instr
> type FromChannelProgram instr =
>    (ChannelMsg.Channel, ChannelMsg.Program) -> Maybe instr
> type FromChannelProgramPitch instr =
>    (ChannelMsg.Channel, ChannelMsg.Program, ChannelMsg.Pitch) -> Maybe instr

\end{haskelllisting}

The \function{allValid} is used to test whether or not every instrument
in a list is found in a \type{InstrumentMap.ChannelProgramTable}.

\begin{haskelllisting}

> repair :: [Instr] -> ChannelProgramTable Instr -> ChannelProgramTable Instr
> repair insts pMap =
>    if allValid pMap insts
>        then pMap
>        else tableFromInstruments insts
>
> allValid :: ChannelProgramTable Instr -> [Instr] -> Bool
> allValid upm = all (\x -> any (partialMatch x . fst) upm)

\end{haskelllisting}

If a Haskore user only uses General Midi instrument names as
\type{Instr}s, we can define a function that automatically creates a
\type{InstrumentMap.ChannelProgramTable} from these names.  Note that, since there are only 15
Midi channels plus percussion, we can handle only 15 instruments.
Perhaps in the future a function could be written to test whether or
not two tracks can be combined with a Program Change (tracks can be
combined if they don't overlap).
\begin{haskelllisting}

> tableFromInstruments :: [Instr] -> ChannelProgramTable Instr
> tableFromInstruments instrs =
>    zip instrs (assignChannels GeneralMidi.instrumentChannels instrs)
>         -- 10th channel (#9) is for percussion

> assignChannels :: [ChannelMsg.Channel] -> [Instr] ->
>       [(ChannelMsg.Channel, ChannelMsg.Program)]
> assignChannels _ [] = []
> assignChannels [] _ =
>    error "Too many instruments; not enough MIDI channels."
> assignChannels chans@(c:cs) (i:is) =
>    let percList = ["percussion", "perc", "drum", "drums"]
>    in  if map toLower i `elem` percList
>          then (GeneralMidi.drumChannel, GeneralMidi.drumProgram)
>                      : assignChannels chans is
>          else (c, fromMaybe
>             (error ("unknown instrument <<" ++ i ++ ">>"))
>             (GeneralMidi.instrumentNameToProgram i))
>                      : assignChannels cs is

> fromInstruments :: Ord instr => [instr] -> ToChannel instr
> fromInstruments instrs =
>    let fm = Map.fromList (zip instrs GeneralMidi.instrumentChannels)
>    in  Map.findWithDefault fm (error "More instruments than channels")

\end{haskelllisting}

The following functions lookup \type{Instr}s in \type{InstrumentMap.ChannelProgramTable}s to
recover channel and program change numbers.
Note that the function that does string matching ignores case,
and that instrument name and search pattern match
if one is a prefix of the other one.
For example, \code{"chur"} matches \code{"Church Organ"}.  Note also
that the {\em first} match succeeds, so using a substring should be
done with care to be sure that the correct instrument is selected.
\begin{haskelllisting}

> partialMatch :: Instr -> Instr -> Bool
> partialMatch "piano" "Acoustic Grand Piano" = True
> partialMatch s1 s2 =
>   let s1' = map toLower s1
>       s2' = map toLower s2
>   in  all (uncurry (==)) (zip s1' s2')
>
> lookupIName :: [(Instr, a)] -> Instr -> a
> lookupIName  ys x =
>    maybe (error ("InstrumentMap.lookupIName: Instrument " ++ x ++ " unknown"))
>          snd (List.find (partialMatch x . fst) ys)
>
> lookup :: Eq instr => [(instr, a)] -> instr -> a
> lookup ys x =
>    fromMaybe (error ("InstrumentMap.lookup: Instrument unknown"))
>              (List.lookup x ys)

\end{haskelllisting}

\begin{haskelllisting}

> reverseLookupMaybe :: Eq a => [(instr, a)] -> a -> Maybe instr
> reverseLookupMaybe ys x =
>    List.lookup x (map swap ys)

> reverseLookup :: Eq a => [(instr, a)] -> a -> instr
> reverseLookup ys x =
>    let instr = reverseLookupMaybe ys x
>        err   = error "InstrumentMap.reverseLookup: channel+program not found"
>    in  fromMaybe err instr

\end{haskelllisting}

A default \type{InstrumentMap.ChannelProgramTable}.
Note: the PC sound card I'm using is limited to 9 instruments.

\begin{haskelllisting}

> defltTable :: [(Instr, ChannelMsg.Channel, GeneralMidi.Instrument)]
> defltTable =
>    map (\(instr,chan,gmInstr) -> (instr, ChannelMsg.toChannel chan, gmInstr))
>    [("piano",   1, GeneralMidi.AcousticGrandPiano),
>     ("vibes",   2, GeneralMidi.Vibraphone),
>     ("bass",    3, GeneralMidi.AcousticBass),
>     ("flute",   4, GeneralMidi.Flute),
>     ("sax",     5, GeneralMidi.TenorSax),
>     ("guitar",  6, GeneralMidi.AcousticGuitarSteel),
>     ("violin",  7, GeneralMidi.Viola),
>     ("violins", 8, GeneralMidi.StringEnsemble1),
>     ("drums",   9, GeneralMidi.AcousticGrandPiano)]
>       -- the GM name for drums is unimportant, only channel 9

> deflt :: ChannelProgramTable Instr
> deflt =
>    map (\(iName, chan, gmName) ->
>          (iName, (chan, GeneralMidi.instrumentToProgram gmName))) defltTable

> defltGM :: ChannelProgramTable GeneralMidi.Instrument
> defltGM =
>    map (\(_, chan, gmName) ->
>          (gmName, (chan, GeneralMidi.instrumentToProgram gmName))) defltTable

> defltCMap :: [(GeneralMidi.Instrument, ChannelMsg.Channel)]
> defltCMap =
>    map (\(_, chan, gmName) -> (gmName, chan)) defltTable

\end{haskelllisting}