{- |
Channel voice messages
-}
module Sound.MIDI.Message.Channel.Voice (
   T(..), get, putWithStatus,
   ControllerValue, PitchBendRange, Pressure,
   isNote, isNoteOn, isNoteOff, zeroKey,
   explicitNoteOff, implicitNoteOff,
   realFromControllerValue,

   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,

   Pitch,      fromPitch,      toPitch,
   Velocity,   fromVelocity,   toVelocity,
   Program,    fromProgram,    toProgram,
   CtrlP.Controller, CtrlP.fromController, CtrlP.toController,

   increasePitch, subtractPitch, frequencyFromPitch,
   maximumVelocity, normalVelocity, realFromVelocity,
  ) where

import qualified Sound.MIDI.ControllerPrivate as CtrlP
import qualified Sound.MIDI.Controller as Ctrl

import           Sound.MIDI.Parser.Primitive
import qualified Sound.MIDI.Parser.Class as Parser

import Control.Monad (liftM, liftM2, )

import qualified Sound.MIDI.Writer.Status as StatusWriter
import qualified Sound.MIDI.Writer.Basic  as Writer
import qualified Sound.MIDI.Bit as Bit

import Sound.MIDI.Monoid ((+#+))

import Data.Ix (Ix)
import Sound.MIDI.Utility (checkRange,
          quantityRandomR, boundedQuantityRandom, chooseQuantity,
          enumRandomR, boundedEnumRandom, chooseEnum, )

import Test.QuickCheck (Arbitrary(arbitrary), )
import qualified Test.QuickCheck as QC
import System.Random (Random(random, randomR), )



-- * message type

data T =
     NoteOff        Pitch Velocity
   | NoteOn         Pitch Velocity
   | PolyAftertouch Pitch Pressure
   | ProgramChange  Program
   {-
   Shall we add support for registered parameters?
   -}
   | Control        Ctrl.T ControllerValue
   | PitchBend      PitchBendRange
   | MonoAftertouch Pressure
     deriving (Int -> T -> ShowS
[T] -> ShowS
T -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [T] -> ShowS
$cshowList :: [T] -> ShowS
show :: T -> String
$cshow :: T -> String
showsPrec :: Int -> T -> ShowS
$cshowsPrec :: Int -> T -> ShowS
Show, T -> T -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: T -> T -> Bool
$c/= :: T -> T -> Bool
== :: T -> T -> Bool
$c== :: T -> T -> Bool
Eq, Eq T
T -> T -> Bool
T -> T -> Ordering
T -> T -> T
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: T -> T -> T
$cmin :: T -> T -> T
max :: T -> T -> T
$cmax :: T -> T -> T
>= :: T -> T -> Bool
$c>= :: T -> T -> Bool
> :: T -> T -> Bool
$c> :: T -> T -> Bool
<= :: T -> T -> Bool
$c<= :: T -> T -> Bool
< :: T -> T -> Bool
$c< :: T -> T -> Bool
compare :: T -> T -> Ordering
$ccompare :: T -> T -> Ordering
Ord)


instance Arbitrary T where
   arbitrary :: Gen T
arbitrary =
      forall a. [(Int, Gen a)] -> Gen a
QC.frequency forall a b. (a -> b) -> a -> b
$
         (Int
10, forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Pitch -> Velocity -> T
NoteOff        forall a. Arbitrary a => Gen a
arbitrary forall a. Arbitrary a => Gen a
arbitrary) forall a. a -> [a] -> [a]
:
         (Int
10, forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Pitch -> Velocity -> T
NoteOn         forall a. Arbitrary a => Gen a
arbitrary forall a. Arbitrary a => Gen a
arbitrary) forall a. a -> [a] -> [a]
:
         ( Int
1, forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Pitch -> Int -> T
PolyAftertouch forall a. Arbitrary a => Gen a
arbitrary (forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
127))) forall a. a -> [a] -> [a]
:
         ( Int
1, forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  Program -> T
ProgramChange  forall a. Arbitrary a => Gen a
arbitrary) forall a. a -> [a] -> [a]
:
         ( Int
1, forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 T -> Int -> T
Control        forall a. Arbitrary a => Gen a
arbitrary (forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
127))) forall a. a -> [a] -> [a]
:
         ( Int
1, forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  Int -> T
PitchBend      (forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
12))) forall a. a -> [a] -> [a]
:
         ( Int
1, forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  Int -> T
MonoAftertouch (forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
127))) forall a. a -> [a] -> [a]
:
         []


instance Random Pitch where
   random :: forall g. RandomGen g => g -> (Pitch, g)
random  = forall a g. (Enum a, Bounded a, RandomGen g) => g -> (a, g)
boundedEnumRandom
   randomR :: forall g. RandomGen g => (Pitch, Pitch) -> g -> (Pitch, g)
randomR = forall a g. (Enum a, RandomGen g) => (a, a) -> g -> (a, g)
enumRandomR

instance Arbitrary Pitch where
   arbitrary :: Gen Pitch
arbitrary = forall a. (Enum a, Bounded a, Random a) => Gen a
chooseEnum


instance Random Velocity where
   random :: forall g. RandomGen g => g -> (Velocity, g)
random  = forall a b g.
(Bounded a, Random b, RandomGen g) =>
(a -> b) -> (b -> a) -> g -> (a, g)
boundedQuantityRandom Velocity -> Int
fromVelocity Int -> Velocity
toVelocity
   randomR :: forall g. RandomGen g => (Velocity, Velocity) -> g -> (Velocity, g)
randomR = forall b g a.
(Random b, RandomGen g) =>
(a -> b) -> (b -> a) -> (a, a) -> g -> (a, g)
quantityRandomR Velocity -> Int
fromVelocity Int -> Velocity
toVelocity

instance Arbitrary Velocity where
   arbitrary :: Gen Velocity
arbitrary = forall a b. (Bounded a, Random b) => (a -> b) -> (b -> a) -> Gen a
chooseQuantity Velocity -> Int
fromVelocity Int -> Velocity
toVelocity


instance Random Program where
   random :: forall g. RandomGen g => g -> (Program, g)
random  = forall a g. (Enum a, Bounded a, RandomGen g) => g -> (a, g)
boundedEnumRandom
   randomR :: forall g. RandomGen g => (Program, Program) -> g -> (Program, g)
randomR = forall a g. (Enum a, RandomGen g) => (a, a) -> g -> (a, g)
enumRandomR

instance Arbitrary Program where
   arbitrary :: Gen Program
arbitrary = forall a. (Enum a, Bounded a, Random a) => Gen a
chooseEnum


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

{- |
NoteOn with zero velocity is considered NoteOff according to MIDI specification.
-}
isNoteOn :: T -> Bool
isNoteOn :: T -> Bool
isNoteOn (NoteOn  Pitch
_ Velocity
v) = Velocity
v forall a. Ord a => a -> a -> Bool
> Int -> Velocity
toVelocity Int
0
isNoteOn T
_             = Bool
False

{- |
NoteOn with zero velocity is considered NoteOff according to MIDI specification.
-}
isNoteOff :: T -> Bool
isNoteOff :: T -> Bool
isNoteOff (NoteOn  Pitch
_ Velocity
v) = Velocity
v forall a. Eq a => a -> a -> Bool
== Int -> Velocity
toVelocity Int
0
isNoteOff (NoteOff Pitch
_ Velocity
_) = Bool
True
isNoteOff T
_             = Bool
False


{- |
Convert all @NoteOn p 0@ to @NoteOff p 64@.
The latter one is easier to process.
-}
explicitNoteOff :: T -> T
explicitNoteOff :: T -> T
explicitNoteOff T
msg =
   case T
msg of
      NoteOn Pitch
p Velocity
v ->
         if Velocity
v forall a. Eq a => a -> a -> Bool
== Int -> Velocity
toVelocity Int
0
           then Pitch -> Velocity -> T
NoteOff Pitch
p forall a b. (a -> b) -> a -> b
$ Int -> Velocity
toVelocity Int
64
           else T
msg
      T
_ -> T
msg


{- |
Convert all @NoteOff p 64@ to @NoteOn p 0@.
The latter one can be encoded more efficiently using the running status.
-}
implicitNoteOff :: T -> T
implicitNoteOff :: T -> T
implicitNoteOff T
msg =
   case T
msg of
      NoteOff Pitch
p Velocity
v ->
         if Velocity
v forall a. Eq a => a -> a -> Bool
== Int -> Velocity
toVelocity Int
64
           then Pitch -> Velocity -> T
NoteOn Pitch
p forall a b. (a -> b) -> a -> b
$ Int -> Velocity
toVelocity Int
0
           else T
msg
      T
_ -> T
msg




-- * Primitive types in Voice messages

type PitchBendRange  = Int
type Pressure        = Int
type ControllerValue = Ctrl.Value


newtype Pitch      = Pitch      {Pitch -> Int
fromPitch      :: Int} deriving (Int -> Pitch -> ShowS
[Pitch] -> ShowS
Pitch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pitch] -> ShowS
$cshowList :: [Pitch] -> ShowS
show :: Pitch -> String
$cshow :: Pitch -> String
showsPrec :: Int -> Pitch -> ShowS
$cshowsPrec :: Int -> Pitch -> ShowS
Show, Pitch -> Pitch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pitch -> Pitch -> Bool
$c/= :: Pitch -> Pitch -> Bool
== :: Pitch -> Pitch -> Bool
$c== :: Pitch -> Pitch -> Bool
Eq, Eq Pitch
Pitch -> Pitch -> Bool
Pitch -> Pitch -> Ordering
Pitch -> Pitch -> Pitch
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Pitch -> Pitch -> Pitch
$cmin :: Pitch -> Pitch -> Pitch
max :: Pitch -> Pitch -> Pitch
$cmax :: Pitch -> Pitch -> Pitch
>= :: Pitch -> Pitch -> Bool
$c>= :: Pitch -> Pitch -> Bool
> :: Pitch -> Pitch -> Bool
$c> :: Pitch -> Pitch -> Bool
<= :: Pitch -> Pitch -> Bool
$c<= :: Pitch -> Pitch -> Bool
< :: Pitch -> Pitch -> Bool
$c< :: Pitch -> Pitch -> Bool
compare :: Pitch -> Pitch -> Ordering
$ccompare :: Pitch -> Pitch -> Ordering
Ord, Ord Pitch
(Pitch, Pitch) -> Int
(Pitch, Pitch) -> [Pitch]
(Pitch, Pitch) -> Pitch -> Bool
(Pitch, Pitch) -> Pitch -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Pitch, Pitch) -> Int
$cunsafeRangeSize :: (Pitch, Pitch) -> Int
rangeSize :: (Pitch, Pitch) -> Int
$crangeSize :: (Pitch, Pitch) -> Int
inRange :: (Pitch, Pitch) -> Pitch -> Bool
$cinRange :: (Pitch, Pitch) -> Pitch -> Bool
unsafeIndex :: (Pitch, Pitch) -> Pitch -> Int
$cunsafeIndex :: (Pitch, Pitch) -> Pitch -> Int
index :: (Pitch, Pitch) -> Pitch -> Int
$cindex :: (Pitch, Pitch) -> Pitch -> Int
range :: (Pitch, Pitch) -> [Pitch]
$crange :: (Pitch, Pitch) -> [Pitch]
Ix)
newtype Velocity   = Velocity   {Velocity -> Int
fromVelocity   :: Int} deriving (Int -> Velocity -> ShowS
[Velocity] -> ShowS
Velocity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Velocity] -> ShowS
$cshowList :: [Velocity] -> ShowS
show :: Velocity -> String
$cshow :: Velocity -> String
showsPrec :: Int -> Velocity -> ShowS
$cshowsPrec :: Int -> Velocity -> ShowS
Show, Velocity -> Velocity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Velocity -> Velocity -> Bool
$c/= :: Velocity -> Velocity -> Bool
== :: Velocity -> Velocity -> Bool
$c== :: Velocity -> Velocity -> Bool
Eq, Eq Velocity
Velocity -> Velocity -> Bool
Velocity -> Velocity -> Ordering
Velocity -> Velocity -> Velocity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Velocity -> Velocity -> Velocity
$cmin :: Velocity -> Velocity -> Velocity
max :: Velocity -> Velocity -> Velocity
$cmax :: Velocity -> Velocity -> Velocity
>= :: Velocity -> Velocity -> Bool
$c>= :: Velocity -> Velocity -> Bool
> :: Velocity -> Velocity -> Bool
$c> :: Velocity -> Velocity -> Bool
<= :: Velocity -> Velocity -> Bool
$c<= :: Velocity -> Velocity -> Bool
< :: Velocity -> Velocity -> Bool
$c< :: Velocity -> Velocity -> Bool
compare :: Velocity -> Velocity -> Ordering
$ccompare :: Velocity -> Velocity -> Ordering
Ord)
newtype Program    = Program    {Program -> Int
fromProgram    :: Int} deriving (Int -> Program -> ShowS
[Program] -> ShowS
Program -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Program] -> ShowS
$cshowList :: [Program] -> ShowS
show :: Program -> String
$cshow :: Program -> String
showsPrec :: Int -> Program -> ShowS
$cshowsPrec :: Int -> Program -> ShowS
Show, Program -> Program -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Program -> Program -> Bool
$c/= :: Program -> Program -> Bool
== :: Program -> Program -> Bool
$c== :: Program -> Program -> Bool
Eq, Eq Program
Program -> Program -> Bool
Program -> Program -> Ordering
Program -> Program -> Program
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Program -> Program -> Program
$cmin :: Program -> Program -> Program
max :: Program -> Program -> Program
$cmax :: Program -> Program -> Program
>= :: Program -> Program -> Bool
$c>= :: Program -> Program -> Bool
> :: Program -> Program -> Bool
$c> :: Program -> Program -> Bool
<= :: Program -> Program -> Bool
$c<= :: Program -> Program -> Bool
< :: Program -> Program -> Bool
$c< :: Program -> Program -> Bool
compare :: Program -> Program -> Ordering
$ccompare :: Program -> Program -> Ordering
Ord, Ord Program
(Program, Program) -> Int
(Program, Program) -> [Program]
(Program, Program) -> Program -> Bool
(Program, Program) -> Program -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Program, Program) -> Int
$cunsafeRangeSize :: (Program, Program) -> Int
rangeSize :: (Program, Program) -> Int
$crangeSize :: (Program, Program) -> Int
inRange :: (Program, Program) -> Program -> Bool
$cinRange :: (Program, Program) -> Program -> Bool
unsafeIndex :: (Program, Program) -> Program -> Int
$cunsafeIndex :: (Program, Program) -> Program -> Int
index :: (Program, Program) -> Program -> Int
$cindex :: (Program, Program) -> Program -> Int
range :: (Program, Program) -> [Program]
$crange :: (Program, Program) -> [Program]
Ix)


toPitch :: Int -> Pitch
toPitch :: Int -> Pitch
toPitch = forall a.
(Bounded a, Ord a, Show a) =>
String -> (Int -> a) -> Int -> a
checkRange String
"Pitch" Int -> Pitch
Pitch

toVelocity :: Int -> Velocity
toVelocity :: Int -> Velocity
toVelocity = forall a.
(Bounded a, Ord a, Show a) =>
String -> (Int -> a) -> Int -> a
checkRange String
"Velocity" Int -> Velocity
Velocity

toProgram :: Int -> Program
toProgram :: Int -> Program
toProgram = forall a.
(Bounded a, Ord a, Show a) =>
String -> (Int -> a) -> Int -> a
checkRange String
"Program" Int -> Program
Program


instance Enum Pitch where
   toEnum :: Int -> Pitch
toEnum   = Int -> Pitch
toPitch
   fromEnum :: Pitch -> Int
fromEnum = Pitch -> Int
fromPitch

{-
I do not like an Enum Velocity instance,
because Velocity is an artificially sampled continuous quantity.
-}

instance Enum Program where
   toEnum :: Int -> Program
toEnum   = Int -> Program
toProgram
   fromEnum :: Program -> Int
fromEnum = Program -> Int
fromProgram

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

subtractPitch :: Pitch -> Pitch -> Int
subtractPitch :: Pitch -> Pitch -> Int
subtractPitch (Pitch Int
p0) (Pitch Int
p1) = Int
p1forall a. Num a => a -> a -> a
-Int
p0

{- |
Convert pitch to frequency
according to the default tuning
given in MIDI 1.0 Detailed Specification.
-}
frequencyFromPitch :: (Floating a) => Pitch -> a
frequencyFromPitch :: forall a. Floating a => Pitch -> a
frequencyFromPitch (Pitch Int
p) =
   a
440 forall a. Num a => a -> a -> a
* a
2 forall a. Floating a => a -> a -> a
** (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
p forall a. Num a => a -> a -> a
+ Int
3 forall a. Num a => a -> a -> a
- Int
6forall a. Num a => a -> a -> a
*Int
12) forall a. Fractional a => a -> a -> a
/ a
12)


instance Bounded Pitch where
   minBound :: Pitch
minBound = Int -> Pitch
Pitch   Int
0
   maxBound :: Pitch
maxBound = Int -> Pitch
Pitch Int
127

{- |
ToDo:
We have defined minBound = Velocity 0,
but strictly spoken the minimum Velocity is 1,
since Velocity zero means NoteOff.
One can at least think of NoteOff with (Velocity 0),
but I have never seen that.
-}
instance Bounded Velocity where
   minBound :: Velocity
minBound = Int -> Velocity
Velocity   Int
0
   maxBound :: Velocity
maxBound = Int -> Velocity
Velocity Int
127

instance Bounded Program where
   minBound :: Program
minBound = Int -> Program
Program   Int
0
   maxBound :: Program
maxBound = Int -> Program
Program Int
127


{- |
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 :: Pitch
zeroKey = Int -> Pitch
toPitch Int
48

{- |
The velocity of an ordinary key stroke and
the maximum possible velocity.
-}
normalVelocity, maximumVelocity :: Velocity
normalVelocity :: Velocity
normalVelocity  = Int -> Velocity
Velocity Int
64
maximumVelocity :: Velocity
maximumVelocity = forall a. Bounded a => a
maxBound

{- |
MIDI specification says,
if velocity is simply mapped to amplitude,
then this should be done by an exponential function.
Thus we map 'normalVelocity' (64) to 0,
'maximumVelocity' (127) to 1,
and 'minimumVelocity' (1) to -1.
That is, normally you should write something like
@amplitude = 2 ** realFromVelocity vel@ or @3 ** realFromVelocity vel@.
-}
realFromVelocity :: (Fractional b) => Velocity -> b
realFromVelocity :: forall b. Fractional b => Velocity -> b
realFromVelocity (Velocity Int
x) =
   forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x forall a. Num a => a -> a -> a
- Velocity -> Int
fromVelocity Velocity
normalVelocity) forall a. Fractional a => a -> a -> a
/
   forall a b. (Integral a, Num b) => a -> b
fromIntegral (Velocity -> Int
fromVelocity Velocity
maximumVelocity forall a. Num a => a -> a -> a
- Velocity -> Int
fromVelocity Velocity
normalVelocity)


maximumControllerValue :: Num a => a
maximumControllerValue :: forall a. Num a => a
maximumControllerValue = a
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.
-}
realFromControllerValue :: (Integral a, Fractional b) => a -> b
realFromControllerValue :: forall a b. (Integral a, Fractional b) => a -> b
realFromControllerValue a
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x forall a. Fractional a => a -> a -> a
/ forall a. Num a => a
maximumControllerValue



{-
These definitions will be deprecated
and then replaced by the ones from MIDI.Controller.
-}


-- * predefined MIDI controllers


-- ** simple names for controllers, if only most-significant bytes are used

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

vectorX :: T
vectorX = T
generalPurpose1
vectorY :: T
vectorY = T
generalPurpose2



-- ** controllers for most-significant bytes of control values
bankSelectMSB, modulationMSB, breathControlMSB, footControlMSB,
  portamentoTimeMSB, dataEntryMSB,
  mainVolumeMSB, balanceMSB, panoramaMSB, expressionMSB,
  generalPurpose1MSB, generalPurpose2MSB,
  generalPurpose3MSB, generalPurpose4MSB :: Ctrl.T

-- ** controllers for least-significant bytes of control values
bankSelectLSB, modulationLSB, breathControlLSB, footControlLSB,
  portamentoTimeLSB, dataEntryLSB,
  mainVolumeLSB, balanceLSB, panoramaLSB, expressionLSB,
  generalPurpose1LSB, generalPurpose2LSB,
  generalPurpose3LSB, generalPurpose4LSB :: Ctrl.T

-- ** additional single byte controllers
sustain, porta, sustenuto, softPedal, hold2,
  generalPurpose5, generalPurpose6, generalPurpose7, generalPurpose8,
  extDepth, tremoloDepth, chorusDepth, celesteDepth, phaserDepth :: Ctrl.T

-- ** increment/decrement and parameter numbers
dataIncrement, dataDecrement,
  nonRegisteredParameterLSB, nonRegisteredParameterMSB,
  registeredParameterLSB, registeredParameterMSB :: Ctrl.T


bankSelectMSB :: T
bankSelectMSB             = forall a. Enum a => Int -> a
toEnum Int
0x00  {-  00 00 -}
modulationMSB :: T
modulationMSB             = forall a. Enum a => Int -> a
toEnum Int
0x01  {-  01 01 -}
breathControlMSB :: T
breathControlMSB          = forall a. Enum a => Int -> a
toEnum Int
0x02  {-  02 02 -}
footControlMSB :: T
footControlMSB            = forall a. Enum a => Int -> a
toEnum Int
0x04  {-  04 04 -}
portamentoTimeMSB :: T
portamentoTimeMSB         = forall a. Enum a => Int -> a
toEnum Int
0x05  {-  05 05 -}
dataEntryMSB :: T
dataEntryMSB              = forall a. Enum a => Int -> a
toEnum Int
0x06  {-  06 06 -}
mainVolumeMSB :: T
mainVolumeMSB             = forall a. Enum a => Int -> a
toEnum Int
0x07  {-  07 07 -}
balanceMSB :: T
balanceMSB                = forall a. Enum a => Int -> a
toEnum Int
0x08  {-  08 08 -}
panoramaMSB :: T
panoramaMSB               = forall a. Enum a => Int -> a
toEnum Int
0x0A  {-  10 0A -}
expressionMSB :: T
expressionMSB             = forall a. Enum a => Int -> a
toEnum Int
0x0B  {-  11 0B -}
generalPurpose1MSB :: T
generalPurpose1MSB        = forall a. Enum a => Int -> a
toEnum Int
0x10  {-  16 10 -}
generalPurpose2MSB :: T
generalPurpose2MSB        = forall a. Enum a => Int -> a
toEnum Int
0x11  {-  17 11 -}
generalPurpose3MSB :: T
generalPurpose3MSB        = forall a. Enum a => Int -> a
toEnum Int
0x12  {-  18 12 -}
generalPurpose4MSB :: T
generalPurpose4MSB        = forall a. Enum a => Int -> a
toEnum Int
0x13  {-  19 13 -}

bankSelectLSB :: T
bankSelectLSB             = forall a. Enum a => Int -> a
toEnum Int
0x20  {-  32 20 -}
modulationLSB :: T
modulationLSB             = forall a. Enum a => Int -> a
toEnum Int
0x21  {-  33 21 -}
breathControlLSB :: T
breathControlLSB          = forall a. Enum a => Int -> a
toEnum Int
0x22  {-  34 22 -}
footControlLSB :: T
footControlLSB            = forall a. Enum a => Int -> a
toEnum Int
0x24  {-  36 24 -}
portamentoTimeLSB :: T
portamentoTimeLSB         = forall a. Enum a => Int -> a
toEnum Int
0x25  {-  37 25 -}
dataEntryLSB :: T
dataEntryLSB              = forall a. Enum a => Int -> a
toEnum Int
0x26  {-  38 26 -}
mainVolumeLSB :: T
mainVolumeLSB             = forall a. Enum a => Int -> a
toEnum Int
0x27  {-  39 27 -}
balanceLSB :: T
balanceLSB                = forall a. Enum a => Int -> a
toEnum Int
0x28  {-  40 28 -}
panoramaLSB :: T
panoramaLSB               = forall a. Enum a => Int -> a
toEnum Int
0x2A  {-  42 2A -}
expressionLSB :: T
expressionLSB             = forall a. Enum a => Int -> a
toEnum Int
0x2B  {-  43 2B -}
generalPurpose1LSB :: T
generalPurpose1LSB        = forall a. Enum a => Int -> a
toEnum Int
0x30  {-  48 30 -}
generalPurpose2LSB :: T
generalPurpose2LSB        = forall a. Enum a => Int -> a
toEnum Int
0x31  {-  49 31 -}
generalPurpose3LSB :: T
generalPurpose3LSB        = forall a. Enum a => Int -> a
toEnum Int
0x32  {-  50 32 -}
generalPurpose4LSB :: T
generalPurpose4LSB        = forall a. Enum a => Int -> a
toEnum Int
0x33  {-  51 33 -}

sustain :: T
sustain                   = forall a. Enum a => Int -> a
toEnum Int
0x40  {-  64 40 -}
porta :: T
porta                     = forall a. Enum a => Int -> a
toEnum Int
0x41  {-  65 41 -}
sustenuto :: T
sustenuto                 = forall a. Enum a => Int -> a
toEnum Int
0x42  {-  66 42 -}
softPedal :: T
softPedal                 = forall a. Enum a => Int -> a
toEnum Int
0x43  {-  67 43 -}
hold2 :: T
hold2                     = forall a. Enum a => Int -> a
toEnum Int
0x45  {-  69 45 -}
generalPurpose5 :: T
generalPurpose5           = forall a. Enum a => Int -> a
toEnum Int
0x50  {-  80 50 -}
generalPurpose6 :: T
generalPurpose6           = forall a. Enum a => Int -> a
toEnum Int
0x51  {-  81 51 -}
generalPurpose7 :: T
generalPurpose7           = forall a. Enum a => Int -> a
toEnum Int
0x52  {-  82 52 -}
generalPurpose8 :: T
generalPurpose8           = forall a. Enum a => Int -> a
toEnum Int
0x53  {-  83 53 -}
extDepth :: T
extDepth                  = forall a. Enum a => Int -> a
toEnum Int
0x5B  {-  91 5B -}
tremoloDepth :: T
tremoloDepth              = forall a. Enum a => Int -> a
toEnum Int
0x5C  {-  92 5C -}
chorusDepth :: T
chorusDepth               = forall a. Enum a => Int -> a
toEnum Int
0x5D  {-  93 5D -}
celesteDepth :: T
celesteDepth              = forall a. Enum a => Int -> a
toEnum Int
0x5E  {-  94 5E -}
phaserDepth :: T
phaserDepth               = forall a. Enum a => Int -> a
toEnum Int
0x5F  {-  95 5F -}

dataIncrement :: T
dataIncrement             = forall a. Enum a => Int -> a
toEnum Int
0x60  {-  96 60 -}
dataDecrement :: T
dataDecrement             = forall a. Enum a => Int -> a
toEnum Int
0x61  {-  97 61 -}
nonRegisteredParameterLSB :: T
nonRegisteredParameterLSB = forall a. Enum a => Int -> a
toEnum Int
0x62  {-  98 62 -}
nonRegisteredParameterMSB :: T
nonRegisteredParameterMSB = forall a. Enum a => Int -> a
toEnum Int
0x63  {-  99 63 -}
registeredParameterLSB :: T
registeredParameterLSB    = forall a. Enum a => Int -> a
toEnum Int
0x64  {- 100 64 -}
registeredParameterMSB :: T
registeredParameterMSB    = forall a. Enum a => Int -> a
toEnum Int
0x65  {- 101 65 -}


-- * serialization

get :: Parser.C parser => Int -> Int -> Parser.Fragile parser T
get :: forall (parser :: * -> *).
C parser =>
Int -> Int -> Fragile parser T
get Int
code Int
firstData =
   let pitch :: Pitch
pitch  = Int -> Pitch
toPitch Int
firstData
       getVel :: ExceptionalT String parser Velocity
getVel = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Int -> Velocity
toVelocity forall (parser :: * -> *). C parser => Fragile parser Int
get1
   in  case Int
code of
          Int
08 -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Pitch -> Velocity -> T
NoteOff        Pitch
pitch) ExceptionalT String parser Velocity
getVel
          Int
09 -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Pitch -> Velocity -> T
NoteOn         Pitch
pitch) ExceptionalT String parser Velocity
getVel
          Int
10 -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Pitch -> Int -> T
PolyAftertouch Pitch
pitch) forall (parser :: * -> *). C parser => Fragile parser Int
get1
          {-
          Whether firstData is a controller and not a mode
          is checked in Message.Channel.get.
          -}
          Int
11 -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (T -> Int -> T
Control (forall a. Enum a => Int -> a
toEnum Int
firstData)) forall (parser :: * -> *). C parser => Fragile parser Int
get1
          Int
12 -> forall (m :: * -> *) a. Monad m => a -> m a
return (Program -> T
ProgramChange (Int -> Program
toProgram Int
firstData))
          Int
13 -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> T
MonoAftertouch Int
firstData)
          Int
14 -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\Int
msb -> Int -> T
PitchBend (Int
firstDataforall a. Num a => a -> a -> a
+Int
128forall a. Num a => a -> a -> a
*Int
msb)) forall (parser :: * -> *). C parser => Fragile parser Int
get1
          Int
_  -> forall (m :: * -> *) a. Monad m => String -> T m a
Parser.giveUp (String
"invalid Voice message code:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
code)


putWithStatus :: Writer.C writer =>
   (Int -> StatusWriter.T compress writer) ->
   T -> StatusWriter.T compress writer
putWithStatus :: forall writer compress.
C writer =>
(Int -> T compress writer) -> T -> T compress writer
putWithStatus Int -> T compress writer
putChan T
e =
   let putC :: Int -> [a] -> T compress writer
putC Int
code [a]
bytes =
          Int -> T compress writer
putChan Int
code forall m. Monoid m => m -> m -> m
+#+
          forall writer compress.
Monoid writer =>
writer -> T compress writer
StatusWriter.fromWriter (forall writer. C writer => ByteList -> writer
Writer.putByteList (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [a]
bytes))
   in  case T
e of
          NoteOff        Pitch
p  Velocity
v  -> forall {a}. Integral a => Int -> [a] -> T compress writer
putC  Int
8 [Pitch -> Int
fromPitch Pitch
p, Velocity -> Int
fromVelocity Velocity
v]
          NoteOn         Pitch
p  Velocity
v  -> forall {a}. Integral a => Int -> [a] -> T compress writer
putC  Int
9 [Pitch -> Int
fromPitch Pitch
p, Velocity -> Int
fromVelocity Velocity
v]
          PolyAftertouch Pitch
p  Int
pr -> forall {a}. Integral a => Int -> [a] -> T compress writer
putC Int
10 [Pitch -> Int
fromPitch Pitch
p, Int
pr]
          Control        T
cn Int
cv -> forall {a}. Integral a => Int -> [a] -> T compress writer
putC Int
11 [forall a. Enum a => a -> Int
fromEnum T
cn, Int
cv]
          ProgramChange  Program
pn -> forall {a}. Integral a => Int -> [a] -> T compress writer
putC Int
12 [Program -> Int
fromProgram Program
pn]
          MonoAftertouch Int
pr -> forall {a}. Integral a => Int -> [a] -> T compress writer
putC Int
13 [Int
pr]
          PitchBend      Int
pb ->
             let (Int
hi,Int
lo) = forall a. Integral a => Int -> a -> (a, a)
Bit.splitAt Int
7 Int
pb in forall {a}. Integral a => Int -> [a] -> T compress writer
putC Int
14 [Int
lo,Int
hi] -- little-endian!!