{- |
Datatype for MIDI events as they can be sent to a synthesizer.
That is, no timing is handled here.

Taken from Haskore.
-}

module Sound.MIDI.Event(
   T(..),
   Pitch, Program,
   Channel, Controller(..), ControllerValue, PitchBendRange, Pressure, Velocity,
   isNote, isNoteOn, isNoteOff, zeroKey,
   maximumVelocity, normalVelocity, toFloatVelocity,
   toFloatController,

   bankSelect, modulation, breathControl, footControl, portamentoTime,
   dataEntry, mainVolume, balance, panorama, expression,
   generalPurpose1, generalPurpose2, generalPurpose3, generalPurpose4,
   vectorX, vectorY,

   bankSelectMSB, modulationMSB, breathControlMSB, footControlMSB,
   portamentoTimeMSB, dataEntryMSB, mainVolumeMSB, balanceMSB,
   panoramaMSB, expressionMSB, generalPurpose1MSB, generalPurpose2MSB,
   generalPurpose3MSB, generalPurpose4MSB, bankSelectLSB, modulationLSB,
   breathControlLSB, footControlLSB, portamentoTimeLSB, dataEntryLSB,
   mainVolumeLSB, balanceLSB, panoramaLSB, expressionLSB,
   generalPurpose1LSB, generalPurpose2LSB, generalPurpose3LSB, generalPurpose4LSB,

   sustain, porta, sustenuto, softPedal, hold2,
   generalPurpose5, generalPurpose6, generalPurpose7, generalPurpose8,
   extDepth, tremoloDepth, chorusDepth, celesteDepth, phaserDepth,

   dataIncrement, dataDecrement,
   nonRegisteredParameterLSB, nonRegisteredParameterMSB,
   registeredParameterLSB, registeredParameterMSB,

   fromPitch,     toPitch,
   fromVelocity,  toVelocity,
   fromProgram,   toProgram,
   fromChannel,   toChannel,
   increasePitch, subtractPitch,
  ) where

import Data.Ix (Ix)



{- * MIDI Events -}

newtype Pitch       = Pitch    {fromPitch    :: Int} deriving (Show, Eq, Ord, Ix)
newtype Velocity    = Velocity {fromVelocity :: Int} deriving (Show, Eq, Ord)
newtype Program     = Program  {fromProgram  :: Int} deriving (Show, Eq, Ord, Ix)
newtype Channel     = Channel  {fromChannel  :: Int} deriving (Show, Eq, Ord, Ix)

toPitch :: Int -> Pitch
toPitch = checkRange "Pitch" Pitch

toVelocity :: Int -> Velocity
toVelocity = checkRange "Velocity" Velocity

toProgram :: Int -> Program
toProgram = checkRange "Program" Program

toChannel :: Int -> Channel
toChannel = checkRange "Channel" Channel

checkRange :: (Bounded a, Ord a, Show a) =>
   String -> (Int -> a) -> Int -> a
checkRange typ f x =
   let y = f x
   in  if minBound <= y && y <= maxBound
         then y
         else error (typ ++ ": value " ++ show x ++ " outside range " ++
                     show ((minBound, maxBound) `asTypeOf` (y,y)))

instance Enum Program where
   toEnum   = toProgram
   fromEnum = fromProgram

instance Enum Channel where
   toEnum   = toChannel
   fromEnum = fromChannel

instance Enum Pitch where
   toEnum   = toPitch
   fromEnum = fromPitch

-- typical methods of a type class for affine spaces
increasePitch :: Int -> Pitch -> Pitch
increasePitch d = toPitch . (d+) . fromPitch

subtractPitch :: Pitch -> Pitch -> Int
subtractPitch (Pitch p0) (Pitch p1) = p1-p0


instance Bounded Pitch where
   minBound = Pitch   0
   maxBound = Pitch 127

instance Bounded Velocity where
   minBound = Velocity   0
   maxBound = Velocity 127

instance Bounded Program where
   minBound = Program   0
   maxBound = Program 127

instance Bounded Channel where
   minBound = Channel  0
   maxBound = Channel 15


{- |
A MIDI problem is that one cannot uniquely map
a MIDI key to a frequency.
The frequency depends on the instrument.
I don't know if the deviations are defined for General MIDI.
If this applies one could add transposition information
to the use patch map.
For now I have chosen a value that leads to the right frequency
for some piano sound in my setup.
-}

zeroKey :: Pitch
zeroKey = toPitch 48

{- |
The velocity of an ordinary key stroke and
the maximum possible velocity.
-}

normalVelocity, maximumVelocity :: Num quant => quant
   -- Velocity
normalVelocity  =  64
maximumVelocity = 127

{- |
64 is given as default value by the MIDI specification
and thus we map it to 1.
0 is mapped to 0.
All other values are interpolated linearly.
-}
toFloatVelocity :: (Integral a, Fractional b) => a -> b
toFloatVelocity x = fromIntegral x / normalVelocity

maximumControllerValue :: Num quant => quant
maximumControllerValue = 127

{- |
Map integral MIDI controller value to floating point value.
Maximum integral MIDI controller value 127 is mapped to 1.
Minimum integral MIDI controller value 0 is mapped to 0.
-}
toFloatController :: (Integral a, Fractional b) => a -> b
toFloatController x = fromIntegral x / maximumControllerValue



type PitchBendRange  = Int
type Pressure        = Int
type ControllerValue = Int

data T =
     NoteOff       Pitch Velocity
   | NoteOn        Pitch Velocity
   | PolyAfter     Pitch Pressure
   | ProgramChange Program
   | Control       Controller ControllerValue
   | PitchBend     PitchBendRange
   | MonoAfter     Pressure
     deriving (Show, Eq, Ord)


isNote :: T -> Bool
isNote (NoteOn  _ _) = True
isNote (NoteOff _ _) = True
isNote _             = False

isNoteOn :: T -> Bool
isNoteOn (NoteOn  _ _) = True
isNoteOn _             = False

isNoteOff :: T -> Bool
isNoteOff (NoteOff _ _) = True
isNoteOff _             = False



{-# DEPRECATED BankSelectMSB             "use bankSelectMSB instead" #-}
{-# DEPRECATED ModulationMSB             "use modulationMSB instead" #-}
{-# DEPRECATED BreathControlMSB          "use breathControlMSB instead" #-}
{-# DEPRECATED Controller03              "use toEnum 0x03 instead" #-}
{-# DEPRECATED FootControlMSB            "use footControlMSB instead" #-}
{-# DEPRECATED PortamentoTimeMSB         "use portamentoTimeMSB instead" #-}
{-# DEPRECATED DataEntryMSB              "use dataEntryMSB instead" #-}
{-# DEPRECATED MainVolumeMSB             "use mainVolumeMSB instead" #-}
{-# DEPRECATED BalanceMSB                "use balanceMSB instead" #-}
{-# DEPRECATED Controller09              "use toEnum 0x09 instead" #-}
{-# DEPRECATED PanoramaMSB               "use panoramaMSB instead" #-}
{-# DEPRECATED ExpressionMSB             "use expressionMSB instead" #-}
{-# DEPRECATED Controller0C              "use toEnum 0x0C instead" #-}
{-# DEPRECATED Controller0D              "use toEnum 0x0D instead" #-}
{-# DEPRECATED Controller0E              "use toEnum 0x0E instead" #-}
{-# DEPRECATED Controller0F              "use toEnum 0x0F instead" #-}
{-# DEPRECATED GeneralPurpose1MSB        "use generalPurpose1MSB instead" #-}
{-# DEPRECATED GeneralPurpose2MSB        "use generalPurpose2MSB instead" #-}
{-# DEPRECATED GeneralPurpose3MSB        "use generalPurpose3MSB instead" #-}
{-# DEPRECATED GeneralPurpose4MSB        "use generalPurpose4MSB instead" #-}
{-# DEPRECATED Controller14              "use toEnum 0x14 instead" #-}
{-# DEPRECATED Controller15              "use toEnum 0x15 instead" #-}
{-# DEPRECATED Controller16              "use toEnum 0x16 instead" #-}
{-# DEPRECATED Controller17              "use toEnum 0x17 instead" #-}
{-# DEPRECATED Controller18              "use toEnum 0x18 instead" #-}
{-# DEPRECATED Controller19              "use toEnum 0x19 instead" #-}
{-# DEPRECATED Controller1A              "use toEnum 0x1A instead" #-}
{-# DEPRECATED Controller1B              "use toEnum 0x1B instead" #-}
{-# DEPRECATED Controller1C              "use toEnum 0x1C instead" #-}
{-# DEPRECATED Controller1D              "use toEnum 0x1D instead" #-}
{-# DEPRECATED Controller1E              "use toEnum 0x1E instead" #-}
{-# DEPRECATED Controller1F              "use toEnum 0x1F instead" #-}
{-# DEPRECATED BankSelectLSB             "use bankSelectLSB instead" #-}
{-# DEPRECATED ModulationLSB             "use modulationLSB instead" #-}
{-# DEPRECATED BreathControlLSB          "use breathControlLSB instead" #-}
{-# DEPRECATED Controller23              "use toEnum 0x23 instead" #-}
{-# DEPRECATED FootControlLSB            "use footControlLSB instead" #-}
{-# DEPRECATED PortamentoTimeLSB         "use portamentoTimeLSB instead" #-}
{-# DEPRECATED DataEntryLSB              "use dataEntryLSB instead" #-}
{-# DEPRECATED MainVolumeLSB             "use mainVolumeLSB instead" #-}
{-# DEPRECATED BalanceLSB                "use balanceLSB instead" #-}
{-# DEPRECATED Controller29              "use toEnum 0x29 instead" #-}
{-# DEPRECATED PanoramaLSB               "use panoramaLSB instead" #-}
{-# DEPRECATED ExpressionLSB             "use expressionLSB instead" #-}
{-# DEPRECATED Controller2C              "use toEnum 0x2C instead" #-}
{-# DEPRECATED Controller2D              "use toEnum 0x2D instead" #-}
{-# DEPRECATED Controller2E              "use toEnum 0x2E instead" #-}
{-# DEPRECATED Controller2F              "use toEnum 0x2F instead" #-}
{-# DEPRECATED GeneralPurpose1LSB        "use generalPurpose1LSB instead" #-}
{-# DEPRECATED GeneralPurpose2LSB        "use generalPurpose2LSB instead" #-}
{-# DEPRECATED GeneralPurpose3LSB        "use generalPurpose3LSB instead" #-}
{-# DEPRECATED GeneralPurpose4LSB        "use generalPurpose4LSB instead" #-}
{-# DEPRECATED Controller34              "use toEnum 0x34 instead" #-}
{-# DEPRECATED Controller35              "use toEnum 0x35 instead" #-}
{-# DEPRECATED Controller36              "use toEnum 0x36 instead" #-}
{-# DEPRECATED Controller37              "use toEnum 0x37 instead" #-}
{-# DEPRECATED Controller38              "use toEnum 0x38 instead" #-}
{-# DEPRECATED Controller39              "use toEnum 0x39 instead" #-}
{-# DEPRECATED Controller3A              "use toEnum 0x3A instead" #-}
{-# DEPRECATED Controller3B              "use toEnum 0x3B instead" #-}
{-# DEPRECATED Controller3C              "use toEnum 0x3C instead" #-}
{-# DEPRECATED Controller3D              "use toEnum 0x3D instead" #-}
{-# DEPRECATED Controller3E              "use toEnum 0x3E instead" #-}
{-# DEPRECATED Controller3F              "use toEnum 0x3F instead" #-}

{-# DEPRECATED Sustain                   "use sustain instead" #-}
{-# DEPRECATED Porta                     "use porta instead" #-}
{-# DEPRECATED Sustenuto                 "use sustenuto instead" #-}
{-# DEPRECATED SoftPedal                 "use softPedal instead" #-}
{-# DEPRECATED Controller44              "use toEnum 0x44 instead" #-}
{-# DEPRECATED Hold2                     "use hold2 instead" #-}
{-# DEPRECATED Controller46              "use toEnum 0x46 instead" #-}
{-# DEPRECATED Controller47              "use toEnum 0x47 instead" #-}
{-# DEPRECATED Controller48              "use toEnum 0x48 instead" #-}
{-# DEPRECATED Controller49              "use toEnum 0x49 instead" #-}
{-# DEPRECATED Controller4A              "use toEnum 0x4A instead" #-}
{-# DEPRECATED Controller4B              "use toEnum 0x4B instead" #-}
{-# DEPRECATED Controller4C              "use toEnum 0x4C instead" #-}
{-# DEPRECATED Controller4D              "use toEnum 0x4D instead" #-}
{-# DEPRECATED Controller4E              "use toEnum 0x4E instead" #-}
{-# DEPRECATED Controller4F              "use toEnum 0x4F instead" #-}
{-# DEPRECATED GeneralPurpose5           "use generalPurpose5 instead" #-}
{-# DEPRECATED GeneralPurpose6           "use generalPurpose6 instead" #-}
{-# DEPRECATED GeneralPurpose7           "use generalPurpose7 instead" #-}
{-# DEPRECATED GeneralPurpose8           "use generalPurpose8 instead" #-}
{-# DEPRECATED Controller54              "use toEnum 0x54 instead" #-}
{-# DEPRECATED Controller55              "use toEnum 0x55 instead" #-}
{-# DEPRECATED Controller56              "use toEnum 0x56 instead" #-}
{-# DEPRECATED Controller57              "use toEnum 0x57 instead" #-}
{-# DEPRECATED Controller58              "use toEnum 0x58 instead" #-}
{-# DEPRECATED Controller59              "use toEnum 0x59 instead" #-}
{-# DEPRECATED Controller5A              "use toEnum 0x5A instead" #-}
{-# DEPRECATED ExtDepth                  "use extDepth instead" #-}
{-# DEPRECATED TremoloDepth              "use tremoloDepth instead" #-}
{-# DEPRECATED ChorusDepth               "use chorusDepth instead" #-}
{-# DEPRECATED CelesteDepth              "use celesteDepth instead" #-}
{-# DEPRECATED PhaserDepth               "use phaserDepth instead" #-}

{-# DEPRECATED DataIncrement             "use dataIncrement instead" #-}
{-# DEPRECATED DataDecrement             "use dataDecrement instead" #-}
{-# DEPRECATED NonRegisteredParameterLSB "use nonRegisteredParameterLSB instead" #-}
{-# DEPRECATED NonRegisteredParameterMSB "use nonRegisteredParameterMSB instead" #-}
{-# DEPRECATED RegisteredParameterLSB    "use registeredParameterLSB instead" #-}
{-# DEPRECATED RegisteredParameterMSB    "use registeredParameterMSB instead" #-}
{-# DEPRECATED Controller66              "use toEnum 0x66 instead" #-}
{-# DEPRECATED Controller67              "use toEnum 0x67 instead" #-}
{-# DEPRECATED Controller68              "use toEnum 0x68 instead" #-}
{-# DEPRECATED Controller69              "use toEnum 0x69 instead" #-}
{-# DEPRECATED Controller6A              "use toEnum 0x6A instead" #-}
{-# DEPRECATED Controller6B              "use toEnum 0x6B instead" #-}
{-# DEPRECATED Controller6C              "use toEnum 0x6C instead" #-}
{-# DEPRECATED Controller6D              "use toEnum 0x6D instead" #-}
{-# DEPRECATED Controller6E              "use toEnum 0x6E instead" #-}
{-# DEPRECATED Controller6F              "use toEnum 0x6F instead" #-}
{-# DEPRECATED Controller70              "use toEnum 0x70 instead" #-}
{-# DEPRECATED Controller71              "use toEnum 0x71 instead" #-}
{-# DEPRECATED Controller72              "use toEnum 0x72 instead" #-}
{-# DEPRECATED Controller73              "use toEnum 0x73 instead" #-}
{-# DEPRECATED Controller74              "use toEnum 0x74 instead" #-}
{-# DEPRECATED Controller75              "use toEnum 0x75 instead" #-}
{-# DEPRECATED Controller76              "use toEnum 0x76 instead" #-}
{-# DEPRECATED Controller77              "use toEnum 0x77 instead" #-}
{-# DEPRECATED Controller78              "use toEnum 0x78 instead" #-}
{-# DEPRECATED Controller79              "use toEnum 0x79 instead" #-}
{-# DEPRECATED Controller7A              "use toEnum 0x7A instead" #-}
{-# DEPRECATED Controller7B              "use toEnum 0x7B instead" #-}
{-# DEPRECATED Controller7C              "use toEnum 0x7C instead" #-}
{-# DEPRECATED Controller7D              "use toEnum 0x7D instead" #-}
{-# DEPRECATED Controller7E              "use toEnum 0x7E instead" #-}
{-# DEPRECATED Controller7F              "use toEnum 0x7F instead" #-}


{- |
Types of predefined MIDI controllers.
-}
data Controller =
     {-  00 00 -} BankSelectMSB
   | {-  01 01 -} ModulationMSB
   | {-  02 02 -} BreathControlMSB
   | {-  03 03 -} Controller03
   | {-  04 04 -} FootControlMSB
   | {-  05 05 -} PortamentoTimeMSB
   | {-  06 06 -} DataEntryMSB
   | {-  07 07 -} MainVolumeMSB
   | {-  08 08 -} BalanceMSB
   | {-  09 09 -} Controller09
   | {-  10 0A -} PanoramaMSB
   | {-  11 0B -} ExpressionMSB
   | {-  12 0C -} Controller0C
   | {-  13 0D -} Controller0D
   | {-  14 0E -} Controller0E
   | {-  15 0F -} Controller0F
   | {-  16 10 -} GeneralPurpose1MSB
   | {-  17 11 -} GeneralPurpose2MSB
   | {-  18 12 -} GeneralPurpose3MSB
   | {-  19 13 -} GeneralPurpose4MSB
   | {-  20 14 -} Controller14
   | {-  21 15 -} Controller15
   | {-  22 16 -} Controller16
   | {-  23 17 -} Controller17
   | {-  24 18 -} Controller18
   | {-  25 19 -} Controller19
   | {-  26 1A -} Controller1A
   | {-  27 1B -} Controller1B
   | {-  28 1C -} Controller1C
   | {-  29 1D -} Controller1D
   | {-  30 1E -} Controller1E
   | {-  31 1F -} Controller1F
   | {-  32 20 -} BankSelectLSB
   | {-  33 21 -} ModulationLSB
   | {-  34 22 -} BreathControlLSB
   | {-  35 23 -} Controller23
   | {-  36 24 -} FootControlLSB
   | {-  37 25 -} PortamentoTimeLSB
   | {-  38 26 -} DataEntryLSB
   | {-  39 27 -} MainVolumeLSB
   | {-  40 28 -} BalanceLSB
   | {-  41 29 -} Controller29
   | {-  42 2A -} PanoramaLSB
   | {-  43 2B -} ExpressionLSB
   | {-  44 2C -} Controller2C
   | {-  45 2D -} Controller2D
   | {-  46 2E -} Controller2E
   | {-  47 2F -} Controller2F
   | {-  48 30 -} GeneralPurpose1LSB
   | {-  49 31 -} GeneralPurpose2LSB
   | {-  50 32 -} GeneralPurpose3LSB
   | {-  51 33 -} GeneralPurpose4LSB
   | {-  52 34 -} Controller34
   | {-  53 35 -} Controller35
   | {-  54 36 -} Controller36
   | {-  55 37 -} Controller37
   | {-  56 38 -} Controller38
   | {-  57 39 -} Controller39
   | {-  58 3A -} Controller3A
   | {-  59 3B -} Controller3B
   | {-  60 3C -} Controller3C
   | {-  61 3D -} Controller3D
   | {-  62 3E -} Controller3E
   | {-  63 3F -} Controller3F
   {- Continuous 7 bit (switches: 0-3f=off, 40-7f=on) -}
   | {-  64 40 -} Sustain
   | {-  65 41 -} Porta
   | {-  66 42 -} Sustenuto
   | {-  67 43 -} SoftPedal
   | {-  68 44 -} Controller44
   | {-  69 45 -} Hold2
   | {-  70 46 -} Controller46
   | {-  71 47 -} Controller47
   | {-  72 48 -} Controller48
   | {-  73 49 -} Controller49
   | {-  74 4A -} Controller4A
   | {-  75 4B -} Controller4B
   | {-  76 4C -} Controller4C
   | {-  77 4D -} Controller4D
   | {-  78 4E -} Controller4E
   | {-  79 4F -} Controller4F
   | {-  80 50 -} GeneralPurpose5
   | {-  81 51 -} GeneralPurpose6
   | {-  82 52 -} GeneralPurpose7
   | {-  83 53 -} GeneralPurpose8
   | {-  84 54 -} Controller54
   | {-  85 55 -} Controller55
   | {-  86 56 -} Controller56
   | {-  87 57 -} Controller57
   | {-  88 58 -} Controller58
   | {-  89 59 -} Controller59
   | {-  90 5A -} Controller5A
   | {-  91 5B -} ExtDepth
   | {-  92 5C -} TremoloDepth
   | {-  93 5D -} ChorusDepth
   | {-  94 5E -} CelesteDepth
   | {-  95 5F -} PhaserDepth
   {- Parameters -}
   | {-  96 60 -} DataIncrement
   | {-  97 61 -} DataDecrement
   | {-  98 62 -} NonRegisteredParameterLSB
   | {-  99 63 -} NonRegisteredParameterMSB
   | {- 100 64 -} RegisteredParameterLSB
   | {- 101 65 -} RegisteredParameterMSB
   | {- 102 66 -} Controller66
   | {- 103 67 -} Controller67
   | {- 104 68 -} Controller68
   | {- 105 69 -} Controller69
   | {- 106 6A -} Controller6A
   | {- 107 6B -} Controller6B
   | {- 108 6C -} Controller6C
   | {- 109 6D -} Controller6D
   | {- 110 6E -} Controller6E
   | {- 111 6F -} Controller6F
   | {- 112 70 -} Controller70
   | {- 113 71 -} Controller71
   | {- 114 72 -} Controller72
   | {- 115 73 -} Controller73
   | {- 116 74 -} Controller74
   | {- 117 75 -} Controller75
   | {- 118 76 -} Controller76
   | {- 119 77 -} Controller77
   | {- 120 78 -} Controller78
   | {- 121 79 -} Controller79
   | {- 122 7A -} Controller7A
   | {- 123 7B -} Controller7B
   | {- 124 7C -} Controller7C
   | {- 125 7D -} Controller7D
   | {- 126 7E -} Controller7E
   | {- 127 7F -} Controller7F
       deriving (Show, Eq, Ord, Enum)






bankSelect, modulation, breathControl, footControl, portamentoTime,
   dataEntry, mainVolume, balance, panorama, expression,
   generalPurpose1, generalPurpose2, generalPurpose3, generalPurpose4,
   vectorX, vectorY :: Controller
bankSelect      = bankSelectMSB
modulation      = modulationMSB
breathControl   = breathControlMSB
footControl     = footControlMSB
portamentoTime  = portamentoTimeMSB
dataEntry       = dataEntryMSB
mainVolume      = mainVolumeMSB
balance         = balanceMSB
panorama        = panoramaMSB
expression      = expressionMSB
generalPurpose1 = generalPurpose1MSB
generalPurpose2 = generalPurpose2MSB
generalPurpose3 = generalPurpose3MSB
generalPurpose4 = generalPurpose4MSB

vectorX = generalPurpose1
vectorY = generalPurpose2



bankSelectMSB, modulationMSB, breathControlMSB, footControlMSB,
  portamentoTimeMSB, dataEntryMSB, mainVolumeMSB, balanceMSB,
  panoramaMSB, expressionMSB, generalPurpose1MSB, generalPurpose2MSB,
  generalPurpose3MSB, generalPurpose4MSB, bankSelectLSB, modulationLSB,
  breathControlLSB, footControlLSB, portamentoTimeLSB, dataEntryLSB,
  mainVolumeLSB, balanceLSB, panoramaLSB, expressionLSB,
  generalPurpose1LSB, generalPurpose2LSB, generalPurpose3LSB, generalPurpose4LSB :: Controller

sustain, porta, sustenuto, softPedal, hold2,
  generalPurpose5, generalPurpose6, generalPurpose7, generalPurpose8,
  extDepth, tremoloDepth, chorusDepth, celesteDepth, phaserDepth :: Controller

dataIncrement, dataDecrement,
  nonRegisteredParameterLSB, nonRegisteredParameterMSB,
  registeredParameterLSB, registeredParameterMSB :: Controller


bankSelectMSB             = BankSelectMSB                 {-  00 00 -}
modulationMSB             = ModulationMSB                 {-  01 01 -}
breathControlMSB          = BreathControlMSB              {-  02 02 -}
footControlMSB            = FootControlMSB                {-  04 04 -}
portamentoTimeMSB         = PortamentoTimeMSB             {-  05 05 -}
dataEntryMSB              = DataEntryMSB                  {-  06 06 -}
mainVolumeMSB             = MainVolumeMSB                 {-  07 07 -}
balanceMSB                = BalanceMSB                    {-  08 08 -}
panoramaMSB               = PanoramaMSB                   {-  10 0A -}
expressionMSB             = ExpressionMSB                 {-  11 0B -}
generalPurpose1MSB        = GeneralPurpose1MSB            {-  16 10 -}
generalPurpose2MSB        = GeneralPurpose2MSB            {-  17 11 -}
generalPurpose3MSB        = GeneralPurpose3MSB            {-  18 12 -}
generalPurpose4MSB        = GeneralPurpose4MSB            {-  19 13 -}
bankSelectLSB             = BankSelectLSB                 {-  32 20 -}
modulationLSB             = ModulationLSB                 {-  33 21 -}
breathControlLSB          = BreathControlLSB              {-  34 22 -}
footControlLSB            = FootControlLSB                {-  36 24 -}
portamentoTimeLSB         = PortamentoTimeLSB             {-  37 25 -}
dataEntryLSB              = DataEntryLSB                  {-  38 26 -}
mainVolumeLSB             = MainVolumeLSB                 {-  39 27 -}
balanceLSB                = BalanceLSB                    {-  40 28 -}
panoramaLSB               = PanoramaLSB                   {-  42 2A -}
expressionLSB             = ExpressionLSB                 {-  43 2B -}
generalPurpose1LSB        = GeneralPurpose1LSB            {-  48 30 -}
generalPurpose2LSB        = GeneralPurpose2LSB            {-  49 31 -}
generalPurpose3LSB        = GeneralPurpose3LSB            {-  50 32 -}
generalPurpose4LSB        = GeneralPurpose4LSB            {-  51 33 -}

sustain                   = Sustain                       {-  64 40 -}
porta                     = Porta                         {-  65 41 -}
sustenuto                 = Sustenuto                     {-  66 42 -}
softPedal                 = SoftPedal                     {-  67 43 -}
hold2                     = Hold2                         {-  69 45 -}
generalPurpose5           = GeneralPurpose5               {-  80 50 -}
generalPurpose6           = GeneralPurpose6               {-  81 51 -}
generalPurpose7           = GeneralPurpose7               {-  82 52 -}
generalPurpose8           = GeneralPurpose8               {-  83 53 -}
extDepth                  = ExtDepth                      {-  91 5B -}
tremoloDepth              = TremoloDepth                  {-  92 5C -}
chorusDepth               = ChorusDepth                   {-  93 5D -}
celesteDepth              = CelesteDepth                  {-  94 5E -}
phaserDepth               = PhaserDepth                   {-  95 5F -}

dataIncrement             = DataIncrement                 {-  96 60 -}
dataDecrement             = DataDecrement                 {-  97 61 -}
nonRegisteredParameterLSB = NonRegisteredParameterLSB     {-  98 62 -}
nonRegisteredParameterMSB = NonRegisteredParameterMSB     {-  99 63 -}
registeredParameterLSB    = RegisteredParameterLSB        {- 100 64 -}
registeredParameterMSB    = RegisteredParameterMSB        {- 101 65 -}