{- | Datatype for MIDI events as they can be sent to a synthesizer. That is, no timing is handled here. Taken from Haskore. -} module Sound.MIDI.Event( T(..), Pitch, Program, Channel, Controller(..), ControllerValue, PitchBendRange, Pressure, Velocity, isNote, isNoteOn, isNoteOff, zeroKey, maximumVelocity, normalVelocity, toFloatVelocity, toFloatController, bankSelect, modulation, breathControl, footControl, portamentoTime, dataEntry, mainVolume, balance, panorama, expression, generalPurpose1, generalPurpose2, generalPurpose3, generalPurpose4, vectorX, vectorY, fromPitch, toPitch, fromVelocity, toVelocity, fromProgram, toProgram, fromChannel, toChannel, increasePitch, subtractPitch, ) where {- * MIDI Events -} 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 -- typical methods of a type class for affine spaces increasePitch :: Int -> Pitch -> Pitch increasePitch d = toPitch . (d+) . fromPitch subtractPitch :: Pitch -> Pitch -> Int subtractPitch (Pitch p0) (Pitch p1) = p1-p0 instance Bounded Pitch where minBound = Pitch 0 maxBound = Pitch 127 instance Bounded Velocity where minBound = Velocity 0 maxBound = Velocity 127 instance Bounded Program where minBound = Program 0 maxBound = Program 127 instance Bounded Channel where minBound = Channel 0 maxBound = Channel 15 {- | A MIDI problem is that one cannot uniquely map a MIDI key to a frequency. The frequency depends on the instrument. I don't know if the deviations are defined for General MIDI. If this applies one could add transposition information to the use patch map. For now I have chosen a value that leads to the right frequency for some piano sound in my setup. -} zeroKey :: Pitch zeroKey = toPitch 48 {- | The velocity of an ordinary key stroke and the maximum possible velocity. -} normalVelocity, maximumVelocity :: Num quant => quant -- Velocity normalVelocity = 64 maximumVelocity = 127 {- | 64 is given as default value by the MIDI specification and thus we map it to 1. -} 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 {- | Types of predefined MIDI controllers. -} data Controller = {- 00 00 -} BankSelectMSB | {- 01 01 -} ModulationMSB | {- 02 02 -} BreathControlMSB | {- 03 03 -} Controller03 | {- 04 04 -} FootControlMSB | {- 05 05 -} PortamentoTimeMSB | {- 06 06 -} DataEntryMSB | {- 07 07 -} MainVolumeMSB | {- 08 08 -} BalanceMSB | {- 09 09 -} Controller09 | {- 10 0A -} PanoramaMSB | {- 11 0B -} ExpressionMSB | {- 12 0C -} Controller0C | {- 13 0D -} Controller0D | {- 14 0E -} Controller0E | {- 15 0F -} Controller0F | {- 16 10 -} GeneralPurpose1MSB | {- 17 11 -} GeneralPurpose2MSB | {- 18 12 -} GeneralPurpose3MSB | {- 19 13 -} GeneralPurpose4MSB | {- 20 14 -} Controller14 | {- 21 15 -} Controller15 | {- 22 16 -} Controller16 | {- 23 17 -} Controller17 | {- 24 18 -} Controller18 | {- 25 19 -} Controller19 | {- 26 1A -} Controller1A | {- 27 1B -} Controller1B | {- 28 1C -} Controller1C | {- 29 1D -} Controller1D | {- 30 1E -} Controller1E | {- 31 1F -} Controller1F | {- 32 20 -} BankSelectLSB | {- 33 21 -} ModulationLSB | {- 34 22 -} BreathControlLSB | {- 35 23 -} Controller23 | {- 36 24 -} FootControlLSB | {- 37 25 -} PortamentoTimeLSB | {- 38 26 -} DataEntryLSB | {- 39 27 -} MainVolumeLSB | {- 40 28 -} BalanceLSB | {- 41 29 -} Controller29 | {- 42 2A -} PanoramaLSB | {- 43 2B -} ExpressionLSB | {- 44 2C -} Controller2C | {- 45 2D -} Controller2D | {- 46 2E -} Controller2E | {- 47 2F -} Controller2F | {- 48 30 -} GeneralPurpose1LSB | {- 49 31 -} GeneralPurpose2LSB | {- 50 32 -} GeneralPurpose3LSB | {- 51 33 -} GeneralPurpose4LSB | {- 52 34 -} Controller34 | {- 53 35 -} Controller35 | {- 54 36 -} Controller36 | {- 55 37 -} Controller37 | {- 56 38 -} Controller38 | {- 57 39 -} Controller39 | {- 58 3A -} Controller3A | {- 59 3B -} Controller3B | {- 60 3C -} Controller3C | {- 61 3D -} Controller3D | {- 62 3E -} Controller3E | {- 63 3F -} Controller3F {- Continuous 7 bit (switches: 0-3f=off, 40-7f=on) -} | {- 64 40 -} Sustain | {- 65 41 -} Porta | {- 66 42 -} Sustenuto | {- 67 43 -} SoftPedal | {- 68 44 -} Controller44 | {- 69 45 -} Hold2 | {- 70 46 -} Controller46 | {- 71 47 -} Controller47 | {- 72 48 -} Controller48 | {- 73 49 -} Controller49 | {- 74 4A -} Controller4A | {- 75 4B -} Controller4B | {- 76 4C -} Controller4C | {- 77 4D -} Controller4D | {- 78 4E -} Controller4E | {- 79 4F -} Controller4F | {- 80 50 -} GeneralPurpose5 | {- 81 51 -} GeneralPurpose6 | {- 82 52 -} GeneralPurpose7 | {- 83 53 -} GeneralPurpose8 | {- 84 54 -} Controller54 | {- 85 55 -} Controller55 | {- 86 56 -} Controller56 | {- 87 57 -} Controller57 | {- 88 58 -} Controller58 | {- 89 59 -} Controller59 | {- 90 5A -} Controller5A | {- 91 5B -} ExtDepth | {- 92 5C -} TremoloDepth | {- 93 5D -} ChorusDepth | {- 94 5E -} CelesteDepth | {- 95 5F -} PhaserDepth {- Parameters -} | {- 96 60 -} DataIncrement | {- 97 61 -} DataDecrement | {- 98 62 -} NonRegisteredParameterLSB | {- 99 63 -} NonRegisteredParameterMSB | {- 100 64 -} RegisteredParameterLSB | {- 101 65 -} RegisteredParameterMSB | {- 102 66 -} Controller66 | {- 103 67 -} Controller67 | {- 104 68 -} Controller68 | {- 105 69 -} Controller69 | {- 106 6A -} Controller6A | {- 107 6B -} Controller6B | {- 108 6C -} Controller6C | {- 109 6D -} Controller6D | {- 110 6E -} Controller6E | {- 111 6F -} Controller6F | {- 112 70 -} Controller70 | {- 113 71 -} Controller71 | {- 114 72 -} Controller72 | {- 115 73 -} Controller73 | {- 116 74 -} Controller74 | {- 117 75 -} Controller75 | {- 118 76 -} Controller76 | {- 119 77 -} Controller77 | {- 120 78 -} Controller78 | {- 121 79 -} Controller79 | {- 122 7A -} Controller7A | {- 123 7B -} Controller7B | {- 124 7C -} Controller7C | {- 125 7D -} Controller7D | {- 126 7E -} Controller7E | {- 127 7F -} Controller7F deriving (Show, Eq, Ord, Enum) bankSelect, modulation, breathControl, footControl, portamentoTime, dataEntry, mainVolume, balance, panorama, expression, generalPurpose1, generalPurpose2, generalPurpose3, generalPurpose4, vectorX, vectorY :: Controller bankSelect = BankSelectMSB modulation = ModulationMSB breathControl = BreathControlMSB footControl = FootControlMSB portamentoTime = PortamentoTimeMSB dataEntry = DataEntryMSB mainVolume = MainVolumeMSB balance = BalanceMSB panorama = PanoramaMSB expression = ExpressionMSB generalPurpose1 = GeneralPurpose1MSB generalPurpose2 = GeneralPurpose2MSB generalPurpose3 = GeneralPurpose3MSB generalPurpose4 = GeneralPurpose4MSB vectorX = generalPurpose1 vectorY = generalPurpose2