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), )
data T =
NoteOff Pitch Velocity
| NoteOn Pitch Velocity
| PolyAftertouch Pitch Pressure
| ProgramChange Program
| 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
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
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
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
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
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
instance Enum Program where
toEnum :: Int -> Program
toEnum = Int -> Program
toProgram
fromEnum :: Program -> Int
fromEnum = Program -> Int
fromProgram
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
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
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
zeroKey :: Pitch
zeroKey :: Pitch
zeroKey = Int -> Pitch
toPitch Int
48
normalVelocity, maximumVelocity :: Velocity
normalVelocity :: Velocity
normalVelocity = Int -> Velocity
Velocity Int
64
maximumVelocity :: Velocity
maximumVelocity = Velocity
forall a. Bounded a => a
maxBound
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
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
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
= 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
bankSelectMSB, modulationMSB, breathControlMSB, footControlMSB,
portamentoTimeMSB, dataEntryMSB,
mainVolumeMSB, balanceMSB, panoramaMSB, expressionMSB,
generalPurpose1MSB, generalPurpose2MSB,
generalPurpose3MSB, generalPurpose4MSB :: Ctrl.T
bankSelectLSB, modulationLSB, breathControlLSB, footControlLSB,
portamentoTimeLSB, dataEntryLSB,
mainVolumeLSB, balanceLSB, panoramaLSB, expressionLSB,
generalPurpose1LSB, generalPurpose2LSB,
generalPurpose3LSB, generalPurpose4LSB :: Ctrl.T
sustain, porta, sustenuto, softPedal, hold2,
generalPurpose5, generalPurpose6, generalPurpose7, generalPurpose8,
extDepth, tremoloDepth, chorusDepth, celesteDepth, phaserDepth :: Ctrl.T
dataIncrement, dataDecrement,
nonRegisteredParameterLSB, nonRegisteredParameterMSB,
registeredParameterLSB, registeredParameterMSB :: Ctrl.T
bankSelectMSB :: T
bankSelectMSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x00
modulationMSB :: T
modulationMSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x01
breathControlMSB :: T
breathControlMSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x02
= Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x04
portamentoTimeMSB :: T
portamentoTimeMSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x05
dataEntryMSB :: T
dataEntryMSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x06
mainVolumeMSB :: T
mainVolumeMSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x07
balanceMSB :: T
balanceMSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x08
panoramaMSB :: T
panoramaMSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x0A
expressionMSB :: T
expressionMSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x0B
generalPurpose1MSB :: T
generalPurpose1MSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x10
generalPurpose2MSB :: T
generalPurpose2MSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x11
generalPurpose3MSB :: T
generalPurpose3MSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x12
generalPurpose4MSB :: T
generalPurpose4MSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x13
bankSelectLSB :: T
bankSelectLSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x20
modulationLSB :: T
modulationLSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x21
breathControlLSB :: T
breathControlLSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x22
= Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x24
portamentoTimeLSB :: T
portamentoTimeLSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x25
dataEntryLSB :: T
dataEntryLSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x26
mainVolumeLSB :: T
mainVolumeLSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x27
balanceLSB :: T
balanceLSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x28
panoramaLSB :: T
panoramaLSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x2A
expressionLSB :: T
expressionLSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x2B
generalPurpose1LSB :: T
generalPurpose1LSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x30
generalPurpose2LSB :: T
generalPurpose2LSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x31
generalPurpose3LSB :: T
generalPurpose3LSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x32
generalPurpose4LSB :: T
generalPurpose4LSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x33
sustain :: T
sustain = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x40
porta :: T
porta = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x41
sustenuto :: T
sustenuto = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x42
softPedal :: T
softPedal = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x43
hold2 :: T
hold2 = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x45
generalPurpose5 :: T
generalPurpose5 = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x50
generalPurpose6 :: T
generalPurpose6 = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x51
generalPurpose7 :: T
generalPurpose7 = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x52
generalPurpose8 :: T
generalPurpose8 = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x53
extDepth :: T
extDepth = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x5B
tremoloDepth :: T
tremoloDepth = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x5C
chorusDepth :: T
chorusDepth = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x5D
celesteDepth :: T
celesteDepth = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x5E
phaserDepth :: T
phaserDepth = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x5F
dataIncrement :: T
dataIncrement = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x60
dataDecrement :: T
dataDecrement = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x61
nonRegisteredParameterLSB :: T
nonRegisteredParameterLSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x62
nonRegisteredParameterMSB :: T
nonRegisteredParameterMSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x63
registeredParameterLSB :: T
registeredParameterLSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x64
registeredParameterMSB :: T
registeredParameterMSB = Int -> T
forall a. Enum a => Int -> a
toEnum Int
0x65
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
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]