diff --git a/midi.cabal b/midi.cabal --- a/midi.cabal +++ b/midi.cabal @@ -1,5 +1,5 @@ Name: midi -Version: 0.0.6 +Version: 0.0.7 License: GPL License-File: LICENSE Author: Henning Thielemann diff --git a/src/Sound/MIDI/Event.hs b/src/Sound/MIDI/Event.hs --- a/src/Sound/MIDI/Event.hs +++ b/src/Sound/MIDI/Event.hs @@ -18,6 +18,22 @@ generalPurpose1, generalPurpose2, generalPurpose3, generalPurpose4, vectorX, vectorY, + bankSelectMSB, modulationMSB, breathControlMSB, footControlMSB, + portamentoTimeMSB, dataEntryMSB, mainVolumeMSB, balanceMSB, + panoramaMSB, expressionMSB, generalPurpose1MSB, generalPurpose2MSB, + generalPurpose3MSB, generalPurpose4MSB, bankSelectLSB, modulationLSB, + breathControlLSB, footControlLSB, portamentoTimeLSB, dataEntryLSB, + mainVolumeLSB, balanceLSB, panoramaLSB, expressionLSB, + generalPurpose1LSB, generalPurpose2LSB, generalPurpose3LSB, generalPurpose4LSB, + + sustain, porta, sustenuto, softPedal, hold2, + generalPurpose5, generalPurpose6, generalPurpose7, generalPurpose8, + extDepth, tremoloDepth, chorusDepth, celesteDepth, phaserDepth, + + dataIncrement, dataDecrement, + nonRegisteredParameterLSB, nonRegisteredParameterMSB, + registeredParameterLSB, registeredParameterMSB, + fromPitch, toPitch, fromVelocity, toVelocity, fromProgram, toProgram, @@ -25,14 +41,16 @@ increasePitch, subtractPitch, ) where +import Data.Ix (Ix) + {- * MIDI Events -} -newtype Pitch = Pitch {fromPitch :: Int} deriving (Show, Eq, Ord) +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) -newtype Channel = Channel {fromChannel :: Int} deriving (Show, Eq, Ord) +newtype Program = Program {fromProgram :: Int} deriving (Show, Eq, Ord, Ix) +newtype Channel = Channel {fromChannel :: Int} deriving (Show, Eq, Ord, Ix) toPitch :: Int -> Pitch toPitch = checkRange "Pitch" Pitch @@ -119,6 +137,8 @@ {- | 64 is given as default value by the MIDI specification and thus we map it to 1. +0 is mapped to 0. +All other values are interpolated linearly. -} toFloatVelocity :: (Integral a, Fractional b) => a -> b toFloatVelocity x = fromIntegral x / normalVelocity @@ -126,6 +146,11 @@ maximumControllerValue :: Num quant => quant maximumControllerValue = 127 +{- | +Map integral MIDI controller value to floating point value. +Maximum integral MIDI controller value 127 is mapped to 1. +Minimum integral MIDI controller value 0 is mapped to 0. +-} toFloatController :: (Integral a, Fractional b) => a -> b toFloatController x = fromIntegral x / maximumControllerValue @@ -160,6 +185,139 @@ isNoteOff _ = False + +{-# DEPRECATED BankSelectMSB "use bankSelectMSB instead" #-} +{-# DEPRECATED ModulationMSB "use modulationMSB instead" #-} +{-# DEPRECATED BreathControlMSB "use breathControlMSB instead" #-} +{-# DEPRECATED Controller03 "use toEnum 0x03 instead" #-} +{-# DEPRECATED FootControlMSB "use footControlMSB instead" #-} +{-# DEPRECATED PortamentoTimeMSB "use portamentoTimeMSB instead" #-} +{-# DEPRECATED DataEntryMSB "use dataEntryMSB instead" #-} +{-# DEPRECATED MainVolumeMSB "use mainVolumeMSB instead" #-} +{-# DEPRECATED BalanceMSB "use balanceMSB instead" #-} +{-# DEPRECATED Controller09 "use toEnum 0x09 instead" #-} +{-# DEPRECATED PanoramaMSB "use panoramaMSB instead" #-} +{-# DEPRECATED ExpressionMSB "use expressionMSB instead" #-} +{-# DEPRECATED Controller0C "use toEnum 0x0C instead" #-} +{-# DEPRECATED Controller0D "use toEnum 0x0D instead" #-} +{-# DEPRECATED Controller0E "use toEnum 0x0E instead" #-} +{-# DEPRECATED Controller0F "use toEnum 0x0F instead" #-} +{-# DEPRECATED GeneralPurpose1MSB "use generalPurpose1MSB instead" #-} +{-# DEPRECATED GeneralPurpose2MSB "use generalPurpose2MSB instead" #-} +{-# DEPRECATED GeneralPurpose3MSB "use generalPurpose3MSB instead" #-} +{-# DEPRECATED GeneralPurpose4MSB "use generalPurpose4MSB instead" #-} +{-# DEPRECATED Controller14 "use toEnum 0x14 instead" #-} +{-# DEPRECATED Controller15 "use toEnum 0x15 instead" #-} +{-# DEPRECATED Controller16 "use toEnum 0x16 instead" #-} +{-# DEPRECATED Controller17 "use toEnum 0x17 instead" #-} +{-# DEPRECATED Controller18 "use toEnum 0x18 instead" #-} +{-# DEPRECATED Controller19 "use toEnum 0x19 instead" #-} +{-# DEPRECATED Controller1A "use toEnum 0x1A instead" #-} +{-# DEPRECATED Controller1B "use toEnum 0x1B instead" #-} +{-# DEPRECATED Controller1C "use toEnum 0x1C instead" #-} +{-# DEPRECATED Controller1D "use toEnum 0x1D instead" #-} +{-# DEPRECATED Controller1E "use toEnum 0x1E instead" #-} +{-# DEPRECATED Controller1F "use toEnum 0x1F instead" #-} +{-# DEPRECATED BankSelectLSB "use bankSelectLSB instead" #-} +{-# DEPRECATED ModulationLSB "use modulationLSB instead" #-} +{-# DEPRECATED BreathControlLSB "use breathControlLSB instead" #-} +{-# DEPRECATED Controller23 "use toEnum 0x23 instead" #-} +{-# DEPRECATED FootControlLSB "use footControlLSB instead" #-} +{-# DEPRECATED PortamentoTimeLSB "use portamentoTimeLSB instead" #-} +{-# DEPRECATED DataEntryLSB "use dataEntryLSB instead" #-} +{-# DEPRECATED MainVolumeLSB "use mainVolumeLSB instead" #-} +{-# DEPRECATED BalanceLSB "use balanceLSB instead" #-} +{-# DEPRECATED Controller29 "use toEnum 0x29 instead" #-} +{-# DEPRECATED PanoramaLSB "use panoramaLSB instead" #-} +{-# DEPRECATED ExpressionLSB "use expressionLSB instead" #-} +{-# DEPRECATED Controller2C "use toEnum 0x2C instead" #-} +{-# DEPRECATED Controller2D "use toEnum 0x2D instead" #-} +{-# DEPRECATED Controller2E "use toEnum 0x2E instead" #-} +{-# DEPRECATED Controller2F "use toEnum 0x2F instead" #-} +{-# DEPRECATED GeneralPurpose1LSB "use generalPurpose1LSB instead" #-} +{-# DEPRECATED GeneralPurpose2LSB "use generalPurpose2LSB instead" #-} +{-# DEPRECATED GeneralPurpose3LSB "use generalPurpose3LSB instead" #-} +{-# DEPRECATED GeneralPurpose4LSB "use generalPurpose4LSB instead" #-} +{-# DEPRECATED Controller34 "use toEnum 0x34 instead" #-} +{-# DEPRECATED Controller35 "use toEnum 0x35 instead" #-} +{-# DEPRECATED Controller36 "use toEnum 0x36 instead" #-} +{-# DEPRECATED Controller37 "use toEnum 0x37 instead" #-} +{-# DEPRECATED Controller38 "use toEnum 0x38 instead" #-} +{-# DEPRECATED Controller39 "use toEnum 0x39 instead" #-} +{-# DEPRECATED Controller3A "use toEnum 0x3A instead" #-} +{-# DEPRECATED Controller3B "use toEnum 0x3B instead" #-} +{-# DEPRECATED Controller3C "use toEnum 0x3C instead" #-} +{-# DEPRECATED Controller3D "use toEnum 0x3D instead" #-} +{-# DEPRECATED Controller3E "use toEnum 0x3E instead" #-} +{-# DEPRECATED Controller3F "use toEnum 0x3F instead" #-} + +{-# DEPRECATED Sustain "use sustain instead" #-} +{-# DEPRECATED Porta "use porta instead" #-} +{-# DEPRECATED Sustenuto "use sustenuto instead" #-} +{-# DEPRECATED SoftPedal "use softPedal instead" #-} +{-# DEPRECATED Controller44 "use toEnum 0x44 instead" #-} +{-# DEPRECATED Hold2 "use hold2 instead" #-} +{-# DEPRECATED Controller46 "use toEnum 0x46 instead" #-} +{-# DEPRECATED Controller47 "use toEnum 0x47 instead" #-} +{-# DEPRECATED Controller48 "use toEnum 0x48 instead" #-} +{-# DEPRECATED Controller49 "use toEnum 0x49 instead" #-} +{-# DEPRECATED Controller4A "use toEnum 0x4A instead" #-} +{-# DEPRECATED Controller4B "use toEnum 0x4B instead" #-} +{-# DEPRECATED Controller4C "use toEnum 0x4C instead" #-} +{-# DEPRECATED Controller4D "use toEnum 0x4D instead" #-} +{-# DEPRECATED Controller4E "use toEnum 0x4E instead" #-} +{-# DEPRECATED Controller4F "use toEnum 0x4F instead" #-} +{-# DEPRECATED GeneralPurpose5 "use generalPurpose5 instead" #-} +{-# DEPRECATED GeneralPurpose6 "use generalPurpose6 instead" #-} +{-# DEPRECATED GeneralPurpose7 "use generalPurpose7 instead" #-} +{-# DEPRECATED GeneralPurpose8 "use generalPurpose8 instead" #-} +{-# DEPRECATED Controller54 "use toEnum 0x54 instead" #-} +{-# DEPRECATED Controller55 "use toEnum 0x55 instead" #-} +{-# DEPRECATED Controller56 "use toEnum 0x56 instead" #-} +{-# DEPRECATED Controller57 "use toEnum 0x57 instead" #-} +{-# DEPRECATED Controller58 "use toEnum 0x58 instead" #-} +{-# DEPRECATED Controller59 "use toEnum 0x59 instead" #-} +{-# DEPRECATED Controller5A "use toEnum 0x5A instead" #-} +{-# DEPRECATED ExtDepth "use extDepth instead" #-} +{-# DEPRECATED TremoloDepth "use tremoloDepth instead" #-} +{-# DEPRECATED ChorusDepth "use chorusDepth instead" #-} +{-# DEPRECATED CelesteDepth "use celesteDepth instead" #-} +{-# DEPRECATED PhaserDepth "use phaserDepth instead" #-} + +{-# DEPRECATED DataIncrement "use dataIncrement instead" #-} +{-# DEPRECATED DataDecrement "use dataDecrement instead" #-} +{-# DEPRECATED NonRegisteredParameterLSB "use nonRegisteredParameterLSB instead" #-} +{-# DEPRECATED NonRegisteredParameterMSB "use nonRegisteredParameterMSB instead" #-} +{-# DEPRECATED RegisteredParameterLSB "use registeredParameterLSB instead" #-} +{-# DEPRECATED RegisteredParameterMSB "use registeredParameterMSB instead" #-} +{-# DEPRECATED Controller66 "use toEnum 0x66 instead" #-} +{-# DEPRECATED Controller67 "use toEnum 0x67 instead" #-} +{-# DEPRECATED Controller68 "use toEnum 0x68 instead" #-} +{-# DEPRECATED Controller69 "use toEnum 0x69 instead" #-} +{-# DEPRECATED Controller6A "use toEnum 0x6A instead" #-} +{-# DEPRECATED Controller6B "use toEnum 0x6B instead" #-} +{-# DEPRECATED Controller6C "use toEnum 0x6C instead" #-} +{-# DEPRECATED Controller6D "use toEnum 0x6D instead" #-} +{-# DEPRECATED Controller6E "use toEnum 0x6E instead" #-} +{-# DEPRECATED Controller6F "use toEnum 0x6F instead" #-} +{-# DEPRECATED Controller70 "use toEnum 0x70 instead" #-} +{-# DEPRECATED Controller71 "use toEnum 0x71 instead" #-} +{-# DEPRECATED Controller72 "use toEnum 0x72 instead" #-} +{-# DEPRECATED Controller73 "use toEnum 0x73 instead" #-} +{-# DEPRECATED Controller74 "use toEnum 0x74 instead" #-} +{-# DEPRECATED Controller75 "use toEnum 0x75 instead" #-} +{-# DEPRECATED Controller76 "use toEnum 0x76 instead" #-} +{-# DEPRECATED Controller77 "use toEnum 0x77 instead" #-} +{-# DEPRECATED Controller78 "use toEnum 0x78 instead" #-} +{-# DEPRECATED Controller79 "use toEnum 0x79 instead" #-} +{-# DEPRECATED Controller7A "use toEnum 0x7A instead" #-} +{-# DEPRECATED Controller7B "use toEnum 0x7B instead" #-} +{-# DEPRECATED Controller7C "use toEnum 0x7C instead" #-} +{-# DEPRECATED Controller7D "use toEnum 0x7D instead" #-} +{-# DEPRECATED Controller7E "use toEnum 0x7E instead" #-} +{-# DEPRECATED Controller7F "use toEnum 0x7F instead" #-} + + {- | Types of predefined MIDI controllers. -} @@ -296,25 +454,99 @@ | {- 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 +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 + + +bankSelectMSB, modulationMSB, breathControlMSB, footControlMSB, + portamentoTimeMSB, dataEntryMSB, mainVolumeMSB, balanceMSB, + panoramaMSB, expressionMSB, generalPurpose1MSB, generalPurpose2MSB, + generalPurpose3MSB, generalPurpose4MSB, bankSelectLSB, modulationLSB, + breathControlLSB, footControlLSB, portamentoTimeLSB, dataEntryLSB, + mainVolumeLSB, balanceLSB, panoramaLSB, expressionLSB, + generalPurpose1LSB, generalPurpose2LSB, generalPurpose3LSB, generalPurpose4LSB :: Controller + +sustain, porta, sustenuto, softPedal, hold2, + generalPurpose5, generalPurpose6, generalPurpose7, generalPurpose8, + extDepth, tremoloDepth, chorusDepth, celesteDepth, phaserDepth :: Controller + +dataIncrement, dataDecrement, + nonRegisteredParameterLSB, nonRegisteredParameterMSB, + registeredParameterLSB, registeredParameterMSB :: Controller + + +bankSelectMSB = BankSelectMSB {- 00 00 -} +modulationMSB = ModulationMSB {- 01 01 -} +breathControlMSB = BreathControlMSB {- 02 02 -} +footControlMSB = FootControlMSB {- 04 04 -} +portamentoTimeMSB = PortamentoTimeMSB {- 05 05 -} +dataEntryMSB = DataEntryMSB {- 06 06 -} +mainVolumeMSB = MainVolumeMSB {- 07 07 -} +balanceMSB = BalanceMSB {- 08 08 -} +panoramaMSB = PanoramaMSB {- 10 0A -} +expressionMSB = ExpressionMSB {- 11 0B -} +generalPurpose1MSB = GeneralPurpose1MSB {- 16 10 -} +generalPurpose2MSB = GeneralPurpose2MSB {- 17 11 -} +generalPurpose3MSB = GeneralPurpose3MSB {- 18 12 -} +generalPurpose4MSB = GeneralPurpose4MSB {- 19 13 -} +bankSelectLSB = BankSelectLSB {- 32 20 -} +modulationLSB = ModulationLSB {- 33 21 -} +breathControlLSB = BreathControlLSB {- 34 22 -} +footControlLSB = FootControlLSB {- 36 24 -} +portamentoTimeLSB = PortamentoTimeLSB {- 37 25 -} +dataEntryLSB = DataEntryLSB {- 38 26 -} +mainVolumeLSB = MainVolumeLSB {- 39 27 -} +balanceLSB = BalanceLSB {- 40 28 -} +panoramaLSB = PanoramaLSB {- 42 2A -} +expressionLSB = ExpressionLSB {- 43 2B -} +generalPurpose1LSB = GeneralPurpose1LSB {- 48 30 -} +generalPurpose2LSB = GeneralPurpose2LSB {- 49 31 -} +generalPurpose3LSB = GeneralPurpose3LSB {- 50 32 -} +generalPurpose4LSB = GeneralPurpose4LSB {- 51 33 -} + +sustain = Sustain {- 64 40 -} +porta = Porta {- 65 41 -} +sustenuto = Sustenuto {- 66 42 -} +softPedal = SoftPedal {- 67 43 -} +hold2 = Hold2 {- 69 45 -} +generalPurpose5 = GeneralPurpose5 {- 80 50 -} +generalPurpose6 = GeneralPurpose6 {- 81 51 -} +generalPurpose7 = GeneralPurpose7 {- 82 52 -} +generalPurpose8 = GeneralPurpose8 {- 83 53 -} +extDepth = ExtDepth {- 91 5B -} +tremoloDepth = TremoloDepth {- 92 5C -} +chorusDepth = ChorusDepth {- 93 5D -} +celesteDepth = CelesteDepth {- 94 5E -} +phaserDepth = PhaserDepth {- 95 5F -} + +dataIncrement = DataIncrement {- 96 60 -} +dataDecrement = DataDecrement {- 97 61 -} +nonRegisteredParameterLSB = NonRegisteredParameterLSB {- 98 62 -} +nonRegisteredParameterMSB = NonRegisteredParameterMSB {- 99 63 -} +registeredParameterLSB = RegisteredParameterLSB {- 100 64 -} +registeredParameterMSB = RegisteredParameterMSB {- 101 65 -} diff --git a/src/Sound/MIDI/File/Load.hs b/src/Sound/MIDI/File/Load.hs --- a/src/Sound/MIDI/File/Load.hs +++ b/src/Sound/MIDI/File/Load.hs @@ -12,8 +12,10 @@ But it seems to be not sensible to re-use functionality from the @iff@ package. -} -module Sound.MIDI.File.Load (fromFile, fromStream, maybeFromStream, showFile) - where +module Sound.MIDI.File.Load + (fromFile, fromStream, maybeFromStream, + maybeEventFromStream, + showFile, ) where import Sound.MIDI.File import qualified Sound.MIDI.File as MIDIFile @@ -198,7 +200,37 @@ getSchedEvent :: TrackParser MIDIFile.SchedEvent getSchedEvent = liftM2 (,) (lift getVar) getEvent + + +maybeEventFromStream :: ByteString -> Either String (MIDIFile.Event, ByteString) +maybeEventFromStream = evalParser getIndividualEvent + + {- | +Parse an event, but without a state for the current type of events +like in 'getEvent'. +-} +getIndividualEvent :: ByteParser MIDIFile.Event +getIndividualEvent = + do + tag <- get1 + case tag of + 240 -> liftM SysExStart $ getBigN =<< getVar + 247 -> liftM SysExCont $ getBigN =<< getVar +{- + 255 -> + do + code <- get1 + size <- getVar + liftM MetaEvent (getMetaEvent code size) +-} + _ -> if tag>127 + then let parseEv = decodeStatus tag + in get1 >>= parseEvent parseEv + else fail "There is no default MIDI event type when parsing individual MIDI events." + + +{- | Parse an event. Note that in the case of a regular MIDI Event, the tag is the status, and we read the first byte of data before we call 'getMIDIEvent'. In the case of a MIDIEvent with running status, we find out the status from @@ -217,7 +249,7 @@ code <- get1 size <- getVar liftM MetaEvent (getMetaEvent code size) - x -> if x>127 + _ -> if tag>127 then let parseEv = decodeStatus tag in putEventParser parseEv >> lift (get1 >>= parseEvent parseEv) else -- running status @@ -385,6 +417,7 @@ {- | Functions to show the decoded contents of a MIDI file in an easy-to-read format. +This is for debugging purposes and should not be used in production code. -} showFile :: FilePath -> IO () showFile fileName = putStr . showChunks =<< readBinaryFile fileName @@ -453,7 +486,7 @@ the type and channel can be omitted for all but the first event. To implement this /feature/, the parser must keep track of the type and channel of the most recent MIDI Event. -This is done by setting a 'EventParser' parser, +This is done by setting an 'EventParser' parser, which parses the data bytes according to the currently active event type. -} type TrackParser a = ParserState.T EventParser ByteString a diff --git a/src/Sound/MIDI/File/Save.hs b/src/Sound/MIDI/File/Save.hs --- a/src/Sound/MIDI/File/Save.hs +++ b/src/Sound/MIDI/File/Save.hs @@ -2,11 +2,12 @@ Save MIDI data to files. The functions in this module allow 'Sound.MIDI.File.T's -to be made into Standard MIDI files (@*.mid@) +to be written into Standard MIDI files (@*.mid@) that can be read and played by music programs such as Cakewalk. -} -module Sound.MIDI.File.Save (toFile, toStream, toOpenStream) where +module Sound.MIDI.File.Save + (toFile, toStream, toOpenStream, eventToStream, ) where import Sound.MIDI.File import qualified Sound.MIDI.File as MIDIFile @@ -23,23 +24,35 @@ {- | The function 'toFile' is the main function -for writing 'MIDIFile.T' values to an actual file; -its first argument is the filename: +for writing 'MIDIFile.T' values to an actual file. -} - -toFile :: FilePath -> MIDIFile.T -> IO () +toFile :: FilePath {- ^ file name -} -> MIDIFile.T -> IO () toFile fn mf = writeBinaryFile fn (toStream mf) -{- | +{- MIDI files are first converted to a monadic string computation using the function 'outMF', and then \"executed\" using 'execWriter'. -} -toStream, toOpenStream :: MIDIFile.T -> ByteString -toStream = execWriter . outMF outChunk +{- | +Convert a MIDI file to a ByteString. +-} +toStream :: MIDIFile.T -> ByteString +toStream = execWriter . outMF outChunk + +{- | +Convert a MIDI file to a ByteString +while replacing chunk lengths by (-1). +This way writing the file is more lazy. +I don't know whether this is useful for anything, +thus simply don't use it. +-} +{-# DEPRECATED toOpenStream "use toStream instead" #-} +toOpenStream :: MIDIFile.T -> ByteString toOpenStream = execWriter . outMF outOpenChunk + outMF :: OutChunk -> MIDIFile.T -> MIDIWriter () outMF outChk (MIDIFile.Cons mft divisn trks) = do @@ -63,6 +76,10 @@ EventList.mapM_ outVar outputEvent $ EventList.snoc trk 0 (MetaEvent EndOfTrack) + +eventToStream :: MIDIFile.Event -> ByteString +eventToStream = execWriter . outputEvent + {- | The following functions encode various 'MIDIFile.T' elements into the raw data of a standard MIDI file. @@ -73,7 +90,8 @@ case e of MIDIEvent ch mevent -> outputMIDIEvent ch mevent MetaEvent mevent -> outputMetaEvent mevent - _ -> error ("don't know, how to write a "++show e++".") + SysExStart bytes -> outInt 1 240 >> outLenByteStr bytes + SysExCont bytes -> outInt 1 247 >> outLenByteStr bytes outputMIDIEvent :: MIDIEvent.Channel -> MIDIEvent.T -> MIDIWriter () outputMIDIEvent c e = @@ -100,8 +118,7 @@ do outInt 1 255 outInt 1 code - outVar (genericLength bytes) - outByteStr bytes + outLenByteStr bytes outMetaStr :: Int -> String -> MIDIWriter () outMetaStr code = @@ -156,6 +173,11 @@ outByteStr :: ByteString -> MIDIWriter () outByteStr = tell + +outLenByteStr :: ByteString -> MIDIWriter () +outLenByteStr bytes = + do outVar (genericLength bytes) + outByteStr bytes {- | Numbers of variable size are represented by sequences of 7-bit blocks diff --git a/src/Sound/MIDI/Parser.hs b/src/Sound/MIDI/Parser.hs --- a/src/Sound/MIDI/Parser.hs +++ b/src/Sound/MIDI/Parser.hs @@ -3,12 +3,13 @@ -} module Sound.MIDI.Parser - (T, zeroOrMore, oneOrMore, StateT(..), force) where + (T, zeroOrMore, oneOrMore, StateT(..), force, ) where -import Control.Monad.State (StateT(StateT, runStateT), liftM2, mplus) +import Control.Monad.State (StateT(StateT, runStateT), liftM2, mplus, ) import Control.Monad.Error () -type T s a = StateT s (Either String) a +type T s = StateT s (Either String) + {- | Wadler's force function diff --git a/src/Sound/MIDI/ParserState.hs b/src/Sound/MIDI/ParserState.hs --- a/src/Sound/MIDI/ParserState.hs +++ b/src/Sound/MIDI/ParserState.hs @@ -3,13 +3,14 @@ -} module Sound.MIDI.ParserState - (T, zeroOrMore, oneOrMore, StateT(..)) where + (T, zeroOrMore, oneOrMore, StateT(..), ) where import qualified Sound.MIDI.Parser as Parser -import Control.Monad.State (StateT(..), mapStateT, liftM2, mplus) +import Control.Monad.State (StateT(..), mapStateT, liftM2, mplus, ) -type T st s a = StateT st (StateT s (Either String)) a +type T st s = StateT st (Parser.T s) + {- | Wadler's force function