midi 0.1.6 → 0.1.7
raw patch · 7 files changed
+180/−28 lines, 7 filesdep ~base
Dependency ranges changed: base
Files
- midi.cabal +15/−13
- src/Sound/MIDI/File.hs +73/−8
- src/Sound/MIDI/File/Event/Meta.hs +6/−3
- src/Sound/MIDI/General.hs +1/−1
- src/Sound/MIDI/Message.hs +0/−2
- src/Sound/MIDI/Message/Channel.hs +0/−1
- src/Sound/MIDI/Message/Class/Check.hs +85/−0
midi.cabal view
@@ -1,24 +1,25 @@ Name: midi-Version: 0.1.6+Version: 0.1.7 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+Tested-With: GHC==6.4.1, GHC==6.8.2, GHC==6.10.4, GHC==6.12.3+Tested-With: 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,- and some definitions from General MIDI standard.- It contains no sending and receiving of MIDI messages.- Cf. @alsa-seq@, @PortMidi@, @hmidi@, @alsa@, @alsa-midi@ packages.- For music composition with MIDI output, see @haskore@.- Alternate packages are @HCodecs@, @zmidi-core@.+ MIDI is the Musical Instrument Digital Interface.+ The package contains definition of realtime and file MIDI messages,+ reading and writing MIDI files,+ and some definitions from the General MIDI standard.+ It contains no sending and receiving of MIDI messages.+ For this purpose see the @alsa-seq@, @jack@, @PortMidi@, @hmidi@ packages.+ For music composition with MIDI output, see @haskore@.+ Alternative packages are @HCodecs@, @zmidi-core@. Extra-Source-Files: Makefile src/Sound/MIDI/Example/Tomatosalad.hs@@ -29,7 +30,7 @@ Source-Repository this type: darcs location: http://code.haskell.org/~thielema/midi/- tag: 0.1.6+ tag: 0.1.7 Flag splitBase description: Choose the new smaller, split-up base package.@@ -51,10 +52,10 @@ If flag(splitBase) Build-Depends: random >=1 && <2,- base >= 2 && <5+ base >= 3 && <5 Else Build-Depends:- base >= 1.0 && < 2+ base >= 1.0 && < 3 GHC-Options: -Wall Hs-Source-Dirs: src@@ -74,6 +75,7 @@ Sound.MIDI.Message.System.Exclusive Sound.MIDI.Message.System.Common Sound.MIDI.Message.System.RealTime+ Sound.MIDI.Message.Class.Check Sound.MIDI.Controller Sound.MIDI.Manufacturer Sound.MIDI.General
src/Sound/MIDI/File.hs view
@@ -10,8 +10,10 @@ ElapsedTime, fromElapsedTime, toElapsedTime, Tempo, fromTempo, toTempo, explicitNoteOff, implicitNoteOff,+ getTracks, mergeTracks,+ secondsFromTicks, ticksPerQuarterNote, - showLines, changeVelocity, getTracks, resampleTime,+ showLines, changeVelocity, resampleTime, showEvent, showTime, sortEvents, progChangeBeforeSetTempo, ) where@@ -27,14 +29,18 @@ import qualified Data.EventList.Relative.TimeBody as EventList--- import qualified Numeric.NonNegative.Wrapper as NonNeg+import qualified Numeric.NonNegative.Wrapper as NonNegW+import qualified Numeric.NonNegative.Class as NonNeg import Test.QuickCheck (Arbitrary(arbitrary), ) import qualified Test.QuickCheck as QC +import qualified Control.Monad.Trans.State as MS import Control.Monad (liftM, liftM2, ) -- import Sound.MIDI.IO(ByteList) import Sound.MIDI.String (rightS, )++import Data.Ratio((%)) import Data.Ix(Ix) import Data.List(groupBy, sort) import Data.Maybe(fromMaybe)@@ -55,10 +61,10 @@ {- | An empty MIDI file.+Tempo is set to one tick per quarter note. -}- empty :: T-empty = Cons Mixed (Ticks 0) [EventList.empty]+empty = Cons Mixed (Ticks 1) [EventList.empty] instance Arbitrary T where@@ -108,10 +114,72 @@ mapTrack (EventList.mapBody (Event.mapVoice VoiceMsg.implicitNoteOff)) +getTracks :: T -> [Track]+getTracks (Cons _ _ trks) = trks++{- |+Merge all tracks into a single track+according to the MIDI file type.+-}+mergeTracks ::+ (NonNeg.C time) =>+ Type ->+ [EventList.T time event] ->+ EventList.T time event+mergeTracks typ tracks =+ case typ of+ Mixed -> foldr (EventList.mergeBy (\_ _ -> True)) EventList.empty tracks+ Parallel -> foldr (EventList.mergeBy (\_ _ -> True)) EventList.empty tracks+ Serial -> EventList.concat tracks++{- |+Process and remove all @SetTempo@ events.+The result is an event list where the times are measured in seconds.+-}+secondsFromTicks ::+ Division ->+ EventList.T ElapsedTime Event.T ->+ EventList.T NonNegW.Rational Event.T+secondsFromTicks division =+ EventList.catMaybes .+ flip MS.evalState MetaEvent.defltST .+ EventList.mapM+ (\ticks -> do+ microsPerQN <- MS.get+ -- cf. Standard MIDI Files 1.0, page 14+ return $+ NonNegW.fromNumberMsg "MIDI.File.processTempo" $+ fromElapsedTime ticks * fromIntegral (NonNegW.toNumber microsPerQN)+ % (1000000 * fromIntegral (NonNegW.toNumber (ticksPerQuarterNote division))))+ (\ev ->+ case ev of+ Event.MetaEvent (MetaEvent.SetTempo microsPerQN) ->+ MS.put microsPerQN >> return Nothing+ _ -> return $ Just ev)+++ticksPerQuarterNote :: Division -> Tempo+ticksPerQuarterNote division =+ case division of+ Ticks ticksPerQN -> ticksPerQN+ SMPTE framesPerSecond ticksPerFrames ->+ {-+ I am uncertain, whether this is correct.+ The "Standard MIDI File 1.0" is unprecise+ with respect to the question,+ whether SetTempo is relevant also in SMPTE mode.+ TiMidity-2.13.2 interprets this kind of division as we do+ and qualifies it as "totally untested".+ -}+ NonNegW.fromNumberMsg "MIDI.File.ticksPerQuarterNote" $+ framesPerSecond * ticksPerFrames+++ {- * Debugging -} {-# DEPRECATED- showLines, changeVelocity, getTracks, resampleTime,+ showLines, changeVelocity, resampleTime, showEvent, showTime, sortEvents, progChangeBeforeSetTempo "only use this for debugging" #-}@@ -176,9 +244,6 @@ Event.MetaEvent (MetaEvent.SetTempo (newTempo tmp)) _ -> ev in mapTrack (EventList.mapBody procEvent . EventList.mapTime divTime)--getTracks :: T -> [Track]-getTracks (Cons _ _ trks) = trks {- | Sort MIDI note events lexicographically.
src/Sound/MIDI/File/Event/Meta.hs view
@@ -128,12 +128,15 @@ {- |-Default duration of a whole note, in seconds; and the default SetTempo-value, in microseconds per quarter note. Both express the default of-120 beats per minute.+Default number of quarter notes in a second. -} defltDurT :: ElapsedTime defltDurT = 2++{- |+The default SetTempo value, in microseconds per quarter note.+This expresses the default of 120 beats per minute.+-} defltST :: Tempo defltST = div 1000000 (fromIntegral defltDurT)
src/Sound/MIDI/General.hs view
@@ -223,7 +223,7 @@ | Maracas | ShortWhistle | LongWhistle | ShortGuiro | LongGuiro | Claves | HiWoodBlock | LowWoodBlock | MuteCuica | OpenCuica | MuteTriangle- | OpenTriangle -- Midi Key 82+ | OpenTriangle -- Midi Key 81 deriving (Show, Eq, Ord, Ix, Enum, Bounded) -- http://oxygen.cside6.com/gallery/ins_gm.html
src/Sound/MIDI/Message.hs view
@@ -34,8 +34,6 @@ 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,7 +42,6 @@ messageChannel :: Channel, messageBody :: Body }- -- ToDo: make nicer Show instance deriving (Show, Eq, Ord) data Body =
+ src/Sound/MIDI/Message/Class/Check.hs view
@@ -0,0 +1,85 @@+module Sound.MIDI.Message.Class.Check where++import Sound.MIDI.Message.Channel (Channel, )+import Sound.MIDI.Message.Channel.Voice (Pitch, Velocity, Program, Controller, )++import qualified Sound.MIDI.Message as MidiMsg+import qualified Sound.MIDI.Message.Channel as ChannelMsg+import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg+import qualified Sound.MIDI.Message.Channel.Mode as Mode++import Control.Monad (guard, )+++class C event where+ note :: Channel -> event -> Maybe (Velocity, Pitch, Bool)+ program :: Channel -> event -> Maybe Program+ anyController :: Channel -> event -> Maybe (Controller, Int)+ pitchBend :: Channel -> event -> Maybe Int+ channelPressure :: Channel -> event -> Maybe Int+ mode :: Channel -> event -> Maybe Mode.T++controller ::+ (C event) =>+ Channel -> Controller -> event -> Maybe Int+controller chan ctrl e = do+ (c,n) <- anyController chan e+ guard (ctrl==c)+ return n+++instance C ChannelMsg.T where+ note chan msg = do+ guard (ChannelMsg.messageChannel msg == chan)+ ChannelMsg.Voice voice <- Just $ ChannelMsg.messageBody msg+ case voice of+ VoiceMsg.NoteOn pitch velocity -> Just (velocity, pitch, True)+ VoiceMsg.NoteOff pitch velocity -> Just (velocity, pitch, False)+ _ -> Nothing++ program chan msg = do+ guard (ChannelMsg.messageChannel msg == chan)+ ChannelMsg.Voice (VoiceMsg.ProgramChange pgm) <-+ Just $ ChannelMsg.messageBody msg+ return pgm++ anyController chan msg = do+ guard (ChannelMsg.messageChannel msg == chan)+ ChannelMsg.Voice (VoiceMsg.Control ctrl val) <-+ Just $ ChannelMsg.messageBody msg+ return (ctrl, val)++ pitchBend chan msg = do+ guard (ChannelMsg.messageChannel msg == chan)+ ChannelMsg.Voice (VoiceMsg.PitchBend bend) <-+ Just $ ChannelMsg.messageBody msg+ return bend++ channelPressure chan msg = do+ guard (ChannelMsg.messageChannel msg == chan)+ ChannelMsg.Voice (VoiceMsg.MonoAftertouch pressure) <-+ Just $ ChannelMsg.messageBody msg+ return pressure++ mode chan msg = do+ guard (ChannelMsg.messageChannel msg == chan)+ ChannelMsg.Mode m <-+ Just $ ChannelMsg.messageBody msg+ return m+++liftMidi ::+ (Channel -> ChannelMsg.T -> Maybe a) ->+ (Channel -> MidiMsg.T -> Maybe a)+liftMidi checkMsg chan msg =+ case msg of+ MidiMsg.Channel chanMsg -> checkMsg chan chanMsg+ _ -> Nothing++instance C MidiMsg.T where+ note = liftMidi note+ program = liftMidi program+ anyController = liftMidi anyController+ pitchBend = liftMidi pitchBend+ channelPressure = liftMidi channelPressure+ mode = liftMidi mode