diff --git a/midi.cabal b/midi.cabal --- a/midi.cabal +++ b/midi.cabal @@ -1,23 +1,24 @@ Name: midi -Version: 0.1.5.2 +Version: 0.1.6 License: GPL License-File: LICENSE Author: Henning Thielemann Maintainer: Henning Thielemann Homepage: http://www.haskell.org/haskellwiki/MIDI Category: Sound, Music +Tested-With: GHC==6.4.1, GHC==6.8.2, GHC==6.10.4, GHC==6.12.3, GHC==7.0.4, GHC==7.2.1 +Cabal-Version: >=1.6 Build-Type: Simple Synopsis: Handling of MIDI messages and files Description: MIDI is the Musical Instrument Digital Interface. The package contains definition of realtime and file MIDI messages, - reading and writing MIDI files. + reading and writing MIDI files, + and some definitions from General MIDI standard. It contains no sending and receiving of MIDI messages. - Cf. @alsa-seq@, @PortMidi@, @alsa@, @alsa-midi@ and @hmidi@ packages. + Cf. @alsa-seq@, @PortMidi@, @hmidi@, @alsa@, @alsa-midi@ packages. For music composition with MIDI output, see @haskore@. -Tested-With: GHC==6.4.1, GHC==6.8.2, GHC==6.10.4 -Cabal-Version: >=1.6 -Build-Type: Simple + Alternate packages are @HCodecs@, @zmidi-core@. Extra-Source-Files: Makefile src/Sound/MIDI/Example/Tomatosalad.hs @@ -28,7 +29,7 @@ Source-Repository this type: darcs location: http://code.haskell.org/~thielema/midi/ - tag: 0.1.5.2 + tag: 0.1.6 Flag splitBase description: Choose the new smaller, split-up base package. @@ -73,6 +74,7 @@ Sound.MIDI.Message.System.Exclusive Sound.MIDI.Message.System.Common Sound.MIDI.Message.System.RealTime + Sound.MIDI.Controller Sound.MIDI.Manufacturer Sound.MIDI.General -- exports ByteList data type @@ -97,6 +99,8 @@ Sound.MIDI.Monoid Sound.MIDI.String Sound.MIDI.Utility + -- type definition + Sound.MIDI.ControllerPrivate -- didactic example Sound.MIDI.Example.ControllerRamp diff --git a/src/Sound/MIDI/Controller.hs b/src/Sound/MIDI/Controller.hs new file mode 100644 --- /dev/null +++ b/src/Sound/MIDI/Controller.hs @@ -0,0 +1,231 @@ +{- | +MIDI controller data type and common controller definitions. + +See . +-} +module Sound.MIDI.Controller ( + T, Value, fromInt, toInt, + + bankSelect, modulation, breathControl, footControl, portamentoTime, + dataEntry, volume, balance, panorama, expression, + effectControl1, effectControl2, + generalPurpose1, generalPurpose2, generalPurpose3, generalPurpose4, + vectorX, vectorY, + soundController1, soundController2, soundController3, + soundController4, soundController5, soundController6, + soundController7, soundController8, soundController9, + soundController10, portamentoControl, + effect1Depth, effect2Depth, effect3Depth, effect4Depth, effect5Depth, + + bankSelectMSB, modulationMSB, breathControlMSB, footControlMSB, + portamentoTimeMSB, dataEntryMSB, volumeMSB, balanceMSB, + panoramaMSB, expressionMSB, + effectControl1MSB, effectControl2MSB, + generalPurpose1MSB, generalPurpose2MSB, + generalPurpose3MSB, generalPurpose4MSB, + + bankSelectLSB, modulationLSB, breathControlLSB, footControlLSB, + portamentoTimeLSB, dataEntryLSB, volumeLSB, balanceLSB, + panoramaLSB, expressionLSB, + effectControl1LSB, effectControl2LSB, + generalPurpose1LSB, generalPurpose2LSB, + generalPurpose3LSB, generalPurpose4LSB, + + soundVariation, timbre, harmonicIntensity, + releaseTime, attackTime, brightness, decayTime, + vibratoRate, vibratoDepth, vibratoDelay, + reverbSendLevel, chorusSendLevel, legato, + + sustain, portamento, sustenuto, softPedal, hold2, + generalPurpose5, generalPurpose6, generalPurpose7, generalPurpose8, + externalEffectDepth, tremoloDepth, chorusDepth, celesteDepth, phaserDepth, + + dataIncrement, dataDecrement, + nonRegisteredParameterLSB, nonRegisteredParameterMSB, + registeredParameterLSB, registeredParameterMSB, + ) where + +import qualified Sound.MIDI.ControllerPrivate as CtrlP + +import Sound.MIDI.Utility (checkRange, ) + + +-- * MIDI controller data type + + +{- +In the future this will be the main type, +and @Controller@ becomes a synonym and is eventually removed. +-} +type T = CtrlP.Controller + +fromInt :: Int -> T +fromInt = checkRange "Controller" CtrlP.Controller + +toInt :: T -> Int +toInt = CtrlP.fromController + + +type Value = Int + + +-- * predefined MIDI controllers + +-- ** simple names for controllers, if only most-significant bytes are used + +bankSelect, modulation, breathControl, footControl, portamentoTime, + dataEntry, volume, balance, panorama, expression, + effectControl1, effectControl2, + generalPurpose1, generalPurpose2, generalPurpose3, generalPurpose4 :: T +bankSelect = bankSelectMSB +modulation = modulationMSB +breathControl = breathControlMSB +footControl = footControlMSB +portamentoTime = portamentoTimeMSB +dataEntry = dataEntryMSB +volume = volumeMSB +balance = balanceMSB +panorama = panoramaMSB +expression = expressionMSB +effectControl1 = effectControl1MSB +effectControl2 = effectControl2MSB +generalPurpose1 = generalPurpose1MSB +generalPurpose2 = generalPurpose2MSB +generalPurpose3 = generalPurpose3MSB +generalPurpose4 = generalPurpose4MSB + + +-- ** aliases for general purpose controllers + +vectorX, vectorY, + soundVariation, timbre, harmonicIntensity, + releaseTime, attackTime, brightness, decayTime, + vibratoRate, vibratoDepth, vibratoDelay, + reverbSendLevel, chorusSendLevel, + externalEffectDepth, tremoloDepth, chorusDepth, celesteDepth, phaserDepth :: T + +vectorX = generalPurpose1 +vectorY = generalPurpose2 + +soundVariation = soundController1 +timbre = soundController2 +harmonicIntensity = soundController2 +releaseTime = soundController3 +attackTime = soundController4 +brightness = soundController5 +decayTime = soundController6 +vibratoRate = soundController7 +vibratoDepth = soundController8 +vibratoDelay = soundController9 + +reverbSendLevel = effect1Depth +chorusSendLevel = effect3Depth + +externalEffectDepth = effect1Depth +tremoloDepth = effect2Depth +chorusDepth = effect3Depth +celesteDepth = effect4Depth +phaserDepth = effect5Depth + + +-- ** controllers for most-significant bytes of control values +bankSelectMSB, modulationMSB, breathControlMSB, footControlMSB, + portamentoTimeMSB, dataEntryMSB, + volumeMSB, balanceMSB, panoramaMSB, expressionMSB, + effectControl1MSB, effectControl2MSB, + generalPurpose1MSB, generalPurpose2MSB, + generalPurpose3MSB, generalPurpose4MSB :: T + +-- ** controllers for least-significant bytes of control values +bankSelectLSB, modulationLSB, breathControlLSB, footControlLSB, + portamentoTimeLSB, dataEntryLSB, + volumeLSB, balanceLSB, panoramaLSB, expressionLSB, + effectControl1LSB, effectControl2LSB, + generalPurpose1LSB, generalPurpose2LSB, + generalPurpose3LSB, generalPurpose4LSB :: T + +-- ** controllers of sound and global effects +sustain, portamento, sustenuto, softPedal, legato, hold2, + soundController1, soundController2, soundController3, + soundController4, soundController5, soundController6, + soundController7, soundController8, soundController9, + soundController10, + generalPurpose5, generalPurpose6, generalPurpose7, generalPurpose8, + portamentoControl, + effect1Depth, effect2Depth, effect3Depth, effect4Depth, effect5Depth :: T + +-- ** increment/decrement and parameter numbers +dataIncrement, dataDecrement, + nonRegisteredParameterLSB, nonRegisteredParameterMSB, + registeredParameterLSB, registeredParameterMSB :: T + +bankSelectMSB = toEnum 0x00 {- 00 00 -} +modulationMSB = toEnum 0x01 {- 01 01 -} +breathControlMSB = toEnum 0x02 {- 02 02 -} +footControlMSB = toEnum 0x04 {- 04 04 -} +portamentoTimeMSB = toEnum 0x05 {- 05 05 -} +dataEntryMSB = toEnum 0x06 {- 06 06 -} +volumeMSB = toEnum 0x07 {- 07 07 -} +balanceMSB = toEnum 0x08 {- 08 08 -} +panoramaMSB = toEnum 0x0A {- 10 0A -} +expressionMSB = toEnum 0x0B {- 11 0B -} +effectControl1MSB = toEnum 0x0C {- 10 0C -} +effectControl2MSB = toEnum 0x0D {- 11 0D -} + +generalPurpose1MSB = toEnum 0x10 {- 16 10 -} +generalPurpose2MSB = toEnum 0x11 {- 17 11 -} +generalPurpose3MSB = toEnum 0x12 {- 18 12 -} +generalPurpose4MSB = toEnum 0x13 {- 19 13 -} + +bankSelectLSB = toEnum 0x20 {- 32 20 -} +modulationLSB = toEnum 0x21 {- 33 21 -} +breathControlLSB = toEnum 0x22 {- 34 22 -} +footControlLSB = toEnum 0x24 {- 36 24 -} +portamentoTimeLSB = toEnum 0x25 {- 37 25 -} +dataEntryLSB = toEnum 0x26 {- 38 26 -} +volumeLSB = toEnum 0x27 {- 39 27 -} +balanceLSB = toEnum 0x28 {- 40 28 -} +panoramaLSB = toEnum 0x2A {- 42 2A -} +expressionLSB = toEnum 0x2B {- 43 2B -} +effectControl1LSB = toEnum 0x2C {- 44 2C -} +effectControl2LSB = toEnum 0x2D {- 45 2D -} + +generalPurpose1LSB = toEnum 0x30 {- 48 30 -} +generalPurpose2LSB = toEnum 0x31 {- 49 31 -} +generalPurpose3LSB = toEnum 0x32 {- 50 32 -} +generalPurpose4LSB = toEnum 0x33 {- 51 33 -} + +sustain = toEnum 0x40 {- 64 40 -} +portamento = toEnum 0x41 {- 65 41 -} +sustenuto = toEnum 0x42 {- 66 42 -} +softPedal = toEnum 0x43 {- 67 43 -} +legato = toEnum 0x44 {- 68 44 -} +hold2 = toEnum 0x45 {- 69 45 -} +soundController1 = toEnum 0x46 {- 70 46 -} +soundController2 = toEnum 0x47 {- 71 47 -} +soundController3 = toEnum 0x48 {- 72 48 -} +soundController4 = toEnum 0x49 {- 73 49 -} +soundController5 = toEnum 0x4A {- 74 4A -} +soundController6 = toEnum 0x4B {- 75 4B -} +soundController7 = toEnum 0x4C {- 76 4C -} +soundController8 = toEnum 0x4D {- 77 4D -} +soundController9 = toEnum 0x4E {- 78 4E -} +soundController10 = toEnum 0x4F {- 79 4F -} + +generalPurpose5 = toEnum 0x50 {- 80 50 -} +generalPurpose6 = toEnum 0x51 {- 81 51 -} +generalPurpose7 = toEnum 0x52 {- 82 52 -} +generalPurpose8 = toEnum 0x53 {- 83 53 -} +portamentoControl = toEnum 0x54 {- 84 54 -} +effect1Depth = toEnum 0x5B {- 91 5B -} +effect2Depth = toEnum 0x5C {- 92 5C -} +effect3Depth = toEnum 0x5D {- 93 5D -} +effect4Depth = toEnum 0x5E {- 94 5E -} +effect5Depth = toEnum 0x5F {- 95 5F -} + +dataIncrement = toEnum 0x60 {- 96 60 -} +dataDecrement = toEnum 0x61 {- 97 61 -} +nonRegisteredParameterLSB = toEnum 0x62 {- 98 62 -} +nonRegisteredParameterMSB = toEnum 0x63 {- 99 63 -} +registeredParameterLSB = toEnum 0x64 {- 100 64 -} +registeredParameterMSB = toEnum 0x65 {- 101 65 -} diff --git a/src/Sound/MIDI/ControllerPrivate.hs b/src/Sound/MIDI/ControllerPrivate.hs new file mode 100644 --- /dev/null +++ b/src/Sound/MIDI/ControllerPrivate.hs @@ -0,0 +1,48 @@ +module Sound.MIDI.ControllerPrivate where + +import Data.Ix (Ix) +import Sound.MIDI.Utility (checkRange, + enumRandomR, boundedEnumRandom, chooseEnum, ) + +import Test.QuickCheck (Arbitrary(arbitrary), ) +import qualified Test.QuickCheck as QC +import System.Random (Random(random, randomR), ) + + + +{- | +We do not define 'Controller' as enumeration with many constructors, +because some controllers have multiple names and some are undefined. +It is also more efficient this way. +Thus you cannot use @case@ for processing controller types, +but you can use 'Data.List.lookup' instead. + +> maybe (putStrLn "unsupported controller") putStrLn $ +> lookup ctrl $ +> (portamento, "portamento") : +> (modulation, "modulation") : +> [] + +-} +newtype Controller = Controller {fromController :: Int} deriving (Show, Eq, Ord, Ix) + +toController :: Int -> Controller +toController = checkRange "Controller" Controller + + +instance Random Controller where + random = boundedEnumRandom + randomR = enumRandomR + +instance Arbitrary Controller where + arbitrary = chooseEnum + + +instance Enum Controller where + toEnum = toController + fromEnum = fromController + +instance Bounded Controller where + minBound = Controller 0 + maxBound = Controller 119 + -- higher controller numbers have special meanings diff --git a/src/Sound/MIDI/Example/Tomatosalad.hs b/src/Sound/MIDI/Example/Tomatosalad.hs --- a/src/Sound/MIDI/Example/Tomatosalad.hs +++ b/src/Sound/MIDI/Example/Tomatosalad.hs @@ -26,82 +26,211 @@ -- import qualified Numeric.NonNegative.Wrapper as NonNeg --- import Data.Tuple.HT (mapSnd, ) +import Data.Tuple.HT (mapFst, ) +import qualified Control.Monad.Trans.State as State +import Control.Monad (liftM3, ) -g0,c1,d1,e1,f1,g1,a1 :: ElapsedTime -> (VoiceMsg.Pitch, ElapsedTime) -[g0,c1,d1,e1,f1,g1,a1] = - map (\p t -> (VoiceMsg.toPitch (p-12), t)) - [55,60,62,64,65,67,69] +g0,a0,b0,c1,cs1,d1,e1,f1,g1,a1,as1 :: VoiceMsg.Pitch +[g0,a0,b0,c1,cs1,d1,e1,f1,g1,a1,as1] = + map VoiceMsg.toPitch [55,57,59,60,61,62,64,65,67,69,70] melody :: [(VoiceMsg.Pitch, ElapsedTime)] melody = - g0 3 : - c1 1 : - c1 1 : - c1 1 : - e1 1 : - d1 1 : - c1 1 : - d1 1 : - g0 1 : - g0 1 : - g0 3 : - c1 1 : - c1 1 : - c1 1 : - e1 1 : - d1 1 : - c1 1 : - g1 3 : - e1 3 : - f1 1 : - f1 1 : - f1 1 : - a1 1 : - g1 1 : - f1 1 : - e1 1 : - e1 1 : - e1 1 : - g1 1 : - f1 1 : - e1 1 : - d1 1 : - d1 1 : - d1 1 : - f1 1 : - e1 1 : - d1 1 : - c1 3 : - [] + let n p t = (VoiceMsg.increasePitch (-12) p, t) + in n g0 3 : + n c1 1 : + n c1 1 : + n c1 1 : + n e1 1 : + n d1 1 : + n c1 1 : + n d1 1 : + n g0 1 : + n g0 1 : + n g0 3 : + n c1 1 : + n c1 1 : + n c1 1 : + n e1 1 : + n d1 1 : + n c1 1 : + n g1 3 : + n e1 3 : + n f1 1 : + n f1 1 : + n f1 1 : + n a1 1 : + n g1 1 : + n f1 1 : + n e1 1 : + n e1 1 : + n e1 1 : + n g1 1 : + n f1 1 : + n e1 1 : + n d1 1 : + n d1 1 : + n d1 1 : + n f1 1 : + n e1 1 : + n d1 1 : + n c1 3 : + [] +melodyEvents :: + [(VoiceMsg.Pitch, ElapsedTime)] -> Int -> + EventListBT.T ElapsedTime Event.T +melodyEvents mel pn = + let chan = ChannelMsg.toChannel 0 + vel = VoiceMsg.toVelocity (VoiceMsg.normalVelocity+25) + event = + Event.MIDIEvent . + ChannelMsg.Cons chan . + ChannelMsg.Voice + in EventListBT.fromPairList $ + concatMap (\(pgm, (n,t)) -> + [(event $ VoiceMsg.ProgramChange pgm, 0), + (event $ VoiceMsg.NoteOn n vel, t), + (event $ VoiceMsg.NoteOff n vel, 0)]) $ + zip (cycle $ map VoiceMsg.toProgram [pn..(pn+4)]) $ + concat $ replicate 5 $ mel -song :: Int -> MidiFile.T -song pn = +solo :: Int -> MidiFile.T +solo pn = + MidiFile.Cons MidiFile.Parallel (MidiFile.Ticks 4) + [EventList.cons 0 + (Event.MetaEvent $ MetaEvent.SetTempo 1500000) $ + EventListTM.switchTimeR const $ + EventListMT.consTime 0 $ + melodyEvents melody pn] + + +melody2 :: [(VoiceMsg.Pitch, ElapsedTime)] +melody2 = + let n p t = (p, t) + in n g0 3 : + n c1 1 : + n c1 1 : + n c1 1 : + n e1 1 : + n d1 1 : + n c1 1 : + n d1 1 : + n g0 1 : + n g0 1 : + n g0 3 : + n d1 1 : + n d1 1 : + n d1 1 : + n f1 1 : + n e1 1 : + n d1 1 : + n g1 3 : + n e1 3 : + n f1 1 : + n f1 1 : + n f1 1 : + n a1 1 : + n g1 1 : + n f1 1 : + n e1 1 : + n e1 1 : + n e1 1 : + n g1 1 : + n f1 1 : + n e1 1 : + n d1 1 : + n d1 1 : + n d1 1 : + n f1 1 : + n e1 1 : + n d1 1 : + n c1 3 : + [] + +nextProgram :: State.State [VoiceMsg.Program] VoiceMsg.Program +nextProgram = State.state $ \(pgm:pgms) -> (pgm,pgms) + +accompEvents :: Int -> EventListBT.T ElapsedTime Event.T +accompEvents pn = let chan = ChannelMsg.toChannel 0 - vel = VoiceMsg.toVelocity VoiceMsg.normalVelocity + vel = VoiceMsg.toVelocity (VoiceMsg.normalVelocity-25) event = Event.MIDIEvent . ChannelMsg.Cons chan . ChannelMsg.Voice - in MidiFile.Cons MidiFile.Parallel (MidiFile.Ticks 4) - [EventList.cons 0 - (Event.MetaEvent $ MetaEvent.SetTempo 1500000) $ - EventListTM.switchTimeR const $ - EventListMT.consTime 0 $ - EventListBT.fromPairList $ - concatMap (\(pgm, (n,t)) -> - [(event $ VoiceMsg.ProgramChange pgm, 0), - (event $ VoiceMsg.NoteOn n vel, t), - (event $ VoiceMsg.NoteOff n vel, 0)]) $ - zip (cycle $ map VoiceMsg.toProgram [pn..(pn+4)]) $ - concat (replicate 5 melody)] + chord :: + VoiceMsg.Pitch -> + (VoiceMsg.Pitch, VoiceMsg.Pitch) -> + State.State [VoiceMsg.Program] [(Event.T, ElapsedTime)] + chord a_ (b_,c_) = + liftM3 + (\ pgm0 pgm1 pgm2 -> + let a = VoiceMsg.increasePitch (-12) a_ + b = VoiceMsg.increasePitch (-12) b_ + c = VoiceMsg.increasePitch (-12) c_ + in map (mapFst event) $ + (VoiceMsg.ProgramChange pgm0, 0) : + (VoiceMsg.NoteOn a vel, 1) : + (VoiceMsg.NoteOff a vel, 0) : + (VoiceMsg.ProgramChange pgm1, 0) : + (VoiceMsg.NoteOn b vel, 0) : + (VoiceMsg.NoteOn c vel, 1) : + (VoiceMsg.NoteOff b vel, 0) : + (VoiceMsg.NoteOff c vel, 0) : + (VoiceMsg.ProgramChange pgm2, 0) : + (VoiceMsg.NoteOn b vel, 0) : + (VoiceMsg.NoteOn c vel, 1) : + (VoiceMsg.NoteOff b vel, 0) : + (VoiceMsg.NoteOff c vel, 0) : + []) + nextProgram nextProgram nextProgram + introChords = + chord c1 (e1, g1) : + chord g0 (e1, g1) : + chord c1 (e1, g1) : + chord g0 (e1, g1) : + [] + chords = + chord c1 (e1, g1) : + chord g0 (e1, g1) : + chord b0 (d1, g1) : + chord g0 (d1, g1) : + chord b0 (f1, g1) : + chord g0 (f1, g1) : + chord c1 (e1, g1) : + chord g0 (g1, as1) : + chord c1 (f1, a1) : + chord a0 (f1, a1) : + chord c1 (e1, g1) : + chord cs1 (e1, a1) : + chord b0 (d1, g1) : + chord g0 (d1, g1) : + chord c1 (e1, g1) : + chord g0 (e1, g1) : + [] + in EventListBT.fromPairList $ + concat $ State.evalState + (sequence $ concat $ introChords : replicate 5 chords) $ + cycle $ map VoiceMsg.toProgram [pn..(pn+4)] +song :: Int -> Int -> MidiFile.T +song pna pnm = + MidiFile.Cons MidiFile.Parallel (MidiFile.Ticks 4) + [EventList.cons 0 + (Event.MetaEvent $ MetaEvent.SetTempo 1500000) $ + let tb t = + EventListTM.switchTimeR const . + EventListMT.consTime t + in EventList.mergeBy (\ _ _ -> True) + (tb 0 $ accompEvents pna) (tb 9 $ melodyEvents melody2 pnm)] + main :: IO () main = - B.writeFile "tomatosalad.mid" (Save.toByteString (song 8)) >> - B.writeFile "hal.mid" (Save.toByteString (song 16)) >> - B.writeFile "graphtheory.mid" (Save.toByteString (song 24)) + B.writeFile "tomatosalad.mid" (Save.toByteString (solo 16)) >> + B.writeFile "hal.mid" (Save.toByteString (solo 21)) >> + B.writeFile "graphtheory.mid" (Save.toByteString (solo 26)) >> + B.writeFile "haltomato.mid" (Save.toByteString (song 16 21)) diff --git a/src/Sound/MIDI/Message.hs b/src/Sound/MIDI/Message.hs --- a/src/Sound/MIDI/Message.hs +++ b/src/Sound/MIDI/Message.hs @@ -34,6 +34,8 @@ data T = Channel Channel.T | System System.T +-- Show instance requires Show instance of System.T +-- deriving (Show) get :: Parser.C parser => Parser.Fallible parser T diff --git a/src/Sound/MIDI/Message/Channel.hs b/src/Sound/MIDI/Message/Channel.hs --- a/src/Sound/MIDI/Message/Channel.hs +++ b/src/Sound/MIDI/Message/Channel.hs @@ -42,6 +42,7 @@ messageChannel :: Channel, messageBody :: Body } + -- ToDo: make nicer Show instance deriving (Show, Eq, Ord) data Body = diff --git a/src/Sound/MIDI/Message/Channel/Voice.hs b/src/Sound/MIDI/Message/Channel/Voice.hs --- a/src/Sound/MIDI/Message/Channel/Voice.hs +++ b/src/Sound/MIDI/Message/Channel/Voice.hs @@ -32,12 +32,15 @@ Pitch, fromPitch, toPitch, Velocity, fromVelocity, toVelocity, Program, fromProgram, toProgram, - Controller, fromController, toController, + CtrlP.Controller, CtrlP.fromController, CtrlP.toController, increasePitch, subtractPitch, frequencyFromPitch, maximumVelocity, normalVelocity, toFloatVelocity, ) 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 @@ -67,7 +70,10 @@ | NoteOn Pitch Velocity | PolyAftertouch Pitch Pressure | ProgramChange Program - | Control Controller ControllerValue + {- + Shall we add support for registered parameters? + -} + | Control Ctrl.T ControllerValue | PitchBend PitchBendRange | MonoAftertouch Pressure deriving (Show, Eq, Ord) @@ -110,14 +116,6 @@ arbitrary = chooseEnum -instance Random Controller where - random = boundedEnumRandom - randomR = enumRandomR - -instance Arbitrary Controller where - arbitrary = chooseEnum - - isNote :: T -> Bool isNote (NoteOn _ _) = True isNote (NoteOff _ _) = True @@ -173,29 +171,14 @@ type PitchBendRange = Int type Pressure = Int -type ControllerValue = Int +type ControllerValue = Ctrl.Value newtype Pitch = Pitch {fromPitch :: Int} deriving (Show, Eq, Ord, Ix) newtype Velocity = Velocity {fromVelocity :: Int} deriving (Show, Eq, Ord) newtype Program = Program {fromProgram :: Int} deriving (Show, Eq, Ord, Ix) -{- | -We do not define 'Controller' as enumeration with many constructors, -because some controllers have multiple names and some are undefined. -It is also more efficient this way. -Thus you cannot use @case@ for processing controller types, -but you can use 'Data.List.lookup' instead. -> maybe (putStrLn "unsupported controller") putStrLn $ -> lookup ctrl $ -> (portamento, "portamento") : -> (modulation, "modulation") : -> [] - --} -newtype Controller = Controller {fromController :: Int} deriving (Show, Eq, Ord, Ix) - toPitch :: Int -> Pitch toPitch = checkRange "Pitch" Pitch @@ -205,10 +188,7 @@ toProgram :: Int -> Program toProgram = checkRange "Program" Program -toController :: Int -> Controller -toController = checkRange "Controller" Controller - instance Enum Pitch where toEnum = toPitch fromEnum = fromPitch @@ -222,10 +202,6 @@ toEnum = toProgram fromEnum = fromProgram -instance Enum Controller where - toEnum = toController - fromEnum = fromController - -- typical methods of a type class for affine spaces increasePitch :: Int -> Pitch -> Pitch increasePitch d = toPitch . (d+) . fromPitch @@ -255,12 +231,7 @@ minBound = Program 0 maxBound = Program 127 -instance Bounded Controller where - minBound = Controller 0 - maxBound = Controller 119 - -- higher controller numbers have special meanings - {- | A MIDI problem is that one cannot uniquely map a MIDI key to a frequency. @@ -317,6 +288,12 @@ +{- +These definitions will be deprecated +and then replaced by the ones from MIDI.Controller. +-} + + -- * predefined MIDI controllers @@ -325,7 +302,7 @@ bankSelect, modulation, breathControl, footControl, portamentoTime, dataEntry, mainVolume, balance, panorama, expression, generalPurpose1, generalPurpose2, generalPurpose3, generalPurpose4, - vectorX, vectorY :: Controller + vectorX, vectorY :: Ctrl.T bankSelect = bankSelectMSB modulation = modulationMSB breathControl = breathControlMSB @@ -351,24 +328,24 @@ portamentoTimeMSB, dataEntryMSB, mainVolumeMSB, balanceMSB, panoramaMSB, expressionMSB, generalPurpose1MSB, generalPurpose2MSB, - generalPurpose3MSB, generalPurpose4MSB :: Controller + 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 :: Controller + generalPurpose3LSB, generalPurpose4LSB :: Ctrl.T -- ** additional single byte controllers sustain, porta, sustenuto, softPedal, hold2, generalPurpose5, generalPurpose6, generalPurpose7, generalPurpose8, - extDepth, tremoloDepth, chorusDepth, celesteDepth, phaserDepth :: Controller + extDepth, tremoloDepth, chorusDepth, celesteDepth, phaserDepth :: Ctrl.T -- ** increment/decrement and parameter numbers dataIncrement, dataDecrement, nonRegisteredParameterLSB, nonRegisteredParameterMSB, - registeredParameterLSB, registeredParameterMSB :: Controller + registeredParameterLSB, registeredParameterMSB :: Ctrl.T bankSelectMSB = toEnum 0x00 {- 00 00 -} @@ -434,6 +411,10 @@ 08 -> liftM (NoteOff pitch) getVel 09 -> liftM (NoteOn pitch) getVel 10 -> liftM (PolyAftertouch pitch) get1 + {- + Whether firstData is a controller and not a mode + is checked in Message.Channel.get. + -} 11 -> liftM (Control (toEnum firstData)) get1 12 -> return (ProgramChange (toProgram firstData)) 13 -> return (MonoAftertouch firstData) diff --git a/src/Sound/MIDI/Parser/File.hs b/src/Sound/MIDI/Parser/File.hs --- a/src/Sound/MIDI/Parser/File.hs +++ b/src/Sound/MIDI/Parser/File.hs @@ -15,7 +15,6 @@ import qualified Control.Monad.Exception.Synchronous as Sync import qualified System.IO as IO -import qualified Sound.MIDI.IO as MIO import Data.Char (ord) import qualified Numeric.NonNegative.Wrapper as NonNeg diff --git a/src/Sound/MIDI/Parser/Restricted.hs b/src/Sound/MIDI/Parser/Restricted.hs --- a/src/Sound/MIDI/Parser/Restricted.hs +++ b/src/Sound/MIDI/Parser/Restricted.hs @@ -9,7 +9,6 @@ import qualified Sound.MIDI.Parser.Class as Parser import qualified Control.Monad.Exception.Synchronous as Sync -import qualified Control.Monad.Trans.State as State import qualified Control.Monad.Trans.Class as Trans import Control.Monad.Trans.State (StateT(runStateT), gets, get, put, ) import Control.Monad (when, )