{- |
Channel messages
-}moduleSound.MIDI.Message.Channel(T(..),Body(..),get,getWithStatus,put,putWithStatus,Channel,fromChannel,toChannel,Voice.Pitch,Voice.fromPitch,Voice.toPitch,Voice.Velocity,Voice.fromVelocity,Voice.toVelocity,Voice.Program,Voice.fromProgram,Voice.toProgram,Voice.Controller,Voice.fromController,Voice.toController,decodeStatus,)whereimportqualifiedSound.MIDI.Message.Channel.VoiceasVoiceimportqualifiedSound.MIDI.Message.Channel.ModeasModeimportqualifiedSound.MIDI.Parser.StatusasStatusParserimportSound.MIDI.Parser.PrimitiveimportqualifiedSound.MIDI.Parser.ClassasParserimportSound.MIDI.Parser.Status(Channel,fromChannel,toChannel,)importControl.Monad(liftM,liftM2,when,)importqualifiedSound.MIDI.Writer.StatusasStatusWriterimportqualifiedSound.MIDI.Writer.BasicasWriterimportqualifiedSound.MIDI.BitasBitimportSound.MIDI.Monoid((+#+))importSound.MIDI.Utility({-checkRange,-}mapSnd,)-- import Data.Ix (Ix)importTest.QuickCheck(Arbitrary(arbitrary),)importqualifiedTest.QuickCheckasQCdataT=Cons{messageChannel::Channel,messageBody::Body}deriving(Show,Eq,Ord)dataBody=VoiceVoice.T|ModeMode.Tderiving(Show,Eq,Ord)instanceArbitraryTwherearbitrary=liftM2Cons(liftMtoChannel$QC.frequency$-- we have to prefer one favorite channel in order to test correct implementation of the running status(20,return3):(1,QC.choose(0,15)):[])(QC.frequency$(20,liftMVoicearbitrary):(1,liftMModearbitrary):[])-- * serialization{- |
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 'get'.
In the case of a MIDIEvent with running status,
we find out the status from the parser
(it's been nice enough to keep track of it for us),
and the tag that we've already gotten is the first byte of data.
-}getWithStatus::Parser.Cparser=>Int->Parser.Fallible(StatusParser.Tparser)TgetWithStatustag=do(status@(code,channel),firstData)<-iftag<0x80thenmaybe(Parser.giveUp"messages wants to repeat status byte, but there was no status yet")(\cc->return(cc,tag))=<<StatusParser.getelseliftM((,)$decodeStatustag)$StatusParser.liftget1StatusParser.set(Juststatus)StatusParser.lift$getcodechannelfirstData-- | for internal usedecodeStatus::Int->(Int,Channel)decodeStatus=mapSndtoChannel.Bit.splitAt4{- |
Parse a MIDI Channel message.
Note that since getting the first byte is a little complex
(there are issues with running status),
the code, channel and first data byte
must be determined by the caller.
-}get::Parser.Cparser=>Int->Channel->Int->Parser.FallibleparserTgetcodechannelfirstData=liftM(Conschannel)$ifcode==11&&firstData>=0x78thenwhen(firstData>=0x80)(Parser.giveUp("mode value out of range: "++showfirstData))>>liftMMode(Mode.getfirstData)elseliftMVoice(Voice.getcodefirstData)put::Writer.Cwriter=>T->writerput=StatusWriter.toWriterWithoutStatus.putWithStatusputWithStatus::Writer.Cwriter=>T->StatusWriter.TwriterputWithStatus(Consce)=caseeofVoicev->Voice.putWithStatus(putChannelc)vModem->putChannelc11+#+StatusWriter.lift(Mode.putm)-- | output a channel + message codeputChannel::Writer.Cwriter=>Channel->Int->StatusWriter.TwriterputChannelchancode=StatusWriter.change(Just(code,chan))$Writer.putIntAsByte(16*code+fromChannelchan)