synthesizer-midi 0.5 → 0.6
raw patch · 5 files changed
+107/−59 lines, 5 filesdep +synthesizer-mididep ~basedep ~containersdep ~deepseq
Dependencies added: synthesizer-midi
Dependency ranges changed: base, containers, deepseq, event-list, midi, non-negative, numeric-prelude, sox, storablevector, synthesizer-core, synthesizer-dimensional, transformers
Files
- src/Synthesizer/MIDI/CausalIO/Process.hs +62/−36
- src/Synthesizer/MIDI/Dimensional.hs +1/−2
- src/Synthesizer/MIDI/EventList.hs +1/−1
- src/Test.hs +1/−1
- synthesizer-midi.cabal +42/−19
src/Synthesizer/MIDI/CausalIO/Process.hs view
@@ -23,6 +23,7 @@ sequenceCore, sequenceModulated, sequenceModulatedMultiProgram,+ sequenceModulatedMultiProgramVelocityPitch, sequenceStorable, -- auxiliary function@@ -102,7 +103,7 @@ (y -> c) -> c -> PIO.T- (EventListTT.T StrictTime [y])+ (Events y) (EventListBT.T PC.ShortStrictTime c) initWith f initial = PIO.traverse initial $@@ -231,9 +232,8 @@ (Check.C event, Arrow arrow) => MIDIEv.Channel -> arrow- (EventListTT.T StrictTime [event])- (EventListTT.T StrictTime- [Either MIDIEv.Program (MIDIEv.NoteBoundary Bool)])+ (Events event)+ (Events (Either MIDIEv.Program (MIDIEv.NoteBoundary Bool))) noteEvents chan = mapMaybe $ MIDIEv.checkNoteEvent chan @@ -241,10 +241,8 @@ embedPrograms :: MIDIEv.Program -> PIO.T- (EventListTT.T StrictTime- [Either MIDIEv.Program (MIDIEv.NoteBoundary Bool)])- (EventListTT.T StrictTime- [MIDIEv.NoteBoundary (Maybe MIDIEv.Program)])+ (Events (Either MIDIEv.Program (MIDIEv.NoteBoundary Bool)))+ (Events (MIDIEv.NoteBoundary (Maybe MIDIEv.Program))) embedPrograms initPgm = catMaybes . traverse initPgm MIDIEv.embedProgramState@@ -278,7 +276,7 @@ newtype NoteOffList = NoteOffList {- unwrapNoteOffList :: EventListTT.T StrictTime [NoteBoundary NoteId]+ unwrapNoteOffList :: Events (NoteBoundary NoteId) } @@ -331,8 +329,7 @@ findEvent :: (a -> Bool) ->- EventListTT.T StrictTime [a] ->- (EventListTT.T StrictTime [a], Maybe a)+ Events a -> (Events a, Maybe a) findEvent p = EventListTT.foldr (\t -> mapFst (EventListMT.consTime t))@@ -365,8 +362,7 @@ case end of NoteBoundary _ endVel _ -> endVel {-- AllNotesOff ->- VoiceMsg.toVelocity VoiceMsg.normalVelocity -} )+ AllNotesOff -> VoiceMsg.normalVelocity -} ) data NoteBoundary a =@@ -405,8 +401,7 @@ concatMap (\(pitch, range) -> map (\noteId ->- NoteBoundary pitch- (VoiceMsg.toVelocity VoiceMsg.normalVelocity)+ NoteBoundary pitch VoiceMsg.normalVelocity (noteId, Nothing)) (flattenNoteIdRange range)) $ Map.toList notes@@ -434,16 +429,24 @@ MS.modify (Map.insert pitch (nextNoteOffId, succNoteId nextNoteOnId)) return [nextNoteOnId]) +{-# INLINE velFreqBank #-}+velFreqBank ::+ (Trans.C y) =>+ (MIDIEv.Program -> y -> y -> process) ->+ (MIDIEv.Program -> MIDIEv.Velocity -> MIDIEv.Pitch -> process)+velFreqBank bank pgm vel pitch =+ bank pgm (MV.velocity vel) (MV.frequencyFromPitch pitch)+ applyInstrumentCore ::- (Arrow arrow, Trans.C y) =>+ (Arrow arrow) => ((MIDIEv.Pitch, NoteId) -> noteOffListCtrl -> gateCtrl) ->- (MIDIEv.Program -> y -> y -> PIO.T gateCtrl chunk) ->+ (MIDIEv.Program -> MIDIEv.Velocity -> MIDIEv.Pitch ->+ PIO.T gateCtrl chunk) -> arrow- (EventListTT.T StrictTime- [NoteBoundary (NoteId, Maybe MIDIEv.Program)])+ (Events (NoteBoundary (NoteId, Maybe MIDIEv.Program))) (Zip.T NoteOffList- (EventListTT.T StrictTime [PIO.T noteOffListCtrl chunk]))+ (Events (PIO.T noteOffListCtrl chunk))) applyInstrumentCore makeGate bank = arr $ uncurry Zip.Cons . mapFst NoteOffList .@@ -456,21 +459,21 @@ Nothing -> Left $ NoteBoundary pitch vel noteId Just pgm -> Right $- bank pgm (MV.velocity vel)- (MV.frequencyFromPitch pitch)+ bank pgm vel pitch <<^ makeGate (pitch, noteId))) applyInstrument ::- (Arrow arrow, Trans.C y) =>- Bank y chunk ->+ (Arrow arrow) =>+ (MIDIEv.Program -> MIDIEv.Velocity -> MIDIEv.Pitch ->+ PIO.T GateChunk chunk) -> arrow- (EventListTT.T StrictTime- [NoteBoundary (NoteId, Maybe MIDIEv.Program)])+ (Events (NoteBoundary (NoteId, Maybe MIDIEv.Program))) (Zip.T NoteOffList- (EventListTT.T StrictTime [PIO.T NoteOffList chunk]))-applyInstrument = applyInstrumentCore gateFromNoteOffs+ (Events (PIO.T NoteOffList chunk)))+applyInstrument bank =+ applyInstrumentCore gateFromNoteOffs bank type ModulatedBank y ctrl chunk =@@ -478,17 +481,16 @@ PIO.T (Zip.T GateChunk ctrl) chunk applyModulatedInstrument ::- (Arrow arrow, Trans.C y, CutG.Read ctrl) =>- ModulatedBank y ctrl chunk ->+ (Arrow arrow, CutG.Read ctrl) =>+ (MIDIEv.Program -> MIDIEv.Velocity -> MIDIEv.Pitch ->+ PIO.T (Zip.T GateChunk ctrl) chunk) -> arrow (Zip.T- (EventListTT.T StrictTime- [NoteBoundary (NoteId, Maybe MIDIEv.Program)])+ (Events (NoteBoundary (NoteId, Maybe MIDIEv.Program))) ctrl) (Zip.T (Zip.T NoteOffList ctrl)- (EventListTT.T StrictTime- [PIO.T (Zip.T NoteOffList ctrl) chunk]))+ (Events (PIO.T (Zip.T NoteOffList ctrl) chunk))) applyModulatedInstrument bank = (\(Zip.Cons (Zip.Cons noteOffs events) ctrl) -> Zip.Cons (Zip.Cons noteOffs ctrl) events)@@ -628,7 +630,7 @@ . flattenControlSchedule .- applyInstrument bank+ applyInstrument (velFreqBank bank) . assignNoteIds .@@ -648,7 +650,7 @@ . flattenControlSchedule .- applyModulatedInstrument bank+ applyModulatedInstrument (velFreqBank bank) . Zip.arrowFirst (assignNoteIds@@ -666,6 +668,30 @@ ModulatedBank y ctrl chunk -> PIO.T (Zip.T (Events event) ctrl) (EventListTT.T StrictTime chunk) sequenceModulatedMultiProgram channel initPgm bank =+ applyModulation+ .+ flattenControlSchedule+ .+ applyModulatedInstrument (velFreqBank bank)+ .+ Zip.arrowFirst+ (assignNoteIds+ .+ embedPrograms initPgm+ .+ noteEvents channel)+++-- | may replace the other functions+sequenceModulatedMultiProgramVelocityPitch ::+ (Check.C event, Monoid chunk, CutG.Read chunk,+ CutG.Transform ctrl, CutG.NormalForm ctrl) =>+ MIDIEv.Channel ->+ MIDIEv.Program ->+ (MIDIEv.Program -> MIDIEv.Velocity -> MIDIEv.Pitch ->+ PIO.T (Zip.T GateChunk ctrl) chunk) ->+ PIO.T (Zip.T (Events event) ctrl) (EventListTT.T StrictTime chunk)+sequenceModulatedMultiProgramVelocityPitch channel initPgm bank = applyModulation . flattenControlSchedule
src/Synthesizer/MIDI/Dimensional.hs view
@@ -37,7 +37,6 @@ import qualified Synthesizer.ChunkySize as ChunkySize import qualified Synthesizer.Generic.Cut as CutG-import qualified Synthesizer.Generic.Signal2 as SigG2 import qualified Synthesizer.Generic.Signal as SigG import qualified Synthesizer.Storable.Cut as CutSt import qualified Synthesizer.Storable.Signal as SigSt@@ -185,7 +184,7 @@ {-# INLINE bendWheelPressure #-} bendWheelPressure :: (Check.C event,- SigG.Write sig q, SigG2.Transform sig q q,+ SigG.Write sig q, SigG.Transform sig q, RealField.C q, Trans.C q, Module.C q q, Dim.C u) => Channel -> Int -> DN.T (Dim.Recip u) q -> q -> q ->
src/Synthesizer/MIDI/EventList.hs view
@@ -120,7 +120,7 @@ Channel -> event -> Maybe (Either Program (NoteBoundary Bool)) checkNoteEvent chan e = msum $- case_ (Check.note chan e) (\(velocity, pitch, press) ->+ case_ (Check.noteExplicitOff chan e) (\(velocity, pitch, press) -> Right $ NoteBoundary pitch velocity press) : case_ (Check.program chan e) Left : {-
src/Test.hs view
@@ -139,7 +139,7 @@ (ChannelMsg.toChannel 0) (ChannelMsg.Voice $ note (VoiceMsg.toPitch pitch)- (VoiceMsg.toVelocity VoiceMsg.normalVelocity))+ VoiceMsg.normalVelocity) makeNoteOn, makeNoteOff :: Int -> ChannelMsg.T makeNoteOn = makeNote VoiceMsg.NoteOn
synthesizer-midi.cabal view
@@ -1,5 +1,5 @@ Name: synthesizer-midi-Version: 0.5+Version: 0.6 License: GPL License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -15,11 +15,11 @@ Stability: Experimental Tested-With: GHC==6.12.3 Tested-With: GHC==7.2.1-Cabal-Version: >=1.6+Cabal-Version: >=1.14 Build-Type: Simple Source-Repository this- Tag: 0.4+ Tag: 0.6 Type: darcs Location: http://code.haskell.org/synthesizer/midi/ @@ -40,21 +40,21 @@ Library Build-Depends:- synthesizer-dimensional >=0.6 && <0.7,- synthesizer-core >=0.5 && <0.6,+ synthesizer-dimensional >=0.7 && <0.8,+ synthesizer-core >=0.6 && <0.7, sox >=0.2.1 && <0.3,- midi >=0.1.7 && <0.2,+ midi >=0.2.1 && <0.3, storable-record >=0.0.2 && <0.1, storablevector >=0.2.5 && <0.3,- deepseq >=1.1 && <1.2,- numeric-prelude >=0.3 && <0.4,+ deepseq >=1.1 && <1.4,+ numeric-prelude >=0.3 && <0.5, non-negative >=0.1 && <0.2, event-list >=0.1 && <0.2, data-accessor-transformers >=0.2.1 && <0.3, data-accessor >=0.2.1 && <0.3,- containers >=0.1 && <0.5,+ containers >=0.1 && <0.6, array >=0.1 && <0.5,- transformers >=0.2 && <0.3,+ transformers >=0.2 && <0.4, utility-ht >=0.0.1 && <0.1 If flag(splitBase)@@ -67,8 +67,9 @@ If impl(ghc>=7.0) GHC-Options: -fwarn-unused-do-bind CPP-Options: -DNoImplicitPrelude=RebindableSyntax- Extensions: CPP+ Default-Extensions: CPP + Default-Language: Haskell2010 GHC-Options: -Wall Hs-source-dirs: src Exposed-modules:@@ -92,23 +93,45 @@ Synthesizer.MIDI.Dimensional.ValuePlain Executable render-midi- If !flag(buildExamples)+ If flag(buildExamples)+ Build-Depends:+ synthesizer-midi,+ synthesizer-core,+ sox,+ storablevector,+ numeric-prelude,+ midi,+ event-list,+ non-negative,+ transformers,+ base+ Else Buildable: False+ Default-Language: Haskell2010 GHC-Options: -Wall If impl(ghc>=7.0) GHC-Options: -fwarn-unused-do-bind CPP-Options: -DNoImplicitPrelude=RebindableSyntax- Extensions: CPP- Hs-Source-Dirs: src- Main-Is: Render.hs+ Default-Extensions: CPP+ Main-Is: src/Render.hs Executable test- If !flag(buildTests)+ If flag(buildTests)+ Build-Depends:+ synthesizer-midi,+ synthesizer-core,+ storablevector,+ numeric-prelude,+ midi,+ event-list,+ transformers,+ base+ Else Buildable: False+ Default-Language: Haskell2010 GHC-Options: -Wall If impl(ghc>=7.0) GHC-Options: -fwarn-unused-do-bind CPP-Options: -DNoImplicitPrelude=RebindableSyntax- Extensions: CPP- Hs-Source-Dirs: src- Main-Is: Test.hs+ Default-Extensions: CPP+ Main-Is: src/Test.hs