diff --git a/midi.cabal b/midi.cabal --- a/midi.cabal +++ b/midi.cabal @@ -1,5 +1,5 @@ Name: midi -Version: 0.1.4 +Version: 0.1.5 License: GPL License-File: LICENSE Author: Henning Thielemann @@ -20,12 +20,12 @@ Build-Type: Simple Source-Repository head type: darcs - location: http://darcs.haskell.org/midi/ + location: http://code.haskell.org/~thielema/midi/ Source-Repository this type: darcs - location: http://darcs.haskell.org/midi/ - tag: 0.1.4 + location: http://code.haskell.org/~thielema/midi/ + tag: 0.1.5 Flag splitBase description: Choose the new smaller, split-up base package. @@ -35,16 +35,22 @@ default: False Library - Build-Depends: event-list >=0.0.9 && < 0.1, non-negative>=0.0.1 && <0.1 - Build-Depends: explicit-exception >=0.1 && <0.2 - Build-Depends: bytestring >=0.9.0.1 && <0.10, binary >=0.4.2 && <0.5 - Build-Depends: transformers >=0.0.1 && <0.2 - Build-Depends: monoid-transformer >=0.0.1 && <0.1 - Build-Depends: QuickCheck >=1 && <2 + Build-Depends: + event-list >=0.0.9 && < 0.1, + non-negative>=0.0.1 && <0.1, + explicit-exception >=0.1 && <0.2, + bytestring >=0.9.0.1 && <0.10, + binary >=0.4.2 && <0.6, + transformers >=0.0.1 && <0.2, + monoid-transformer >=0.0.1 && <0.1, + QuickCheck >=1 && <3 If flag(splitBase) - Build-Depends: base >= 2, random >=1 && <2 + Build-Depends: + random >=1 && <2, + base >= 2 && <6 Else - Build-Depends: base >= 1.0 && < 2 + Build-Depends: + base >= 1.0 && < 2 GHC-Options: -Wall Hs-Source-Dirs: src diff --git a/src/Sound/MIDI/File.hs b/src/Sound/MIDI/File.hs --- a/src/Sound/MIDI/File.hs +++ b/src/Sound/MIDI/File.hs @@ -71,7 +71,6 @@ [] division <- arbitrary return (Cons typ division content) - coarbitrary = error "not implemented" instance Arbitrary Division where arbitrary = @@ -79,7 +78,6 @@ liftM (Ticks . (1+)) arbitrary : liftM2 (\x y -> SMPTE (1+abs x) (1+abs y)) arbitrary arbitrary : [] - coarbitrary = error "not implemented" diff --git a/src/Sound/MIDI/File/Event.hs b/src/Sound/MIDI/File/Event.hs --- a/src/Sound/MIDI/File/Event.hs +++ b/src/Sound/MIDI/File/Event.hs @@ -61,7 +61,6 @@ (100, liftM MIDIEvent arbitrary) : ( 1, liftM MetaEvent arbitrary) : [] - coarbitrary = error "not implemented" maybeMIDIEvent :: T -> Maybe ChannelMsg.T diff --git a/src/Sound/MIDI/File/Event/Meta.hs b/src/Sound/MIDI/File/Event/Meta.hs --- a/src/Sound/MIDI/File/Event/Meta.hs +++ b/src/Sound/MIDI/File/Event/Meta.hs @@ -85,7 +85,6 @@ liftM SequencerSpecific arbitraryByteList : -- liftM Unknown arbitrary arbitraryByteList : [] - coarbitrary = error "not implemented" arbitraryByte :: QC.Gen Int arbitraryByte = QC.choose (0,0xFF::Int) @@ -109,7 +108,6 @@ instance Arbitrary Key where arbitrary = chooseEnum - coarbitrary = error "not implemented" @@ -126,7 +124,6 @@ instance Arbitrary Scale where arbitrary = chooseEnum - coarbitrary = error "not implemented" diff --git a/src/Sound/MIDI/General.hs b/src/Sound/MIDI/General.hs --- a/src/Sound/MIDI/General.hs +++ b/src/Sound/MIDI/General.hs @@ -13,7 +13,7 @@ import Sound.MIDI.Utility (mapSnd, enumRandomR, boundedEnumRandom, chooseEnum, ) -import Test.QuickCheck (Arbitrary(..), ) +import Test.QuickCheck (Arbitrary(arbitrary), ) import System.Random (Random(random,randomR), ) @@ -180,7 +180,6 @@ instance Arbitrary Instrument where arbitrary = chooseEnum - coarbitrary = error "GeneralMIDI.Instrument.coarbitrary not implemented" @@ -235,4 +234,3 @@ instance Arbitrary Drum where arbitrary = chooseEnum - coarbitrary = error "GeneralMIDI.Drum.coarbitrary not implemented" 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 @@ -61,7 +61,6 @@ (20, liftM Voice arbitrary) : ( 1, liftM Mode arbitrary) : []) - coarbitrary = error "not implemented" -- * serialization diff --git a/src/Sound/MIDI/Message/Channel/Mode.hs b/src/Sound/MIDI/Message/Channel/Mode.hs --- a/src/Sound/MIDI/Message/Channel/Mode.hs +++ b/src/Sound/MIDI/Message/Channel/Mode.hs @@ -43,7 +43,6 @@ liftM MonoMode (QC.choose (0,16)) : return PolyMode : [] - coarbitrary = error "not implemented" -- * serialization 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 @@ -34,7 +34,7 @@ Program, fromProgram, toProgram, Controller, fromController, toController, - increasePitch, subtractPitch, + increasePitch, subtractPitch, frequencyFromPitch, maximumVelocity, normalVelocity, toFloatVelocity, ) where @@ -84,7 +84,6 @@ ( 1, liftM PitchBend (QC.choose (0,12))) : ( 1, liftM MonoAftertouch (QC.choose (0,127))) : [] - coarbitrary = error "not implemented" instance Random Pitch where @@ -93,7 +92,6 @@ instance Arbitrary Pitch where arbitrary = chooseEnum - coarbitrary = error "not implemented" instance Random Velocity where @@ -102,7 +100,6 @@ instance Arbitrary Velocity where arbitrary = chooseQuantity fromVelocity toVelocity - coarbitrary = error "not implemented" instance Random Program where @@ -111,7 +108,6 @@ instance Arbitrary Program where arbitrary = chooseEnum - coarbitrary = error "not implemented" instance Random Controller where @@ -120,7 +116,6 @@ instance Arbitrary Controller where arbitrary = chooseEnum - coarbitrary = error "not implemented" isNote :: T -> Bool @@ -187,7 +182,7 @@ {- | We do not define 'Controller' as enumeration with many constructors, -because some controller have multiple names and some are undefined. +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. @@ -238,7 +233,16 @@ subtractPitch :: Pitch -> Pitch -> Int subtractPitch (Pitch p0) (Pitch p1) = p1-p0 +{- | +Convert pitch to frequency +according to the default tuning +given in MIDI 1.0 Detailed Specification. +-} +frequencyFromPitch :: (Floating a) => Pitch -> a +frequencyFromPitch (Pitch p) = + 440 * 2 ** (fromIntegral (p + 3 - 6*12) / 12) + instance Bounded Pitch where minBound = Pitch 0 maxBound = Pitch 127 @@ -273,8 +277,10 @@ {- | The velocity of an ordinary key stroke and the maximum possible velocity. --} +ToDo: +This should be of type Velocity. +-} normalVelocity, maximumVelocity :: Num quant => quant -- Velocity normalVelocity = 64 @@ -285,6 +291,14 @@ and thus we map it to 1. 0 is mapped to 0. All other values are interpolated linearly. + +ToDo: +MIDI specification says, +if velocity is simply mapped to amplitude, +then this should be done by an exponential function. +Thus we should be better map 'normalVelocity' to 0, +'maximumVelocity' to 1, +and 'minimumVelocity' to -1. -} toFloatVelocity :: (Integral a, Fractional b) => a -> b toFloatVelocity x = fromIntegral x / normalVelocity diff --git a/src/Sound/MIDI/Utility.hs b/src/Sound/MIDI/Utility.hs --- a/src/Sound/MIDI/Utility.hs +++ b/src/Sound/MIDI/Utility.hs @@ -118,7 +118,6 @@ [(26, QC.choose ('a','z')), (26, QC.choose ('A','Z')), (10, QC.choose ('0','9'))] - coarbitrary = error "not implemented" arbitraryString :: QC.Gen String arbitraryString = @@ -130,7 +129,6 @@ instance QC.Arbitrary ArbByte where arbitrary = fmap (ArbByte . fromIntegral) $ QC.choose (0,0xFF::Int) - coarbitrary = error "not implemented" arbitraryByteList :: QC.Gen [Word8] -- ByteList arbitraryByteList =