{- |
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
(Int -> T -> ShowS) -> (T -> String) -> ([T] -> ShowS) -> Show T
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
(T -> T -> Bool) -> (T -> T -> Bool) -> Eq T
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
Eq T
-> (T -> T -> Ordering)
-> (T -> T -> Bool)
-> (T -> T -> Bool)
-> (T -> T -> Bool)
-> (T -> T -> Bool)
-> (T -> T -> T)
-> (T -> T -> T)
-> Ord 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
$cp1Ord :: Eq T
Ord)


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


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

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


instance Random Velocity where
   random :: g -> (Velocity, g)
random  = (Velocity -> Int) -> (Int -> Velocity) -> g -> (Velocity, g)
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 :: (Velocity, Velocity) -> g -> (Velocity, g)
randomR = (Velocity -> Int)
-> (Int -> Velocity) -> (Velocity, Velocity) -> g -> (Velocity, g)
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 = (Velocity -> Int) -> (Int -> Velocity) -> Gen Velocity
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 :: g -> (Program, g)
random  = g -> (Program, g)
forall a g. (Enum a, Bounded a, RandomGen g) => g -> (a, g)
boundedEnumRandom
   randomR :: (Program, Program) -> g -> (Program, g)
randomR = (Program, Program) -> g -> (Program, g)
forall a g. (Enum a, RandomGen g) => (a, a) -> g -> (a, g)
enumRandomR

instance Arbitrary Program where
   arbitrary :: Gen Program
arbitrary = Gen Program
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 Velocity -> Velocity -> Bool
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 Velocity -> Velocity -> Bool
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 Velocity -> Velocity -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Velocity
toVelocity Int
0
           then Pitch -> Velocity -> T
NoteOff Pitch
p (Velocity -> T) -> Velocity -> T
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 Velocity -> Velocity -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Velocity
toVelocity Int
64
           then Pitch -> Velocity -> T
NoteOn Pitch
p (Velocity -> T) -> Velocity -> T
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
(Int -> Pitch -> ShowS)
-> (Pitch -> String) -> ([Pitch] -> ShowS) -> Show Pitch
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
(Pitch -> Pitch -> Bool) -> (Pitch -> Pitch -> Bool) -> Eq Pitch
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
Eq Pitch
-> (Pitch -> Pitch -> Ordering)
-> (Pitch -> Pitch -> Bool)
-> (Pitch -> Pitch -> Bool)
-> (Pitch -> Pitch -> Bool)
-> (Pitch -> Pitch -> Bool)
-> (Pitch -> Pitch -> Pitch)
-> (Pitch -> Pitch -> Pitch)
-> Ord 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
$cp1Ord :: Eq Pitch
Ord, Ord Pitch
Ord Pitch
-> ((Pitch, Pitch) -> [Pitch])
-> ((Pitch, Pitch) -> Pitch -> Int)
-> ((Pitch, Pitch) -> Pitch -> Int)
-> ((Pitch, Pitch) -> Pitch -> Bool)
-> ((Pitch, Pitch) -> Int)
-> ((Pitch, Pitch) -> Int)
-> Ix 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]
$cp1Ix :: Ord Pitch
Ix)
newtype Velocity   = Velocity   {Velocity -> Int
fromVelocity   :: Int} deriving (Int -> Velocity -> ShowS
[Velocity] -> ShowS
Velocity -> String
(Int -> Velocity -> ShowS)
-> (Velocity -> String) -> ([Velocity] -> ShowS) -> Show Velocity
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
(Velocity -> Velocity -> Bool)
-> (Velocity -> Velocity -> Bool) -> Eq Velocity
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
Eq Velocity
-> (Velocity -> Velocity -> Ordering)
-> (Velocity -> Velocity -> Bool)
-> (Velocity -> Velocity -> Bool)
-> (Velocity -> Velocity -> Bool)
-> (Velocity -> Velocity -> Bool)
-> (Velocity -> Velocity -> Velocity)
-> (Velocity -> Velocity -> Velocity)
-> Ord 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
$cp1Ord :: Eq Velocity
Ord)
newtype Program    = Program    {Program -> Int
fromProgram    :: Int} deriving (Int -> Program -> ShowS
[Program] -> ShowS
Program -> String
(Int -> Program -> ShowS)
-> (Program -> String) -> ([Program] -> ShowS) -> Show Program
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
(Program -> Program -> Bool)
-> (Program -> Program -> Bool) -> Eq Program
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
Eq Program
-> (Program -> Program -> Ordering)
-> (Program -> Program -> Bool)
-> (Program -> Program -> Bool)
-> (Program -> Program -> Bool)
-> (Program -> Program -> Bool)
-> (Program -> Program -> Program)
-> (Program -> Program -> Program)
-> Ord 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
$cp1Ord :: Eq Program
Ord, Ord Program
Ord Program
-> ((Program, Program) -> [Program])
-> ((Program, Program) -> Program -> Int)
-> ((Program, Program) -> Program -> Int)
-> ((Program, Program) -> Program -> Bool)
-> ((Program, Program) -> Int)
-> ((Program, Program) -> Int)
-> Ix 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]
$cp1Ix :: Ord Program
Ix)


toPitch :: Int -> Pitch
toPitch :: Int -> Pitch
toPitch = String -> (Int -> Pitch) -> Int -> Pitch
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 = String -> (Int -> Velocity) -> Int -> Velocity
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 = String -> (Int -> Program) -> Int -> Program
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 (Int -> Pitch) -> (Pitch -> Int) -> Pitch -> Pitch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Pitch -> Int) -> Pitch -> Int
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
p1Int -> Int -> Int
forall 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 :: Pitch -> a
frequencyFromPitch (Pitch Int
p) =
   a
440 a -> a -> a
forall a. Num a => a -> a -> a
* a
2 a -> a -> a
forall a. Floating a => a -> a -> a
** (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
6Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
12) a -> a -> a
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 = Velocity
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 :: Velocity -> b
realFromVelocity (Velocity Int
x) =
   Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Velocity -> Int
fromVelocity Velocity
normalVelocity) b -> b -> b
forall a. Fractional a => a -> a -> a
/
   Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Velocity -> Int
fromVelocity Velocity
maximumVelocity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Velocity -> Int
fromVelocity Velocity
normalVelocity)


maximumControllerValue :: Num a => a
maximumControllerValue :: 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 :: a -> b
realFromControllerValue a
x = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x b -> b -> b
forall a. Fractional a => a -> a -> a
/ b
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             = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x00  {-  00 00 -}
modulationMSB :: T
modulationMSB             = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x01  {-  01 01 -}
breathControlMSB :: T
breathControlMSB          = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x02  {-  02 02 -}
footControlMSB :: T
footControlMSB            = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x04  {-  04 04 -}
portamentoTimeMSB :: T
portamentoTimeMSB         = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x05  {-  05 05 -}
dataEntryMSB :: T
dataEntryMSB              = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x06  {-  06 06 -}
mainVolumeMSB :: T
mainVolumeMSB             = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x07  {-  07 07 -}
balanceMSB :: T
balanceMSB                = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x08  {-  08 08 -}
panoramaMSB :: T
panoramaMSB               = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x0A  {-  10 0A -}
expressionMSB :: T
expressionMSB             = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x0B  {-  11 0B -}
generalPurpose1MSB :: T
generalPurpose1MSB        = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x10  {-  16 10 -}
generalPurpose2MSB :: T
generalPurpose2MSB        = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x11  {-  17 11 -}
generalPurpose3MSB :: T
generalPurpose3MSB        = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x12  {-  18 12 -}
generalPurpose4MSB :: T
generalPurpose4MSB        = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x13  {-  19 13 -}

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

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

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


-- * serialization

get :: Parser.C parser => Int -> Int -> Parser.Fragile parser T
get :: 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 = (Int -> Velocity)
-> ExceptionalT String parser Int
-> ExceptionalT String parser Velocity
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Int -> Velocity
toVelocity ExceptionalT String parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get1
   in  case Int
code of
          Int
08 -> (Velocity -> T)
-> ExceptionalT String parser Velocity -> Fragile parser T
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 -> (Velocity -> T)
-> ExceptionalT String parser Velocity -> Fragile parser T
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 -> (Int -> T) -> ExceptionalT String parser Int -> Fragile parser T
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Pitch -> Int -> T
PolyAftertouch Pitch
pitch) ExceptionalT String parser Int
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 -> (Int -> T) -> ExceptionalT String parser Int -> Fragile parser T
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (T -> Int -> T
Control (Int -> T
forall a. Enum a => Int -> a
toEnum Int
firstData)) ExceptionalT String parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get1
          Int
12 -> T -> Fragile parser T
forall (m :: * -> *) a. Monad m => a -> m a
return (Program -> T
ProgramChange (Int -> Program
toProgram Int
firstData))
          Int
13 -> T -> Fragile parser T
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> T
MonoAftertouch Int
firstData)
          Int
14 -> (Int -> T) -> ExceptionalT String parser Int -> Fragile parser T
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\Int
msb -> Int -> T
PitchBend (Int
firstDataInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
128Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
msb)) ExceptionalT String parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get1
          Int
_  -> String -> Fragile parser T
forall (m :: * -> *) a. Monad m => String -> T m a
Parser.giveUp (String
"invalid Voice message code:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
code)


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