module Sound.MIDI.Event(
T(..),
Pitch, Program,
Channel, Controller(..), ControllerValue, PitchBendRange, Pressure, Velocity,
isNote, isNoteOn, isNoteOff, zeroKey,
maximumVelocity, normalVelocity, toFloatVelocity,
toFloatController,
bankSelect, modulation, breathControl, footControl, portamentoTime,
dataEntry, mainVolume, balance, panorama, expression,
generalPurpose1, generalPurpose2, generalPurpose3, generalPurpose4,
vectorX, vectorY,
fromPitch, toPitch,
fromVelocity, toVelocity,
fromProgram, toProgram,
fromChannel, toChannel,
increasePitch, subtractPitch,
) where
newtype Pitch = Pitch {fromPitch :: Int} deriving (Show, Eq, Ord)
newtype Velocity = Velocity {fromVelocity :: Int} deriving (Show, Eq, Ord)
newtype Program = Program {fromProgram :: Int} deriving (Show, Eq, Ord)
newtype Channel = Channel {fromChannel :: Int} deriving (Show, Eq, Ord)
toPitch :: Int -> Pitch
toPitch = checkRange "Pitch" Pitch
toVelocity :: Int -> Velocity
toVelocity = checkRange "Velocity" Velocity
toProgram :: Int -> Program
toProgram = checkRange "Program" Program
toChannel :: Int -> Channel
toChannel = checkRange "Channel" Channel
checkRange :: (Bounded a, Ord a, Show a) =>
String -> (Int -> a) -> Int -> a
checkRange typ f x =
let y = f x
in if minBound <= y && y <= maxBound
then y
else error (typ ++ ": value " ++ show x ++ " outside range " ++
show ((minBound, maxBound) `asTypeOf` (y,y)))
instance Enum Program where
toEnum = toProgram
fromEnum = fromProgram
instance Enum Channel where
toEnum = toChannel
fromEnum = fromChannel
instance Enum Pitch where
toEnum = toPitch
fromEnum = fromPitch
increasePitch :: Int -> Pitch -> Pitch
increasePitch d = toPitch . (d+) . fromPitch
subtractPitch :: Pitch -> Pitch -> Int
subtractPitch (Pitch p0) (Pitch p1) = p1p0
instance Bounded Pitch where
minBound = Pitch 0
maxBound = Pitch 127
instance Bounded Velocity where
minBound = Velocity 0
maxBound = Velocity 127
instance Bounded Program where
minBound = Program 0
maxBound = Program 127
instance Bounded Channel where
minBound = Channel 0
maxBound = Channel 15
zeroKey :: Pitch
zeroKey = toPitch 48
normalVelocity, maximumVelocity :: Num quant => quant
normalVelocity = 64
maximumVelocity = 127
toFloatVelocity :: (Integral a, Fractional b) => a -> b
toFloatVelocity x = fromIntegral x / normalVelocity
maximumControllerValue :: Num quant => quant
maximumControllerValue = 127
toFloatController :: (Integral a, Fractional b) => a -> b
toFloatController x = fromIntegral x / maximumControllerValue
type PitchBendRange = Int
type Pressure = Int
type ControllerValue = Int
data T =
NoteOff Pitch Velocity
| NoteOn Pitch Velocity
| PolyAfter Pitch Pressure
| ProgramChange Program
| Control Controller ControllerValue
| PitchBend PitchBendRange
| MonoAfter Pressure
deriving (Show, Eq, Ord)
isNote :: T -> Bool
isNote (NoteOn _ _) = True
isNote (NoteOff _ _) = True
isNote _ = False
isNoteOn :: T -> Bool
isNoteOn (NoteOn _ _) = True
isNoteOn _ = False
isNoteOff :: T -> Bool
isNoteOff (NoteOff _ _) = True
isNoteOff _ = False
data Controller =
BankSelectMSB
| ModulationMSB
| BreathControlMSB
| Controller03
| FootControlMSB
| PortamentoTimeMSB
| DataEntryMSB
| MainVolumeMSB
| BalanceMSB
| Controller09
| PanoramaMSB
| ExpressionMSB
| Controller0C
| Controller0D
| Controller0E
| Controller0F
| GeneralPurpose1MSB
| GeneralPurpose2MSB
| GeneralPurpose3MSB
| GeneralPurpose4MSB
| Controller14
| Controller15
| Controller16
| Controller17
| Controller18
| Controller19
| Controller1A
| Controller1B
| Controller1C
| Controller1D
| Controller1E
| Controller1F
| BankSelectLSB
| ModulationLSB
| BreathControlLSB
| Controller23
| FootControlLSB
| PortamentoTimeLSB
| DataEntryLSB
| MainVolumeLSB
| BalanceLSB
| Controller29
| PanoramaLSB
| ExpressionLSB
| Controller2C
| Controller2D
| Controller2E
| Controller2F
| GeneralPurpose1LSB
| GeneralPurpose2LSB
| GeneralPurpose3LSB
| GeneralPurpose4LSB
| Controller34
| Controller35
| Controller36
| Controller37
| Controller38
| Controller39
| Controller3A
| Controller3B
| Controller3C
| Controller3D
| Controller3E
| Controller3F
| Sustain
| Porta
| Sustenuto
| SoftPedal
| Controller44
| Hold2
| Controller46
| Controller47
| Controller48
| Controller49
| Controller4A
| Controller4B
| Controller4C
| Controller4D
| Controller4E
| Controller4F
| GeneralPurpose5
| GeneralPurpose6
| GeneralPurpose7
| GeneralPurpose8
| Controller54
| Controller55
| Controller56
| Controller57
| Controller58
| Controller59
| Controller5A
| ExtDepth
| TremoloDepth
| ChorusDepth
| CelesteDepth
| PhaserDepth
| DataIncrement
| DataDecrement
| NonRegisteredParameterLSB
| NonRegisteredParameterMSB
| RegisteredParameterLSB
| RegisteredParameterMSB
| Controller66
| Controller67
| Controller68
| Controller69
| Controller6A
| Controller6B
| Controller6C
| Controller6D
| Controller6E
| Controller6F
| Controller70
| Controller71
| Controller72
| Controller73
| Controller74
| Controller75
| Controller76
| Controller77
| Controller78
| Controller79
| Controller7A
| Controller7B
| Controller7C
| Controller7D
| Controller7E
| Controller7F
deriving (Show, Eq, Ord, Enum)
bankSelect, modulation, breathControl, footControl, portamentoTime,
dataEntry, mainVolume, balance, panorama, expression,
generalPurpose1, generalPurpose2, generalPurpose3, generalPurpose4,
vectorX, vectorY :: Controller
bankSelect = BankSelectMSB
modulation = ModulationMSB
breathControl = BreathControlMSB
footControl = FootControlMSB
portamentoTime = PortamentoTimeMSB
dataEntry = DataEntryMSB
mainVolume = MainVolumeMSB
balance = BalanceMSB
panorama = PanoramaMSB
expression = ExpressionMSB
generalPurpose1 = GeneralPurpose1MSB
generalPurpose2 = GeneralPurpose2MSB
generalPurpose3 = GeneralPurpose3MSB
generalPurpose4 = GeneralPurpose4MSB
vectorX = generalPurpose1
vectorY = generalPurpose2