midi 0.1.5.2 → 0.1.6
raw patch · 9 files changed
+508/−114 lines, 9 files
Files
- midi.cabal +11/−7
- src/Sound/MIDI/Controller.hs +231/−0
- src/Sound/MIDI/ControllerPrivate.hs +48/−0
- src/Sound/MIDI/Example/Tomatosalad.hs +191/−62
- src/Sound/MIDI/Message.hs +2/−0
- src/Sound/MIDI/Message/Channel.hs +1/−0
- src/Sound/MIDI/Message/Channel/Voice.hs +24/−43
- src/Sound/MIDI/Parser/File.hs +0/−1
- src/Sound/MIDI/Parser/Restricted.hs +0/−1
midi.cabal view
@@ -1,23 +1,24 @@ Name: midi-Version: 0.1.5.2+Version: 0.1.6 License: GPL License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de> Maintainer: Henning Thielemann <haskell@henning-thielemann.de> 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
+ src/Sound/MIDI/Controller.hs view
@@ -0,0 +1,231 @@+{- |+MIDI controller data type and common controller definitions.++See <http://www.midi.org/techspecs/midimessages.php>.+-}+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 -}
+ src/Sound/MIDI/ControllerPrivate.hs view
@@ -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
src/Sound/MIDI/Example/Tomatosalad.hs view
@@ -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))
src/Sound/MIDI/Message.hs view
@@ -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
src/Sound/MIDI/Message/Channel.hs view
@@ -42,6 +42,7 @@ messageChannel :: Channel, messageBody :: Body }+ -- ToDo: make nicer Show instance deriving (Show, Eq, Ord) data Body =
src/Sound/MIDI/Message/Channel/Voice.hs view
@@ -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)
src/Sound/MIDI/Parser/File.hs view
@@ -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
src/Sound/MIDI/Parser/Restricted.hs view
@@ -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, )