diff --git a/src/Synthesizer/CausalIO/ALSA/MIDIControllerSelection.hs b/src/Synthesizer/CausalIO/ALSA/MIDIControllerSelection.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/CausalIO/ALSA/MIDIControllerSelection.hs
@@ -0,0 +1,112 @@
+module Synthesizer.CausalIO.ALSA.MIDIControllerSelection (
+   fromChannel,
+   filter,
+   T(Cons),
+
+   controllerLinear,
+   controllerExponential,
+   pitchBend,
+   channelPressure,
+   ) where
+
+import qualified Synthesizer.CausalIO.Process as PIO
+import qualified Synthesizer.CausalIO.ALSA.Process as PAlsa
+
+import qualified Synthesizer.PiecewiseConstant.ALSA.MIDIControllerSet as PCS
+import qualified Synthesizer.EventList.ALSA.MIDI as MIDIEv
+import qualified Synthesizer.MIDIValue as MV
+
+import qualified Sound.ALSA.Sequencer.Event as Event
+
+-- import qualified Data.EventList.Relative.TimeBody  as EventList
+import qualified Data.EventList.Relative.TimeTime  as EventListTT
+
+import qualified Algebra.Transcendental as Trans
+import qualified Algebra.Field          as Field
+
+import qualified Data.Map as Map
+import qualified Data.Maybe as Maybe
+import Data.Tuple.HT (mapSnd, )
+
+import Control.Arrow (Arrow, )
+
+import NumericPrelude.Numeric
+import NumericPrelude.Base hiding ((.), filter, )
+import Prelude ()
+
+
+
+fromChannel ::
+   (Arrow arrow) =>
+   MIDIEv.Channel ->
+   arrow
+      (EventListTT.T MIDIEv.StrictTime [Event.T])
+      (EventListTT.T MIDIEv.StrictTime [(PCS.Controller, Int)])
+fromChannel chan =
+   PAlsa.mapMaybe $ PCS.maybeController chan
+
+
+-- see PCS.mapInsertMany
+mapInsertMany ::
+   (Ord key) =>
+   [(key,a)] -> Map.Map key a -> Map.Map key a
+mapInsertMany assignments inits =
+   foldl (flip (uncurry Map.insert)) inits assignments
+
+
+
+data T a =
+   Cons PCS.Controller (Int -> a) a
+
+filter ::
+   [T a] ->
+   PIO.T
+      (EventListTT.T MIDIEv.StrictTime [(PCS.Controller, Int)])
+      (PCS.T Int a)
+filter mapping =
+   let dict =
+          Map.fromList $
+          zipWith (\n (Cons cc f _init) -> (cc, (n, f)))
+             [0 ..] mapping
+   in  PIO.mapAccum
+          (\evs curMap ->
+             let ctrlEvs =
+                    fmap (Maybe.mapMaybe (\(cc, val) ->
+                       fmap (mapSnd ($val)) $ Map.lookup cc dict)) evs
+             in  (PCS.Cons curMap ctrlEvs,
+                  mapInsertMany
+                     (concat $ EventListTT.getBodies ctrlEvs)
+                     curMap))
+          (Map.fromList $ zip [0..] $
+           map (\(Cons _cc _f initVal) -> initVal) mapping)
+
+
+controllerLinear ::
+   (Field.C y) =>
+   MIDIEv.Controller ->
+   (y,y) -> y ->
+   T y
+controllerLinear ctrl bnd initial =
+   Cons (PCS.Controller ctrl) (MV.controllerLinear bnd) initial
+
+controllerExponential ::
+   (Trans.C y) =>
+   MIDIEv.Controller ->
+   (y,y) -> y ->
+   T y
+controllerExponential ctrl bnd initial =
+   Cons (PCS.Controller ctrl) (MV.controllerExponential bnd) initial
+
+pitchBend ::
+   (Trans.C y) =>
+   y -> y ->
+   T y
+pitchBend range center =
+   Cons PCS.PitchBend (MV.pitchBend range center) center
+
+channelPressure ::
+   (Trans.C y) =>
+   y -> y ->
+   T y
+channelPressure maxVal initial =
+   Cons PCS.Pressure (MV.controllerLinear (zero,maxVal)) initial
diff --git a/src/Synthesizer/CausalIO/ALSA/MIDIControllerSet.hs b/src/Synthesizer/CausalIO/ALSA/MIDIControllerSet.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/CausalIO/ALSA/MIDIControllerSet.hs
@@ -0,0 +1,156 @@
+module Synthesizer.CausalIO.ALSA.MIDIControllerSet (
+   T,
+   fromChannel,
+   slice, PCS.Controller(..),
+
+   controllerLinear,
+   controllerExponential,
+   pitchBend,
+   channelPressure,
+   bendWheelPressure,
+   ) where
+
+import qualified Synthesizer.CausalIO.Process as PIO
+import qualified Synthesizer.CausalIO.ALSA.Process as PAlsa
+
+import qualified Synthesizer.PiecewiseConstant.ALSA.MIDIControllerSet as PCS
+import qualified Synthesizer.PiecewiseConstant.Signal as PC
+import qualified Synthesizer.EventList.ALSA.MIDI as MIDIEv
+import qualified Synthesizer.MIDIValue.BendModulation as BM
+import qualified Synthesizer.MIDIValue.BendWheelPressure as BWP
+import qualified Synthesizer.MIDIValue as MV
+
+import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
+import qualified Sound.ALSA.Sequencer.Event as Event
+
+-- import qualified Data.EventList.Relative.TimeBody  as EventList
+import qualified Data.EventList.Relative.TimeTime  as EventListTT
+import qualified Data.EventList.Relative.BodyTime  as EventListBT
+import qualified Data.EventList.Relative.MixedTime as EventListMT
+
+import qualified Algebra.Transcendental as Trans
+import qualified Algebra.Field          as Field
+import qualified Algebra.RealRing       as RealRing
+
+import qualified Control.Monad.Trans.State as MS
+
+import qualified Data.Accessor.Basic as Acc
+
+import qualified Data.Map as Map
+
+import Data.Traversable (Traversable, traverse, )
+import Data.Foldable (traverse_, )
+
+import Control.Arrow (Arrow, arr, )
+import Control.Category ((.), )
+
+import qualified Data.Maybe as Maybe
+import Data.Maybe.HT (toMaybe, )
+
+import NumericPrelude.Numeric
+import NumericPrelude.Base hiding ((.), )
+import Prelude ()
+
+
+
+-- see PCS.mapInsertMany
+mapInsertMany ::
+   (Ord key) =>
+   [(key,a)] -> Map.Map key a -> Map.Map key a
+mapInsertMany assignments inits =
+   foldl (flip (uncurry Map.insert)) inits assignments
+
+
+fromChannel ::
+   MIDIEv.Channel ->
+   PIO.T
+      (EventListTT.T MIDIEv.StrictTime [Event.T])
+      (PCS.T PCS.Controller Int)
+fromChannel chan =
+   (PIO.traverse Map.empty $ \evs0 -> do
+      initial <- MS.get
+      fmap (PCS.Cons initial) $
+         traverse (\ys -> MS.modify (mapInsertMany ys) >> return ys) evs0)
+   .
+   PAlsa.mapMaybe (PCS.maybeController chan)
+
+
+type T arrow y =
+   arrow
+      (PCS.T PCS.Controller Int)
+      (EventListBT.T PC.ShortStrictTime y)
+
+
+slice ::
+   (Arrow arrow) =>
+   PCS.Controller ->
+   (Int -> y) {- ^ This might be a function from "Synthesizer.MIDIValue"
+                   or "Synthesizer.Dimensional.MIDIValue" -} ->
+   y ->
+   T arrow y
+slice c f deflt =
+   arr $ \(PCS.Cons initial stream) ->
+      let yin = maybe deflt f $ Map.lookup c initial
+      in  PC.subdivideLongStrict $
+          EventListMT.consBody yin $
+          flip MS.evalState yin $
+          traverse
+             (\ys -> traverse_ (MS.put . f) ys >> MS.get) $
+          fmap
+             (Maybe.mapMaybe
+                (\(ci,a) -> toMaybe (c==ci) a))
+             stream
+
+
+controllerLinear ::
+   (Field.C y, Arrow arrow) =>
+   MIDIEv.Controller ->
+   (y,y) -> y ->
+   T arrow y
+controllerLinear ctrl bnd initial =
+   slice (PCS.Controller ctrl) (MV.controllerLinear bnd) initial
+
+controllerExponential ::
+   (Trans.C y, Arrow arrow) =>
+   MIDIEv.Controller ->
+   (y,y) -> y ->
+   T arrow y
+controllerExponential ctrl bnd initial =
+   slice (PCS.Controller ctrl) (MV.controllerExponential bnd) initial
+
+pitchBend ::
+   (Trans.C y, Arrow arrow) =>
+   y -> y ->
+   T arrow y
+pitchBend range center =
+   slice PCS.PitchBend (MV.pitchBend range center) center
+
+channelPressure ::
+   (Trans.C y, Arrow arrow) =>
+   y -> y ->
+   T arrow y
+channelPressure maxVal initial =
+   slice PCS.Pressure (MV.controllerLinear (zero,maxVal)) initial
+
+bendWheelPressure ::
+   (RealRing.C y, Trans.C y, Arrow arrow) =>
+   Int -> y -> y ->
+   T arrow (BM.T y)
+bendWheelPressure pitchRange wheelDepth pressDepth =
+   arr $ \(PCS.Cons initial stream) ->
+      let set key field =
+             maybe id (Acc.set field) $
+             Map.lookup key initial
+          yin =
+             set PCS.PitchBend BWP.bend $
+             set (PCS.Controller VoiceMsg.modulation) BWP.wheel $
+             set PCS.Pressure BWP.pressure $
+             BWP.deflt
+      in  PC.subdivideLongStrict $
+          fmap (BM.fromBendWheelPressure pitchRange wheelDepth pressDepth) $
+          EventListMT.consBody yin $
+          flip MS.evalState yin $
+          traverse (\ys0 -> traverse_ MS.put ys0 >> MS.get) $
+          fmap Maybe.catMaybes $
+          flip MS.evalState BWP.deflt $
+          traverse (traverse PCS.checkBendWheelPressure) stream
diff --git a/src/Synthesizer/CausalIO/ALSA/Process.hs b/src/Synthesizer/CausalIO/ALSA/Process.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/CausalIO/ALSA/Process.hs
@@ -0,0 +1,728 @@
+{-# LANGUAGE ExistentialQuantification #-}
+module Synthesizer.CausalIO.ALSA.Process (
+   Events,
+   playFromEvents,
+
+   slice,
+   controllerLinear,
+   controllerExponential,
+   pitchBend,
+   channelPressure,
+   bendWheelPressure,
+   constant,
+
+   Instrument,
+   Bank,
+   GateChunk,
+   noteEvents,
+   embedPrograms,
+   applyInstrument,
+   applyModulatedInstrument,
+   flattenControlSchedule,
+   applyModulation,
+   arrangeStorable,
+   sequenceCore,
+   sequenceModulated,
+   sequenceModulatedMultiProgram,
+   sequenceStorable,
+
+   -- auxiliary function
+   initWith,
+   mapMaybe,
+   ) where
+
+import qualified Synthesizer.CausalIO.Gate as Gate
+import qualified Synthesizer.CausalIO.Process as PIO
+
+import qualified Synthesizer.PiecewiseConstant.Signal as PC
+import qualified Synthesizer.PiecewiseConstant.ALSA.MIDI as AlsaPC
+import qualified Synthesizer.EventList.ALSA.MIDI as MIDIEv
+import qualified Synthesizer.Storable.ALSA.Play as Play
+import qualified Synthesizer.Storable.Cut as CutSt
+import qualified Synthesizer.Generic.Cut as CutG
+import qualified Synthesizer.Zip as Zip
+import Synthesizer.EventList.ALSA.MIDI (StrictTime, )
+
+import qualified Synthesizer.MIDIValue.BendModulation as BM
+import qualified Synthesizer.MIDIValue.BendWheelPressure as BWP
+import qualified Synthesizer.MIDIValue as MV
+
+import qualified Sound.ALSA.PCM as PCM
+import qualified Sound.ALSA.Sequencer.Event as Event
+
+import qualified Sound.MIDI.ALSA.Check as Check
+import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
+
+import Control.DeepSeq (NFData, rnf, )
+
+import qualified Data.EventList.Relative.TimeBody  as EventList
+import qualified Data.EventList.Relative.BodyTime  as EventListBT
+import qualified Data.EventList.Relative.TimeTime  as EventListTT
+import qualified Data.EventList.Relative.TimeMixed as EventListTM
+import qualified Data.EventList.Relative.MixedTime as EventListMT
+import qualified Data.EventList.Absolute.TimeBody  as AbsEventList
+
+import qualified Numeric.NonNegative.Wrapper as NonNegW
+import qualified Numeric.NonNegative.Class as NonNeg
+
+import qualified Algebra.Transcendental as Trans
+import qualified Algebra.RealField      as RealField
+import qualified Algebra.RealRing       as RealRing
+import qualified Algebra.Field          as Field
+import qualified Algebra.Additive       as Additive
+import qualified Algebra.ToInteger      as ToInteger
+
+import qualified Data.StorableVector as SV
+import qualified Data.StorableVector.ST.Strict as SVST
+import Foreign.Storable (Storable, )
+
+import Control.Exception (bracket, )
+
+import qualified Control.Monad.Trans.Writer as MW
+import qualified Control.Monad.Trans.State as MS
+import qualified Control.Monad.Trans.Class as MT
+import Control.Monad.IO.Class (liftIO, )
+
+import qualified Data.Traversable as Trav
+import Data.Traversable (Traversable, )
+import Data.Foldable (traverse_, )
+
+import Control.Arrow (Arrow, arr, (^<<), (<<^), )
+import Control.Category ((.), )
+
+import qualified Data.Map as Map
+
+import qualified Data.List.HT as ListHT
+import qualified Data.Maybe as Maybe
+import Data.Monoid (Monoid, mempty, mappend, )
+import Data.Maybe (maybeToList, )
+import Data.Tuple.HT (mapFst, mapPair, )
+
+import NumericPrelude.Numeric
+import NumericPrelude.Base hiding ((.), sequence, )
+import Prelude ()
+
+
+type Events = EventListTT.T StrictTime [Event.T]
+
+playFromEvents ::
+   (RealField.C time, PCM.SampleFmt a, Additive.C a) =>
+   Play.Device -> MIDIEv.ClientName -> time -> time -> PCM.SampleFreq ->
+   PIO.T Events (SV.Vector a) ->
+   IO ()
+playFromEvents device name latency beat rate
+      (PIO.Cons next create delete) =
+   let sink = Play.makeSink device beat rate
+       rateFloat = fromIntegral rate
+   in  MIDIEv.withMIDIEventsChunked name beat rateFloat $ \getEventsList ->
+       PCM.withSoundSink sink $ \to ->
+{-
+       Play.writeLazy sink to
+          (SVL.replicate
+              (SVL.chunkSize $ round (beat * rateFloat))
+              (round (latency * rateFloat))
+              (zero::Float))
+-}
+       Play.write sink to
+          (SV.replicate (round (latency * rateFloat)) zero) >>
+       (bracket create delete $ \state ->
+        let loop getEvs0 s0 =
+               case getEvs0 of
+                  [] -> return ()
+                  getEvents : getEvs1 -> do
+                     evs <- getEvents
+                     (pcm, s1) <- next evs s0
+                     Play.write sink to pcm
+                     loop getEvs1 s1
+        in  loop getEventsList state)
+
+
+initWith ::
+   (y -> c) ->
+   c ->
+   PIO.T
+      (EventListTT.T StrictTime [y])
+      (EventListBT.T PC.ShortStrictTime c)
+initWith f initial =
+   PIO.traverse initial $
+      \evs0 -> do
+         y0 <- MS.get
+         fmap (PC.subdivideLongStrict . EventListMT.consBody y0) $
+            Trav.traverse (\ys -> traverse_ (MS.put . f) ys >> MS.get) evs0
+
+slice ::
+   (Event.T -> Maybe Int) ->
+   (Int -> y) -> y ->
+   PIO.T
+      Events
+      (EventListBT.T PC.ShortStrictTime y)
+slice select f initial =
+   initWith f initial . mapMaybe select
+
+
+
+mapMaybe ::
+   (Arrow arrow, Functor f) =>
+   (a -> Maybe b) ->
+   arrow (f [a]) (f [b])
+mapMaybe f =
+   arr $ fmap $ Maybe.mapMaybe f
+
+catMaybes ::
+   (Arrow arrow, Functor f) =>
+   arrow (f [Maybe a]) (f [a])
+catMaybes =
+   arr $ fmap Maybe.catMaybes
+
+traverse ::
+   (Traversable f) =>
+   s -> (a -> MS.State s b) ->
+   PIO.T (f [a]) (f [b])
+traverse initial f =
+   PIO.traverse initial (Trav.traverse (Trav.traverse f))
+
+
+controllerLinear ::
+   (Field.C y) =>
+   MIDIEv.Channel ->
+   MIDIEv.Controller ->
+   (y,y) -> y ->
+   PIO.T
+      Events
+      (EventListBT.T PC.ShortStrictTime y)
+controllerLinear chan ctrl bnd initial =
+   slice (Check.controller chan ctrl)
+      (MV.controllerLinear bnd) initial
+
+controllerExponential ::
+   (Trans.C y) =>
+   MIDIEv.Channel ->
+   MIDIEv.Controller ->
+   (y,y) -> y ->
+   PIO.T
+      Events
+      (EventListBT.T PC.ShortStrictTime y)
+controllerExponential chan ctrl bnd initial =
+   slice (Check.controller chan ctrl)
+      (MV.controllerExponential bnd) initial
+
+pitchBend ::
+   (Trans.C y) =>
+   MIDIEv.Channel ->
+   y -> y ->
+   PIO.T
+      Events
+      (EventListBT.T PC.ShortStrictTime y)
+pitchBend chan range center =
+   slice (Check.pitchBend chan)
+      (MV.pitchBend range center) center
+
+channelPressure ::
+   (Trans.C y) =>
+   MIDIEv.Channel ->
+   y -> y ->
+   PIO.T
+      Events
+      (EventListBT.T PC.ShortStrictTime y)
+channelPressure chan maxVal initial =
+   slice (Check.channelPressure chan)
+      (MV.controllerLinear (zero,maxVal)) initial
+
+bendWheelPressure ::
+   (RealRing.C y, Trans.C y) =>
+   MIDIEv.Channel ->
+   Int -> y -> y ->
+   PIO.T
+      Events
+      (EventListBT.T PC.ShortStrictTime (BM.T y))
+bendWheelPressure chan
+      pitchRange wheelDepth pressDepth =
+   let toBM = BM.fromBendWheelPressure pitchRange wheelDepth pressDepth
+   in  initWith toBM (toBM BWP.deflt)
+       .
+       catMaybes
+       .
+       traverse BWP.deflt (AlsaPC.checkBendWheelPressure chan)
+
+
+-- might be moved to synthesizer-core
+constant ::
+   (Arrow arrow) =>
+   y -> arrow Events (EventListBT.T PC.ShortStrictTime y)
+constant y = arr $
+   EventListBT.singleton y .
+   NonNegW.fromNumberMsg "CausalIO.ALSA.constant" .
+   fromIntegral .
+   EventListTT.duration
+
+_constant ::
+   (Arrow arrow, CutG.Read input) =>
+   y -> arrow input (EventListBT.T PC.ShortStrictTime y)
+_constant y = arr $
+   EventListBT.singleton y .
+   NonNegW.fromNumberMsg "CausalIO.ALSA.constant" .
+   CutG.length
+
+
+
+noteEvents ::
+   (Arrow arrow) =>
+   MIDIEv.Channel ->
+   arrow
+      (EventListTT.T StrictTime [Event.T])
+      (EventListTT.T StrictTime
+         [Either MIDIEv.Program (MIDIEv.NoteBoundary Bool)])
+noteEvents chan =
+   mapMaybe $ MIDIEv.checkNoteEvent chan
+
+
+embedPrograms ::
+   MIDIEv.Program ->
+   PIO.T
+      (EventListTT.T StrictTime
+         [Either MIDIEv.Program (MIDIEv.NoteBoundary Bool)])
+      (EventListTT.T StrictTime
+         [MIDIEv.NoteBoundary (Maybe MIDIEv.Program)])
+embedPrograms initPgm =
+   catMaybes .
+   traverse initPgm MIDIEv.embedProgramState
+
+
+type GateChunk = Gate.Chunk MIDIEv.Velocity
+type Instrument y chunk = y -> y -> PIO.T GateChunk chunk
+type Bank y chunk = MIDIEv.Program -> Instrument y chunk
+
+
+
+{-
+for distinction of notes with the same pitch
+
+We must use Integer instead of Int, in order to avoid an overflow
+that would invalidate the check for unmatched NoteOffs
+that is based on comparison of the NoteIds.
+We cannot re-use NoteIds easily,
+since the events at one time point are handled out of order.
+-}
+newtype NoteId = NoteId Integer
+   deriving (Show, Eq, Ord)
+
+succNoteId :: NoteId -> NoteId
+succNoteId (NoteId n) = NoteId (n+1)
+
+flattenNoteIdRange :: (NoteId,NoteId) -> [NoteId]
+flattenNoteIdRange (start,afterEnd) =
+   takeWhile (<afterEnd) $ iterate succNoteId start
+
+
+newtype NoteOffList =
+   NoteOffList {
+      unwrapNoteOffList :: EventListTT.T StrictTime [NoteBoundary NoteId]
+   }
+
+
+instance CutG.Read NoteOffList where
+   null (NoteOffList evs) =
+      EventListTT.isPause evs && EventListTT.duration evs == 0
+   length = fromIntegral . EventListTT.duration . unwrapNoteOffList
+
+instance CutG.NormalForm NoteOffList where
+   evaluateHead =
+      EventListMT.switchTimeL (\t _ -> rnf (NonNegW.toNumber t)) .
+      unwrapNoteOffList
+
+instance Monoid NoteOffList where
+   mempty = NoteOffList (EventListTT.pause mempty)
+   mappend (NoteOffList xs) (NoteOffList ys) =
+      NoteOffList (mappend xs ys)
+
+{- |
+The function defined here are based on the interpretation
+of event lists as piecewise constant signals.
+They do not fit to the interpretation of atomic events.
+Because e.g. it makes no sense to split an atomic event into two instances by splitAt,
+and it is also not clear, whether dropping the first chunk
+shall leave a chunk of length zero
+or remove that chunk completely.
+-}
+instance CutG.Transform NoteOffList where
+   take n (NoteOffList xs) =
+      NoteOffList $
+      EventListTT.takeTime
+         (NonNegW.fromNumberMsg "NoteOffList.take" $ fromIntegral n) xs
+   drop n (NoteOffList xs) =
+      NoteOffList $
+      EventListTT.dropTime
+         (NonNegW.fromNumberMsg "NoteOffList.drop" $ fromIntegral n) xs
+   splitAt n (NoteOffList xs) =
+      mapPair (NoteOffList, NoteOffList) $
+      EventListTT.splitAtTime
+         (NonNegW.fromNumberMsg "NoteOffList.splitAtTime" $ fromIntegral n) xs
+
+   -- cf. ChunkySize.dropMarginRem
+   dropMarginRem =
+      CutG.dropMarginRemChunky
+         (fmap fromIntegral . EventListTT.getTimes . unwrapNoteOffList)
+
+   reverse (NoteOffList xs) =
+      NoteOffList . EventListTT.reverse $ xs
+
+
+findEvent ::
+   (a -> Bool) ->
+   EventListTT.T StrictTime [a] ->
+   (EventListTT.T StrictTime [a], Maybe a)
+findEvent p =
+   EventListTT.foldr
+      (\t -> mapFst (EventListMT.consTime t))
+      (\evs rest ->
+         case ListHT.break p evs of
+            (prefix, suffix) ->
+               mapFst (EventListMT.consBody prefix) $
+               case suffix of
+                  [] -> rest
+                  ev:_ -> (EventListTT.pause mempty, Just ev))
+      (EventListBT.empty, Nothing)
+
+gateFromNoteOffs ::
+   (MIDIEv.Pitch, NoteId) ->
+   NoteOffList ->
+   GateChunk
+gateFromNoteOffs pitchNoteId (NoteOffList noteOffs) =
+   let dur = EventListTT.duration noteOffs
+       (sustain, mEnd) =
+          findEvent
+             (\bnd ->
+                case bnd of
+                   -- AllNotesOff -> True
+                   NoteBoundary endPitch _ noteId ->
+                      pitchNoteId == (endPitch, noteId))
+          noteOffs
+   in  Gate.chunk dur $
+       flip fmap mEnd $ \end ->
+       (EventListTT.duration sustain,
+        case end of
+           NoteBoundary _ endVel _ -> endVel
+           {-
+           AllNotesOff ->
+              VoiceMsg.toVelocity VoiceMsg.normalVelocity -} )
+
+
+data NoteBoundary a =
+     NoteBoundary VoiceMsg.Pitch VoiceMsg.Velocity a
+--   | AllSoundOff
+   deriving (Eq, Show)
+
+{- |
+We count NoteIds per pitch,
+such that the pair (pitch,noteId) identifies a note.
+We treat nested notes in a first-in-first-out order (FIFO).
+E.g.
+
+> On, On, On, Off, Off, Off
+
+is interpreted as
+
+> On 0, On 1, On 2, Off 0, Off 1, Off 2
+
+NoteOffs without previous NoteOns are thrown away.
+-}
+assignNoteIds ::
+   (Traversable f) =>
+   PIO.T
+      (f [MIDIEv.NoteBoundary (Maybe MIDIEv.Program)])
+      (f [NoteBoundary (NoteId, Maybe MIDIEv.Program)])
+assignNoteIds =
+   fmap concat
+   ^<<
+   traverse Map.empty (\bnd ->
+      case bnd of
+         MIDIEv.AllNotesOff -> do
+            notes <- MS.get
+            MS.put Map.empty
+            return $
+               concatMap (\(pitch, range) ->
+                  map
+                     (\noteId ->
+                        NoteBoundary pitch
+                           (VoiceMsg.toVelocity VoiceMsg.normalVelocity)
+                           (noteId, Nothing))
+                     (flattenNoteIdRange range)) $
+               Map.toList notes
+         MIDIEv.NoteBoundary pitch vel mpgm ->
+            fmap (fmap (\noteId ->
+               NoteBoundary pitch vel (noteId,mpgm))) $
+            case mpgm of
+               Nothing -> do
+                  mNoteId <- MS.gets (Map.lookup pitch)
+                  case mNoteId of
+                     Nothing -> return []
+                     Just (nextNoteOffId, nextNoteOnId) ->
+                        if nextNoteOffId >= nextNoteOnId
+                          then return []
+                          else do
+                             MS.modify (Map.insert pitch (succNoteId nextNoteOffId, nextNoteOnId))
+                             return [nextNoteOffId]
+               Just _ -> do
+                  mNoteId <- MS.gets (Map.lookup pitch)
+                  let (nextNoteOffId, nextNoteOnId) =
+                         case mNoteId of
+                            Nothing -> (NoteId 0, NoteId 0)
+                            Just ids -> ids
+
+                  MS.modify (Map.insert pitch (nextNoteOffId, succNoteId nextNoteOnId))
+                  return [nextNoteOnId])
+
+applyInstrumentCore ::
+   (Arrow arrow, Trans.C y) =>
+   ((MIDIEv.Pitch, NoteId) -> noteOffListCtrl -> gateCtrl) ->
+   (MIDIEv.Program -> y -> y -> PIO.T gateCtrl chunk) ->
+   arrow
+      (EventListTT.T StrictTime
+         [NoteBoundary (NoteId, Maybe MIDIEv.Program)])
+      (Zip.T
+         NoteOffList
+         (EventListTT.T StrictTime [PIO.T noteOffListCtrl chunk]))
+applyInstrumentCore makeGate bank = arr $
+   uncurry Zip.Cons .
+   mapFst NoteOffList .
+   EventListTT.unzip .
+   fmap (ListHT.unzipEithers . fmap (\ev ->
+      case ev of
+--         MIDIEv.AllNotesOff -> Left MIDIEv.AllNotesOff
+         NoteBoundary pitch vel (noteId, mpgm) ->
+            case mpgm of
+               Nothing -> Left $ NoteBoundary pitch vel noteId
+               Just pgm ->
+                  Right $
+                     bank pgm (MV.velocity vel)
+                        (MV.frequencyFromPitch pitch)
+                     <<^
+                     makeGate (pitch, noteId)))
+
+applyInstrument ::
+   (Arrow arrow, Trans.C y) =>
+   Bank y chunk ->
+   arrow
+      (EventListTT.T StrictTime
+         [NoteBoundary (NoteId, Maybe MIDIEv.Program)])
+      (Zip.T
+         NoteOffList
+         (EventListTT.T StrictTime [PIO.T NoteOffList chunk]))
+applyInstrument = applyInstrumentCore gateFromNoteOffs
+
+
+type ModulatedBank y ctrl chunk =
+        MIDIEv.Program -> y -> y ->
+        PIO.T (Zip.T GateChunk ctrl) chunk
+
+applyModulatedInstrument ::
+   (Arrow arrow, Trans.C y, CutG.Read ctrl) =>
+   ModulatedBank y ctrl chunk ->
+   arrow
+      (Zip.T
+         (EventListTT.T StrictTime
+            [NoteBoundary (NoteId, Maybe MIDIEv.Program)])
+         ctrl)
+      (Zip.T
+         (Zip.T NoteOffList ctrl)
+         (EventListTT.T StrictTime
+            [PIO.T (Zip.T NoteOffList ctrl) chunk]))
+applyModulatedInstrument bank =
+   (\(Zip.Cons (Zip.Cons noteOffs events) ctrl) ->
+      Zip.Cons (Zip.Cons noteOffs ctrl) events)
+   ^<<
+   Zip.arrowFirst
+      (applyInstrumentCore
+         (Zip.arrowFirst . gateFromNoteOffs) bank)
+
+
+{- |
+Turn an event list with bundles of elements
+into an event list with single events.
+ToDo: Move to event-list package?
+-}
+flatten ::
+   (NonNeg.C time) =>
+   a ->
+   EventListTT.T time [a] ->
+   EventListTT.T time a
+flatten empty =
+   EventListTT.foldr
+      EventListMT.consTime
+      (\bt xs ->
+         uncurry EventListMT.consBody $
+         case bt of
+            [] -> (empty, xs)
+            b:bs -> (b, foldr (\c rest -> EventListTT.cons NonNeg.zero c rest) xs bs))
+      EventListBT.empty
+
+
+flattenControlSchedule ::
+   (Monoid chunk, Arrow arrow) =>
+   arrow
+      (Zip.T ctrl
+         (EventListTT.T StrictTime [PIO.T ctrl chunk]))
+      (Zip.T ctrl
+         (EventListTT.T StrictTime (PIO.T ctrl chunk)))
+flattenControlSchedule = arr $
+   \(Zip.Cons ctrl evs) ->
+      -- Zip.consChecked "flattenControlSchedule" ctrl $
+      Zip.Cons ctrl $
+      flatten (arr (const mempty)) evs
+
+
+
+data CausalState a b =
+   forall state.
+   CausalState
+      (a -> state -> IO (b, state))
+      (state -> IO ())
+      state
+
+_applyChunkSimple :: CausalState a b -> a -> IO (b, CausalState a b)
+_applyChunkSimple (CausalState next delete state0) input = do
+   (output, state1) <- next input state0
+   return (output, CausalState next delete state1)
+
+applyChunk ::
+   (CutG.Read a, CutG.Read b) =>
+   CausalState a b -> a -> IO (b, Maybe (CausalState a b))
+applyChunk (CausalState next delete state0) input = do
+   (output, state1) <- next input state0
+   cs <-
+      if CutG.length output < CutG.length input
+        then do
+           delete state1
+           return Nothing
+        else return $ Just $ CausalState next delete state1
+   return (output, cs)
+
+-- could be moved to synthesizer-core
+applyModulation ::
+   (CutG.Transform ctrl, CutG.NormalForm ctrl,
+    CutG.Read chunk,
+    Monoid time, ToInteger.C time) =>
+   PIO.T
+      (Zip.T ctrl (EventListTT.T time (PIO.T ctrl chunk)))
+      (EventListTT.T time chunk)
+applyModulation = PIO.Cons
+   (\(Zip.Cons ctrl evs) acc0 -> do
+      acc1 <- mapM (flip applyChunk ctrl) acc0
+      let (accChunks, acc2) = unzip acc1
+
+      (newChunks, newAcc) <-
+         MW.runWriterT $
+         flip MS.evalStateT ctrl $
+         EventListTT.mapM
+            (\time -> do
+               ctrl_ <- MS.gets (CutG.drop (fromIntegral time))
+               MS.put ctrl_
+               return (case CutG.evaluateHead ctrl_ of () -> time))
+            (\(PIO.Cons next create delete) -> do
+               state0 <- liftIO create
+               (chunk, state1) <-
+                  liftIO . applyChunk (CausalState next delete state0)
+                  =<< MS.get
+               MT.lift $ MW.tell $ maybeToList state1
+               return chunk)
+            evs
+
+      return
+         (EventListTM.prependBodyEnd
+             (EventList.fromPairList $
+              map ((,) mempty) accChunks)
+             newChunks,
+          Maybe.catMaybes acc2 ++ newAcc))
+
+   (return [])
+   (mapM_ (\(CausalState _ close state) -> close state))
+
+arrangeStorable ::
+   (Arrow arrow, Storable a, Additive.C a) =>
+   arrow
+      (EventListTT.T StrictTime (SV.Vector a))
+      (SV.Vector a)
+arrangeStorable =
+   arr $ \evs ->
+   SVST.runSTVector (do
+      v <- SVST.new (fromIntegral $ EventListTT.duration evs) zero
+      mapM_ (uncurry $ CutSt.addChunkToBuffer v) $
+         AbsEventList.toPairList $
+         AbsEventList.mapTime fromIntegral $
+         EventList.toAbsoluteEventList 0 $
+         EventListTM.switchTimeR const evs
+      return v)
+
+
+
+sequenceCore ::
+   (Monoid chunk, CutG.Read chunk, Trans.C y) =>
+   MIDIEv.Channel ->
+   Bank y chunk ->
+   PIO.T Events (EventListTT.T StrictTime chunk)
+sequenceCore channel bank =
+   applyModulation
+   .
+   flattenControlSchedule
+   .
+   applyInstrument bank
+   .
+   assignNoteIds
+   .
+   embedPrograms (VoiceMsg.toProgram 0)
+   .
+   noteEvents channel
+
+
+sequenceModulated ::
+   (Monoid chunk, CutG.Read chunk,
+    CutG.Transform ctrl, CutG.NormalForm ctrl, Trans.C y) =>
+   MIDIEv.Channel ->
+   ModulatedBank y ctrl chunk ->
+   PIO.T (Zip.T Events ctrl) (EventListTT.T StrictTime chunk)
+sequenceModulated channel bank =
+   applyModulation
+   .
+   flattenControlSchedule
+   .
+   applyModulatedInstrument bank
+   .
+   Zip.arrowFirst
+      (assignNoteIds
+       .
+       embedPrograms (VoiceMsg.toProgram 0)
+       .
+       noteEvents channel)
+
+
+sequenceModulatedMultiProgram ::
+   (Monoid chunk, CutG.Read chunk,
+    CutG.Transform ctrl, CutG.NormalForm ctrl, Trans.C y) =>
+   MIDIEv.Channel ->
+   MIDIEv.Program ->
+   ModulatedBank y ctrl chunk ->
+   PIO.T (Zip.T Events ctrl) (EventListTT.T StrictTime chunk)
+sequenceModulatedMultiProgram channel initPgm bank =
+   applyModulation
+   .
+   flattenControlSchedule
+   .
+   applyModulatedInstrument bank
+   .
+   Zip.arrowFirst
+      (assignNoteIds
+       .
+       embedPrograms initPgm
+       .
+       noteEvents channel)
+
+
+sequenceStorable ::
+   (Storable a, Additive.C a, Trans.C y) =>
+   MIDIEv.Channel ->
+   Bank y (SV.Vector a) ->
+   PIO.T Events (SV.Vector a)
+sequenceStorable channel bank =
+   arrangeStorable
+   .
+   sequenceCore channel bank
diff --git a/src/Synthesizer/Dimensional/ALSA/MIDI.hs b/src/Synthesizer/Dimensional/ALSA/MIDI.hs
--- a/src/Synthesizer/Dimensional/ALSA/MIDI.hs
+++ b/src/Synthesizer/Dimensional/ALSA/MIDI.hs
@@ -15,6 +15,7 @@
 
 import qualified Synthesizer.Dimensional.MIDIValue as DMV
 import qualified Synthesizer.MIDIValue as MV
+import qualified Sound.MIDI.ALSA.Check as Check
 
 import qualified Synthesizer.Dimensional.Causal.Process    as Causal
 import qualified Synthesizer.Dimensional.Causal.Filter     as Filt
@@ -34,6 +35,7 @@
 import Synthesizer.Dimensional.Causal.Process ((<<<), )
 import Synthesizer.Dimensional.Process (($:), )
 
+import qualified Synthesizer.PiecewiseConstant.Signal as PC
 import qualified Synthesizer.ChunkySize as ChunkySize
 
 import qualified Synthesizer.Generic.Cut          as CutG
@@ -69,7 +71,7 @@
 import qualified Algebra.Module         as Module
 import qualified Algebra.RealField      as RealField
 import qualified Algebra.Field          as Field
-import qualified Algebra.Additive       as Additive
+-- import qualified Algebra.Additive       as Additive
 
 import Control.Category (Category, (.), )
 import Control.Applicative (Applicative, pure, (<*>), liftA2, )
@@ -169,7 +171,7 @@
        in  return . SigA.fromBody amp .
            AlsaPC.initWith
               (DMV.pitchBend amp range center) (DN.divToScalar center amp)) $
-   AlsaEL.getSlice (AlsaEL.maybePitchBend chan)
+   AlsaEL.getSlice (Check.pitchBend chan)
 --   AlsaEL.getPitchBendEvents chan
 
 
@@ -186,7 +188,7 @@
        AlsaPC.initWith
           (DMV.controllerLinear maxVal (zero,maxVal))
           (DN.divToScalar initVal maxVal)) $
-   AlsaEL.getSlice (AlsaEL.maybeChannelPressure chan)
+   AlsaEL.getSlice (Check.channelPressure chan)
 --   AlsaEL.getPitchBendEvents chan
 
 
@@ -240,8 +242,8 @@
 chunkySizeFromLazyTime :: AlsaEL.LazyTime -> ChunkySize.T
 chunkySizeFromLazyTime =
    Chunky.fromChunks .
-   map (SigG.LazySize . fromIntegral . NonNegW.toNumber) .
-   concatMap AlsaEL.chopLongTime .
+   map (SigG.LazySize . NonNegW.toNumber) .
+   concatMap PC.chopLongTime .
    Chunky98.toChunks .
    Chunky98.normalize
 
diff --git a/src/Synthesizer/Dimensional/ALSA/Play.hs b/src/Synthesizer/Dimensional/ALSA/Play.hs
--- a/src/Synthesizer/Dimensional/ALSA/Play.hs
+++ b/src/Synthesizer/Dimensional/ALSA/Play.hs
@@ -31,6 +31,8 @@
 import NumericPrelude.Base
 
 
+type Device = String
+
 type RenderedStorableSignal u t v y yv =
    SigA.T (Rate.Dimensional u t) (Amp.Dimensional v y) (SigSt.T yv)
 
@@ -38,72 +40,84 @@
    SigA.T (Rate.Phantom s) (Amp.Dimensional v y) (SigSt.T yv)
 
 
+makeSink ::
+   (ALSA.SampleFmt y, RealRing.C t) =>
+   Device {- ^ ALSA output device -} ->
+   DN.Time t {- ^ period (buffer) size expressed in seconds -} ->
+   DN.Frequency t {- ^ sample rate -} ->
+   ALSA.SoundSink y ALSA.Pcm
+makeSink device periodTime rate =
+   Play.makeSink device
+      (DN.toNumberWithDimension Dim.time periodTime)
+      (RealRing.round (DN.toNumberWithDimension Dim.frequency rate))
+
+
 {-# INLINE timeVoltageStorable #-}
 timeVoltageStorable ::
    (Module.C y yv, ALSA.SampleFmt yv, RealRing.C t) =>
+   Device ->
    DN.Time t->
    RenderedStorableSignal Dim.Time t Dim.Voltage y yv ->
    IO ()
-timeVoltageStorable period sig =
-   let rate = DN.toNumberWithDimension Dim.frequency (SigA.actualSampleRate sig)
-       per  = DN.toNumberWithDimension Dim.time period
-   in  Play.auto per (RealRing.round rate)
-          (SigA.vectorSamples (DN.toNumberWithDimension Dim.voltage) sig)
+timeVoltageStorable device period sig =
+   Play.auto (makeSink device period (SigA.actualSampleRate sig))
+      (SigA.vectorSamples (DN.toNumberWithDimension Dim.voltage) sig)
 
 {-# INLINE timeVoltageMonoStorableToInt16 #-}
 timeVoltageMonoStorableToInt16 ::
    (Storable y, RealRing.C y, RealRing.C t) =>
+   Device ->
    DN.Time t->
    RenderedStorableSignal Dim.Time t Dim.Voltage y y ->
    IO ()
-timeVoltageMonoStorableToInt16 period sig =
-   let rate = DN.toNumberWithDimension Dim.frequency (SigA.actualSampleRate sig)
-       per  = DN.toNumberWithDimension Dim.time period
-   in  Play.monoToInt16 per (RealRing.round rate)
-          (SigA.scalarSamples (DN.toNumberWithDimension Dim.voltage) sig)
+timeVoltageMonoStorableToInt16 device period sig =
+   Play.monoToInt16 (makeSink device period (SigA.actualSampleRate sig))
+      (SigA.scalarSamples (DN.toNumberWithDimension Dim.voltage) sig)
 
 {-# INLINE timeVoltageStereoStorableToInt16 #-}
 timeVoltageStereoStorableToInt16 ::
    (Storable y, Module.C y y, RealRing.C y, RealRing.C t) =>
+   Device ->
    DN.Time t->
    RenderedStorableSignal Dim.Time t Dim.Voltage y (Stereo.T y) ->
    IO ()
-timeVoltageStereoStorableToInt16 period sig =
-   let rate = DN.toNumberWithDimension Dim.frequency (SigA.actualSampleRate sig)
-       per  = DN.toNumberWithDimension Dim.time period
-   in  Play.stereoToInt16 per (RealRing.round rate)
-          (SigA.vectorSamples (DN.toNumberWithDimension Dim.voltage) sig)
+timeVoltageStereoStorableToInt16 device period sig =
+   Play.stereoToInt16 (makeSink device period (SigA.actualSampleRate sig))
+      (SigA.vectorSamples (DN.toNumberWithDimension Dim.voltage) sig)
 
 
 {-# INLINE renderTimeVoltageStorable #-}
 renderTimeVoltageStorable ::
    (Module.C y yv, ALSA.SampleFmt yv, RealRing.C t) =>
+   Device ->
    DN.Time t->
    DN.T Dim.Frequency t ->
    (forall s. Proc.T s Dim.Time t
       (StorableSignal s Dim.Voltage y yv)) ->
    IO ()
-renderTimeVoltageStorable period rate sig =
-   timeVoltageStorable period (SigA.render rate sig)
+renderTimeVoltageStorable device period rate sig =
+   timeVoltageStorable device period (SigA.render rate sig)
 
 {-# INLINE renderTimeVoltageMonoStorableToInt16 #-}
 renderTimeVoltageMonoStorableToInt16 ::
    (Storable y, RealRing.C y, RealRing.C t) =>
+   Device ->
    DN.Time t->
    DN.T Dim.Frequency t ->
    (forall s. Proc.T s Dim.Time t
       (StorableSignal s Dim.Voltage y y)) ->
    IO ()
-renderTimeVoltageMonoStorableToInt16 period rate sig =
-   timeVoltageMonoStorableToInt16 period (SigA.render rate sig)
+renderTimeVoltageMonoStorableToInt16 device period rate sig =
+   timeVoltageMonoStorableToInt16 device period (SigA.render rate sig)
 
 {-# INLINE renderTimeVoltageStereoStorableToInt16 #-}
 renderTimeVoltageStereoStorableToInt16 ::
    (Storable y, Module.C y y, RealRing.C y, RealRing.C t) =>
+   Device ->
    DN.Time t->
    DN.T Dim.Frequency t ->
    (forall s. Proc.T s Dim.Time t
       (StorableSignal s Dim.Voltage y (Stereo.T y))) ->
    IO ()
-renderTimeVoltageStereoStorableToInt16 period rate sig =
-   timeVoltageStereoStorableToInt16 period (SigA.render rate sig)
+renderTimeVoltageStereoStorableToInt16 device period rate sig =
+   timeVoltageStereoStorableToInt16 device period (SigA.render rate sig)
diff --git a/src/Synthesizer/Dimensional/ALSA/Server/Common.hs b/src/Synthesizer/Dimensional/ALSA/Server/Common.hs
--- a/src/Synthesizer/Dimensional/ALSA/Server/Common.hs
+++ b/src/Synthesizer/Dimensional/ALSA/Server/Common.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE RankNTypes #-}
 module Synthesizer.Dimensional.ALSA.Server.Common where
 
 import qualified Synthesizer.Dimensional.ALSA.Play as Play
@@ -61,20 +61,32 @@
    let (SVL.ChunkSize size) = PlaySt.defaultChunkSize
    in  DN.scale (fromIntegral size) $ DN.unrecip sampleRate
 
+device :: Play.Device
+device = PlaySt.defaultDevice
 
+clientName :: MIDIEv.ClientName
+clientName = MIDIEv.ClientName "Haskell-Synthesizer"
+
+
 type Real = Double
 
 
 {-# INLINE withMIDIEvents #-}
 withMIDIEvents ::
    Field.C t =>
-   (DN.Time t -> DN.Frequency t -> a -> IO b) ->
-   (EventList.T MIDIEv.StrictTime [Event.T] -> a) -> IO b
+   (DN.Time t -> DN.Frequency t ->
+    (forall s. Proc.T s Dim.Time t
+        (Play.StorableSignal s Dim.Voltage y yv)) ->
+    IO b) ->
+   (EventList.T MIDIEv.StrictTime [Event.T] ->
+    forall s. Proc.T s Dim.Time t
+       (Play.StorableSignal s Dim.Voltage y yv)) ->
+   IO b
 withMIDIEvents action proc =
-   MIDIEv.withMIDIEvents
+   MIDIEv.withMIDIEvents clientName
       (DN.toNumberWithDimension Dim.time periodTime :: Double)
       (DN.toNumberWithDimension Dim.frequency sampleRate :: Double) $
-   action periodTime sampleRate . proc
+   \ sig -> action periodTime sampleRate (proc sig)
 
 {-# INLINE play #-}
 play ::
@@ -85,5 +97,5 @@
       (Play.StorableSignal s Dim.Voltage y yv)) ->
    IO ()
 play period rate sig =
-   Play.renderTimeVoltageStorable period rate
+   Play.renderTimeVoltageStorable device period rate
    (FiltR.delay latency $: sig)
diff --git a/src/Synthesizer/Dimensional/ALSA/Server/Instrument.hs b/src/Synthesizer/Dimensional/ALSA/Server/Instrument.hs
--- a/src/Synthesizer/Dimensional/ALSA/Server/Instrument.hs
+++ b/src/Synthesizer/Dimensional/ALSA/Server/Instrument.hs
@@ -25,7 +25,6 @@
 import qualified Synthesizer.Dimensional.ChunkySize.Signal as SigC
 import qualified Synthesizer.Dimensional.Signal.Private as SigA
 import qualified Synthesizer.Dimensional.Process as Proc
-import qualified Synthesizer.Dimensional.Wave as WaveD
 
 import Synthesizer.Dimensional.Causal.Process ((<<<), )
 import Synthesizer.Dimensional.Wave ((&*~), )
@@ -37,9 +36,6 @@
 import qualified Synthesizer.Frame.Stereo        as Stereo
 
 import qualified Synthesizer.Storable.Signal      as SigSt
-
-import qualified Algebra.Field          as Field
-import qualified Algebra.Ring           as Ring
 
 import qualified Algebra.DimensionTerm as Dim
 import qualified Number.DimensionTerm  as DN
diff --git a/src/Synthesizer/Dimensional/ALSA/Server/Run.hs b/src/Synthesizer/Dimensional/ALSA/Server/Run.hs
--- a/src/Synthesizer/Dimensional/ALSA/Server/Run.hs
+++ b/src/Synthesizer/Dimensional/ALSA/Server/Run.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE Rank2Types #-}
 module Synthesizer.Dimensional.ALSA.Server.Run where
 
 import Synthesizer.Dimensional.ALSA.Server.Common
@@ -12,6 +11,7 @@
 import qualified Synthesizer.Dimensional.Causal.Process    as Causal
 import qualified Synthesizer.Dimensional.Causal.Oscillator as Osci
 import qualified Synthesizer.Dimensional.Causal.Filter     as Filt
+import qualified Synthesizer.Dimensional.Causal.FilterParameter   as FiltP
 import qualified Synthesizer.Dimensional.Causal.ControlledProcess as CProc
 
 import qualified Synthesizer.Dimensional.Rate.Oscillator as OsciR
@@ -19,7 +19,6 @@
 import qualified Synthesizer.Dimensional.Amplitude.Displacement as DispA
 import qualified Synthesizer.Dimensional.Amplitude.Filter as FiltA
 import qualified Synthesizer.Dimensional.Signal.Private as SigA
-import qualified Synthesizer.Dimensional.Process as Proc
 import qualified Synthesizer.Dimensional.Wave as WaveD
 
 import Synthesizer.Dimensional.Causal.Process ((<<<), )
@@ -31,8 +30,6 @@
 
 import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
 
-import qualified Algebra.Ring           as Ring
-
 import qualified Number.DimensionTerm  as DN
 
 import NumericPrelude.Numeric
@@ -168,7 +165,7 @@
    \evs ->
         liftA3
            (\osci filt (music,speed,depth) ->
-              (Filt.lowpassFromUniversal <<<
+              (FiltP.lowpassFromUniversal <<<
                filt (CtrlA.constant 10)
                  (DispA.mapExponential 4 (DN.frequency 1000) $
                   FiltA.envelope (SigA.restore depth) $
@@ -176,7 +173,7 @@
               `Causal.apply`
               FiltA.amplify 0.2 music)
            (OsciR.freqMod (WaveD.flat Wave.sine) zero)
-           (CProc.runSynchronous2 Filt.universal)
+           (CProc.runSynchronous2 FiltP.universal)
 --           FiltR.universal
            (MIDI.runFilter evs
               (liftA3 (,,)
diff --git a/src/Synthesizer/Dimensional/ALSA/Server/Test.hs b/src/Synthesizer/Dimensional/ALSA/Server/Test.hs
--- a/src/Synthesizer/Dimensional/ALSA/Server/Test.hs
+++ b/src/Synthesizer/Dimensional/ALSA/Server/Test.hs
@@ -19,8 +19,6 @@
 
 import qualified Data.EventList.Relative.TimeBody  as EventList
 
-import qualified Algebra.Ring           as Ring
-
 import qualified Algebra.DimensionTerm as Dim
 import qualified Number.DimensionTerm  as DN
 
diff --git a/src/Synthesizer/Dimensional/MIDIValue.hs b/src/Synthesizer/Dimensional/MIDIValue.hs
--- a/src/Synthesizer/Dimensional/MIDIValue.hs
+++ b/src/Synthesizer/Dimensional/MIDIValue.hs
@@ -3,16 +3,21 @@
 Functions for converting MIDI controller and key values
 to something meaningful for signal processing.
 -}
-module Synthesizer.Dimensional.MIDIValue where
+module Synthesizer.Dimensional.MIDIValue (
+   controllerLinear,
+   controllerExponential,
+   pitchBend,
+   MV.frequencyFromPitch,
+   ) where
 
-import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
+import qualified Synthesizer.Dimensional.MIDIValuePlain as MV
 
 import qualified Algebra.DimensionTerm as Dim
 import qualified Number.DimensionTerm as DN
 
 import qualified Algebra.Transcendental as Trans
 import qualified Algebra.Field          as Field
-import qualified Algebra.Additive       as Additive
+-- import qualified Algebra.Additive       as Additive
 
 import NumericPrelude.Numeric
 -- import NumericPrelude.Base
@@ -22,35 +27,19 @@
 controllerLinear ::
    (Field.C y, Dim.C v) =>
    DN.T v y -> (DN.T v y, DN.T v y) -> Int -> y
-controllerLinear amp (lower,upper) n =
-   let k = fromIntegral n / 127
-   in  DN.divToScalar (DN.scale (1-k) lower + DN.scale k upper) amp
+controllerLinear amp bnd n =
+   DN.divToScalar (MV.controllerLinear bnd n) amp
 
 {-# INLINE controllerExponential #-}
 controllerExponential ::
    (Trans.C y, Dim.C v) =>
    DN.T v y -> (DN.T v y, DN.T v y) -> Int -> y
-controllerExponential amp (lower,upper) n =
-   let k = fromIntegral n / 127
-   in  DN.divToScalar lower amp ** (1-k) *
-       DN.divToScalar upper amp ** k
+controllerExponential amp bnd n =
+   DN.divToScalar (MV.controllerExponential bnd n) amp
 
 {-# INLINE pitchBend #-}
 pitchBend ::
    (Trans.C y, Dim.C v) =>
    DN.T v y -> y -> DN.T v y -> Int -> y
 pitchBend amp range center n =
-   DN.divToScalar center amp * range ** (fromIntegral n / 8192)
-
-{- |
-Convert pitch to frequency according to the default tuning
-in MIDI 1.0 Detailed Specification.
--}
-{-# INLINE frequencyFromPitch #-}
-frequencyFromPitch ::
-   (Trans.C y) =>
-   VoiceMsg.Pitch -> DN.Frequency y
-frequencyFromPitch pitch =
-   DN.scale
-      (2 ^? (fromIntegral (VoiceMsg.fromPitch pitch + 3 - 6*12) / 12))
-      (DN.frequency 440)
+   DN.divToScalar (MV.pitchBend range center n) amp
diff --git a/src/Synthesizer/Dimensional/MIDIValuePlain.hs b/src/Synthesizer/Dimensional/MIDIValuePlain.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/Dimensional/MIDIValuePlain.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{- |
+Functions for converting MIDI controller and key values
+to something meaningful for signal processing.
+-}
+module Synthesizer.Dimensional.MIDIValuePlain (
+   controllerLinear,
+   controllerExponential,
+   pitchBend,
+   frequencyFromPitch,
+   ) where
+
+import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
+
+import qualified Algebra.DimensionTerm as Dim
+import qualified Number.DimensionTerm as DN
+
+import qualified Algebra.Transcendental as Trans
+import qualified Algebra.Field          as Field
+-- import qualified Algebra.Additive       as Additive
+
+import NumericPrelude.Numeric
+import NumericPrelude.Base
+
+
+{-# INLINE controllerLinear #-}
+controllerLinear ::
+   (Field.C y, Dim.C v) =>
+   (DN.T v y, DN.T v y) -> Int -> DN.T v y
+controllerLinear (lower,upper) n =
+   let k = fromIntegral n / 127
+   in  DN.scale (1-k) lower + DN.scale k upper
+
+{-# INLINE controllerExponential #-}
+controllerExponential ::
+   (Trans.C y, Dim.C v) =>
+   (DN.T v y, DN.T v y) -> Int -> DN.T v y
+controllerExponential (lower,upper) n =
+   let k = fromIntegral n / 127
+   in  case error "MIDIValue.controllerExponential dimension" of
+          d ->
+             DN.fromNumberWithDimension d $
+             DN.toNumberWithDimension d lower ** (1-k) *
+             DN.toNumberWithDimension d upper ** k
+
+{-# INLINE pitchBend #-}
+pitchBend ::
+   (Trans.C y, Dim.C v) =>
+   y -> DN.T v y -> Int -> DN.T v y
+pitchBend range center n =
+   DN.scale (range ** (fromIntegral n / 8192)) center
+
+{- |
+Convert pitch to frequency according to the default tuning
+in MIDI 1.0 Detailed Specification.
+-}
+{-# INLINE frequencyFromPitch #-}
+frequencyFromPitch ::
+   (Trans.C y) =>
+   VoiceMsg.Pitch -> DN.Frequency y
+frequencyFromPitch pitch =
+   DN.scale
+      (2 ^? (fromIntegral (VoiceMsg.fromPitch pitch + 3 - 6*12) / 12))
+      (DN.frequency 440)
diff --git a/src/Synthesizer/EventList/ALSA/MIDI.hs b/src/Synthesizer/EventList/ALSA/MIDI.hs
--- a/src/Synthesizer/EventList/ALSA/MIDI.hs
+++ b/src/Synthesizer/EventList/ALSA/MIDI.hs
@@ -4,6 +4,7 @@
 import qualified Sound.ALSA.Sequencer.Address as Addr
 import qualified Sound.ALSA.Sequencer.Client as Client
 import qualified Sound.ALSA.Sequencer.Port as Port
+import qualified Sound.ALSA.Sequencer.Port.Info as PortInfo
 import qualified Sound.ALSA.Sequencer.Event as Event
 import qualified Sound.ALSA.Sequencer.Queue as Queue
 import qualified Sound.ALSA.Sequencer.RealTime as RealTime
@@ -11,10 +12,10 @@
 import qualified Sound.ALSA.Exception as AlsaExc
 
 import qualified Data.EventList.Relative.TimeBody  as EventList
--- import qualified Data.EventList.Relative.TimeTime  as EventListTT
+import qualified Data.EventList.Relative.TimeTime  as EventListTT
 import qualified Data.EventList.Relative.MixedBody as EventListMB
 -- import qualified Data.EventList.Relative.BodyMixed as EventListBM
--- import qualified Data.EventList.Relative.TimeMixed as EventListTM
+import qualified Data.EventList.Relative.TimeMixed as EventListTM
 -- import qualified Data.EventList.Relative.MixedTime as EventListMT
 -- import qualified Data.EventList.Relative.BodyTime  as EventListBT
 import qualified Data.EventList.Relative.BodyBody  as EventListBB
@@ -22,9 +23,9 @@
 
 import qualified Sound.MIDI.Message.Channel as ChannelMsg
 import qualified Sound.MIDI.Message.Channel.Mode as Mode
+import qualified Sound.MIDI.ALSA.Check as Check
 import qualified Sound.MIDI.ALSA as MALSA
 
-import qualified Data.Accessor.Basic as Acc
 import Data.Accessor.Basic ((^.), )
 
 import System.IO.Unsafe (unsafeInterleaveIO, )
@@ -40,7 +41,6 @@
 import qualified Numeric.NonNegative.Chunky as NonNegChunky
 -- import Data.Monoid (Monoid, mconcat, mappend, )
 
-import qualified Algebra.ToRational as ToRational
 import qualified Algebra.RealField  as RealField
 import qualified Algebra.Field      as Field
 -- import qualified Algebra.Additive as Additive
@@ -49,16 +49,15 @@
 
 import qualified Data.List.HT as ListHT
 import Data.Tuple.HT (mapPair, mapFst, mapSnd, )
+import Data.Ord.HT (limit, )
 import Data.Maybe.HT (toMaybe, )
 import Data.Maybe (catMaybes, isNothing, )
 import Control.Monad.HT ((<=<), )
-import Control.Monad (liftM, liftM2, guard, )
-
-import qualified Data.List as List
+import Control.Monad (liftM, liftM2, guard, mzero, )
 
 import NumericPrelude.Numeric
 import NumericPrelude.Base
-import qualified Prelude as P
+-- import qualified Prelude as P
 
 -- import Debug.Trace (trace, )
 
@@ -114,29 +113,40 @@
              (const $ return [])
    in  loop
 
+{- |
+RealTime.toFractional for NumericPrelude.
+-}
+realTimeToField :: (Field.C a) => RealTime.T -> a
+realTimeToField (RealTime.Cons s n) =
+   fromIntegral s + fromIntegral n / (10^9)
+
+addStamp ::
+   (RealField.C time) =>
+   Event.T -> StampedEvent time
+addStamp ev =
+   (case Event.timestamp ev of
+      Event.RealTime t -> realTimeToField t
+      _ -> error "unsupported time stamp type",
+    ev)
+
 {- | only use it for blocking sequencers -}
-getEventsUntilEcho_ ::
-   (Field.C time, SndSeq.AllowInput mode) =>
-   SndSeq.T mode -> IO [StampedEvent time]
-getEventsUntilEcho_ h =
-   let loop = do
-          ev <- Event.input h
-          let t =
-                 case Event.timestamp ev of
-                    Event.RealTime rt ->
---                       realToFrac $
-                       fromRational' $ toRational $
-                       RealTime.toDouble rt
-                    _ -> error "unsupported time stamp type"
-          case Event.body ev of
-             Event.CustomEv Event.Echo _ -> return []
-             _ -> liftM ((t,ev):) loop
-   in  loop
+getStampedEventsUntilTime ::
+   (RealField.C time,
+    SndSeq.AllowInput mode, SndSeq.AllowOutput mode) =>
+   SndSeq.T mode ->
+   Queue.T -> Port.T -> time ->
+   IO [StampedEvent time]
+getStampedEventsUntilTime h q p t =
+   fmap (map addStamp) $ getEventsUntilTime h q p t
 
+
+{- |
+The client id may differ from the receiving sequencer.
+I do not know, whether there are circumstances, where this is useful.
+-}
 getEventsUntilEcho ::
    (SndSeq.AllowInput mode) =>
-   Client.T ->
-   SndSeq.T mode -> IO [Event.T]
+   Client.T -> SndSeq.T mode -> IO [Event.T]
 getEventsUntilEcho c h =
    let loop = do
           ev <- Event.input h
@@ -150,7 +160,24 @@
             else liftM (ev:) loop
    in  loop
 
+{- |
+Get events until a certain point in time.
+It sends itself an Echo event in order to measure time.
+-}
+getEventsUntilTime ::
+   (RealField.C time,
+    SndSeq.AllowInput mode, SndSeq.AllowOutput mode) =>
+   SndSeq.T mode ->
+   Queue.T -> Port.T -> time ->
+   IO [Event.T]
+getEventsUntilTime h q p t = do
+   c <- Client.getId h
+   _ <- Event.output h $
+           makeEcho c q p t (Event.Custom 0 0 0)
+   _ <- Event.drainOutput h
+   getEventsUntilEcho c h
 
+
 getWaitingEvents ::
    (SndSeq.AllowInput mode) =>
    SndSeq.T mode -> IO [Event.T]
@@ -164,18 +191,8 @@
 
 
 type StrictTime = NonNegW.Integer
-
-{- |
-Returns a list of non-zero times.
--}
-{-# INLINE chopLongTime #-}
-chopLongTime :: StrictTime -> [StrictTime]
-chopLongTime n =
-   let d = NonNegW.fromNumber $ fromIntegral (maxBound :: Int)
-       (q,r) = P.divMod n d
-   in  List.genericReplicate q d ++
-       if r /= NonNeg.zero then [r] else []
-
+newtype ClientName = ClientName String
+   deriving (Show)
 
 {-
 ghc -i:src -e 'withMIDIEvents 44100 print' src/Synthesizer/Storable/ALSA/MIDI.hs
@@ -187,7 +204,7 @@
 then play and event fetching get out of sync over the time.
 -}
 withMIDIEvents :: (RealField.C time) =>
-   time -> time ->
+   ClientName -> time -> time ->
    (EventList.T StrictTime [Event.T] -> IO a) -> IO a
 withMIDIEvents =
    withMIDIEventsBlockEcho
@@ -197,10 +214,10 @@
 as a quick hack, we neglect the ALSA time stamp and use getTime or so
 -}
 withMIDIEventsNonblockWaitGrouped :: (RealField.C time) =>
-   time -> time ->
+   ClientName -> time -> time ->
    (EventList.T StrictTime [Event.T] -> IO a) -> IO a
-withMIDIEventsNonblockWaitGrouped beat rate proc =
-   withInPort SndSeq.Nonblock $ \ h _p ->
+withMIDIEventsNonblockWaitGrouped name beat rate proc =
+   withInPort name SndSeq.Nonblock $ \ h _p ->
    do start <- getTimeSeconds
       l <- lazySequence $
               flip map (iterate (beat+) start) $ \t ->
@@ -223,10 +240,10 @@
 but ones xruns occur, this implies more and more xruns.
 -}
 withMIDIEventsNonblockWaitDefer :: (RealField.C time) =>
-   time -> time ->
+   ClientName -> time -> time ->
    (EventList.T StrictTime (Maybe Event.T) -> IO a) -> IO a
-withMIDIEventsNonblockWaitDefer beat rate proc =
-   withInPort SndSeq.Nonblock $ \ h _p ->
+withMIDIEventsNonblockWaitDefer name beat rate proc =
+   withInPort name SndSeq.Nonblock $ \ h _p ->
    do start <- getTimeSeconds
       l <- lazySequence $
               flip map (iterate (beat+) start) $ \t ->
@@ -249,10 +266,10 @@
 (Or debug output slows down processing.)
 -}
 withMIDIEventsNonblockWaitSkip :: (RealField.C time) =>
-   time -> time ->
+   ClientName -> time -> time ->
    (EventList.T StrictTime (Maybe Event.T) -> IO a) -> IO a
-withMIDIEventsNonblockWaitSkip beat rate proc =
-   withInPort SndSeq.Nonblock $ \ h _p ->
+withMIDIEventsNonblockWaitSkip name beat rate proc =
+   withInPort name SndSeq.Nonblock $ \ h _p ->
    do start <- getTimeSeconds
       l <- lazySequence $
            flip map (iterate (beat+) start) $ \t ->
@@ -271,10 +288,10 @@
          AbsEventList.fromPairList $ concat l
 
 withMIDIEventsNonblockWaitMin :: (RealField.C time) =>
-   time -> time ->
+   ClientName -> time -> time ->
    (EventList.T StrictTime (Maybe Event.T) -> IO a) -> IO a
-withMIDIEventsNonblockWaitMin beat rate proc =
-   withInPort SndSeq.Nonblock $ \ h _p ->
+withMIDIEventsNonblockWaitMin name beat rate proc =
+   withInPort name SndSeq.Nonblock $ \ h _p ->
    do start <- getTimeSeconds
       l <- lazySequence $
               flip map (iterate (beat+) start) $ \t ->
@@ -295,10 +312,10 @@
          AbsEventList.fromPairList $ concat l
 
 withMIDIEventsNonblockConstantPause :: (RealField.C time) =>
-   time -> time ->
+   ClientName -> time -> time ->
    (EventList.T StrictTime (Maybe Event.T) -> IO a) -> IO a
-withMIDIEventsNonblockConstantPause beat rate proc =
-   withInPort SndSeq.Nonblock $ \ h _p ->
+withMIDIEventsNonblockConstantPause name beat rate proc =
+   withInPort name SndSeq.Nonblock $ \ h _p ->
    do l <- ioToLazyList $ threadDelay (round $ flip asTypeOf rate $ beat*1e6) >>
               liftM2 (:)
                  (liftM (\t->(t,Nothing)) getTimeSeconds)
@@ -308,10 +325,10 @@
          AbsEventList.fromPairList $ concat l
 
 withMIDIEventsNonblockSimple :: (RealField.C time) =>
-   time -> time ->
+   ClientName -> time -> time ->
    (EventList.T StrictTime Event.T -> IO a) -> IO a
-withMIDIEventsNonblockSimple beat rate proc =
-   withInPort SndSeq.Nonblock $ \ h _p ->
+withMIDIEventsNonblockSimple name beat rate proc =
+   withInPort name SndSeq.Nonblock $ \ h _p ->
    do l <- ioToLazyList $
               threadDelay (round $ flip asTypeOf rate $ beat*1e6) >>
               getWaitingStampedEvents h
@@ -319,38 +336,126 @@
          discretizeTime rate $
          AbsEventList.fromPairList $ concat l
 
+
+setTimestamping ::
+   SndSeq.T mode -> Port.T -> Queue.T -> IO ()
+setTimestamping h p q = do
+   info <- PortInfo.get h p
+   PortInfo.setTimestamping info True
+   PortInfo.setTimestampReal info True
+   PortInfo.setTimestampQueue info q
+   PortInfo.set h p info
+
 withMIDIEventsBlockEcho :: (RealField.C time) =>
-   time -> time ->
+   ClientName -> time -> time ->
    (EventList.T StrictTime [Event.T] -> IO a) -> IO a
-withMIDIEventsBlockEcho beat rate proc =
-   withInPort SndSeq.Block $ \ h p ->
+withMIDIEventsBlockEcho name beat rate proc =
+   withInPort name SndSeq.Block $ \ h p ->
    Queue.with h $ \ q ->
-   do {-
-      info <- PortInfo.get h p
-      PortInfo.setTimestamping info True
-      PortInfo.setTimestampReal info True
-      PortInfo.setTimestampQueue info q
-      PortInfo.set h p info
-      -}
-
+   do setTimestamping h p q
       Queue.control h q Event.QueueStart 0 Nothing
-      Event.drainOutput h
+      _ <- Event.drainOutput h
 
-      c <- Client.getId h
-      l <-
-         lazySequence $
-         flip map (iterate (beat+) 0) $ \t -> do
-            Event.output h $
-               makeEcho c q p (t+beat) (Event.Custom 0 0 0)
-            Event.drainOutput h
+      proc .
+         discretizeTime rate .
+         AbsEventList.fromPairList .
+         concat =<<
+         (lazySequence $
+          flip map (iterate (beat+) 0) $ \t ->
+             let end = t+beat
+             in  -- (\act -> do evs <- act; print evs; return evs) $
+                 -- add a laziness break
+                 fmap ((t,[]) :) $
+                 fmap (map (mapPair (limit (t,end), (:[])))) $
+                 getStampedEventsUntilTime h q p end)
+
+{- |
+This is like withMIDIEventsBlockEcho
+but collects all events at the beginning of the beats.
+This way, further processing steps may collapse
+all controller events within one beat to one event.
+-}
+withMIDIEventsBlockEchoQuantised :: (RealField.C time) =>
+   ClientName -> time -> time ->
+   (EventList.T StrictTime [Event.T] -> IO a) -> IO a
+withMIDIEventsBlockEchoQuantised name beat rate proc =
+   withInPort name SndSeq.Block $ \ h p ->
+   Queue.with h $ \ q ->
+   do Queue.control h q Event.QueueStart 0 Nothing
+      _ <- Event.drainOutput h
+
+      proc .
+         discretizeTime rate .
+         AbsEventList.fromPairList =<<
+         (lazySequence $
+          flip map (iterate (beat+) 0) $ \t ->
             liftM
                (\evs -> (t, evs))
-               (getEventsUntilEcho c h)
+               (getEventsUntilTime h q p (t+beat)))
 
+{- |
+Make sure, that @beat@ is an integer multiple of @recip rate@.
+Since we round time within each chunk,
+we would otherwise accumulate rounding errors over time.
+-}
+withMIDIEventsChunked ::
+   (RealField.C time) =>
+   ClientName -> time -> time ->
+   ([IO (EventListTT.T StrictTime [Event.T])] -> IO a) ->
+   IO a
+withMIDIEventsChunked name beat rate proc =
+   withInPort name SndSeq.Block $ \ h p ->
+   Queue.with h $ \ q ->
+   do setTimestamping h p q
+      Queue.control h q Event.QueueStart 0 Nothing
+      _ <- Event.drainOutput h
+
       proc $
-         discretizeTime rate $
-         AbsEventList.fromPairList l
+         map
+            (\t ->
+               let end = t+beat
+               in  liftM
+                      (\evs ->
+                         EventListTM.switchBodyR
+                            (error "withMIDIEventsChunked: empty list, but there must be at least the end event")
+                            const $
+                         discretizeTime rate $
+                         AbsEventList.fromPairList $
+                         (t,[]) :
+                         {-
+                         FIXME: This is a quick hack in order to assert
+                         that all events are within one chunk
+                         and do not lie on the boundary.
+                         -}
+                         map (mapPair (limit (t , end - recip rate), (:[]))) evs ++
+                         (end, []) :
+                         [])
+                      (getStampedEventsUntilTime h q p end))
+            (iterate (beat+) 0)
 
+withMIDIEventsChunkedQuantised ::
+   (RealField.C time) =>
+   ClientName -> time -> time ->
+   ([IO (EventList.T StrictTime [Event.T])] -> IO a) ->
+   IO a
+withMIDIEventsChunkedQuantised name beat rate proc =
+   withInPort name SndSeq.Block $ \ h p ->
+   Queue.with h $ \ q ->
+   do Queue.control h q Event.QueueStart 0 Nothing
+      _ <- Event.drainOutput h
+
+      proc $
+         map
+            (\t ->
+               liftM
+                  (\evs ->
+                     EventList.cons NonNeg.zero evs $
+                     EventList.singleton
+                        (NonNegW.fromNumberMsg "chunked time conversion" $
+                         round (beat*rate)) [])
+                  (getEventsUntilTime h q p (t+beat)))
+            (iterate (beat+) 0)
+
 makeEcho ::
    RealField.C time =>
    Client.T -> Queue.T -> Port.T ->
@@ -375,21 +480,23 @@
       }
 
 withMIDIEventsBlock :: (RealField.C time) =>
-   time ->
+   ClientName -> time ->
    (EventList.T StrictTime Event.T -> IO a) -> IO a
-withMIDIEventsBlock rate proc =
-   withInPort SndSeq.Block $ \ h _p ->
+withMIDIEventsBlock name rate proc =
+   withInPort name SndSeq.Block $ \ h _p ->
    do l <- ioToLazyList $ getStampedEvent h
       proc $
          discretizeTime rate $
          AbsEventList.fromPairList l
 
 withInPort ::
-   SndSeq.BlockMode -> (SndSeq.T SndSeq.DuplexMode -> Port.T -> IO t) -> IO t
-withInPort blockMode act =
+   ClientName ->
+   SndSeq.BlockMode ->
+   (SndSeq.T SndSeq.DuplexMode -> Port.T -> IO t) -> IO t
+withInPort (ClientName name) blockMode act =
    SndSeq.with SndSeq.defaultName blockMode $ \h ->
-   Client.setName h "Haskell-Synthesizer" >>
-   Port.withSimple h "listener"
+   Client.setName h name >>
+   Port.withSimple h "input"
       (Port.caps [Port.capWrite, Port.capSubsWrite])
       Port.typeMidiGeneric
       (act h)
@@ -449,27 +556,11 @@
 type Program    = ChannelMsg.Program
 
 
-maybeAnyController ::
-   Channel -> Event.T -> Maybe (Controller, Int)
-maybeAnyController chan e = do
-   -- let Event.TickTime n = Event.timestamp e
-   Event.CtrlEv Event.Controller c <- Just $ Event.body e
-   guard (c ^. MALSA.ctrlChannel  ==  chan)
-   MALSA.Controller cn cv <- Just $ c ^. MALSA.ctrlControllerMode
-   return (cn, cv)
-
-maybeController :: Channel -> Controller -> Event.T -> Maybe Int
-maybeController chan ctrl e = do
-   (c,n) <- maybeAnyController chan e
-   guard (ctrl==c)
-   return n
-
-
 getControllerEvents ::
    Channel -> Controller ->
    Filter (EventList.T StrictTime [Int])
 getControllerEvents chan ctrl =
-   getSlice (maybeController chan ctrl)
+   getSlice (Check.controller chan ctrl)
 
 {-
 getControllerEvents ::
@@ -477,28 +568,9 @@
    Filter (EventList.T StrictTime (Maybe Int))
 getControllerEvents chan ctrl =
    fmap (fmap (fmap snd . ListHT.viewR)) $
-   getSlice (maybeController chan ctrl)
+   getSlice (Check.controller chan ctrl)
 -}
 
-maybePitchBend :: Channel -> Event.T -> Maybe Int
-maybePitchBend chan e =
-   case Event.body e of
-      Event.CtrlEv Event.PitchBend c ->
-         toMaybe
-            (c ^. MALSA.ctrlChannel == chan)
-            (c ^. MALSA.ctrlValue)
-      _ -> Nothing
-
-maybeChannelPressure :: Channel -> Event.T -> Maybe Int
-maybeChannelPressure chan e =
-   case Event.body e of
-      Event.CtrlEv Event.ChanPress c ->
-         toMaybe
-            (c ^. MALSA.ctrlChannel == chan)
-            (c ^. MALSA.ctrlValue)
-      _ -> Nothing
-
-
 data NoteBoundary a =
      NoteBoundary Pitch Velocity a
    | AllNotesOff
@@ -515,33 +587,38 @@
    Channel ->
    Filter (EventList.T StrictTime [Either Program (NoteBoundary Bool)])
 getNoteEvents chan =
-   getSlice $ \e ->
-      case Event.body e of
-         Event.NoteEv notePart note ->
-            do guard (note ^. MALSA.noteChannel == chan)
-               let (part,vel) =
-                      MALSA.normalNoteFromEvent notePart note
-               press <-
-                  case part of
-                     Event.NoteOn  -> Just True
-                     Event.NoteOff -> Just False
-                     _ -> Nothing
-               return $ Right $ NoteBoundary
-                  (note ^. MALSA.notePitch) vel press
-         Event.CtrlEv Event.PgmChange ctrl ->
-            do guard (ctrl ^. MALSA.ctrlChannel == chan)
-               return $ Left $ ctrl ^. MALSA.ctrlProgram
-         {-
-         We do not handle AllSoundOff here,
-         since this would also mean to clear reverb buffers
-         and this cannot be handled here.
-         -}
-         Event.CtrlEv Event.Controller ctrl ->
-            do guard (ctrl ^. MALSA.ctrlControllerMode ==
-                        MALSA.Mode Mode.AllNotesOff)
-               return $ Right AllNotesOff
-         _ -> Nothing
+   getSlice $ checkNoteEvent chan
 
+checkNoteEvent ::
+   Channel -> Event.T ->
+   Maybe (Either Program (NoteBoundary Bool))
+checkNoteEvent chan e =
+   case Event.body e of
+      Event.NoteEv notePart note ->
+         do guard (note ^. MALSA.noteChannel == chan)
+            let (part,vel) =
+                   MALSA.normalNoteFromEvent notePart note
+            press <-
+               case part of
+                  Event.NoteOn  -> return True
+                  Event.NoteOff -> return False
+                  _ -> mzero
+            return $ Right $ NoteBoundary
+               (note ^. MALSA.notePitch) vel press
+      Event.CtrlEv Event.PgmChange ctrl ->
+         do guard (ctrl ^. MALSA.ctrlChannel == chan)
+            return $ Left $ ctrl ^. MALSA.ctrlProgram
+      {-
+      We do not handle AllSoundOff here,
+      since this would also mean to clear reverb buffers
+      and this cannot be handled here.
+      -}
+      Event.CtrlEv Event.Controller ctrl ->
+         do guard (ctrl ^. MALSA.ctrlControllerMode ==
+                     MALSA.Mode Mode.AllNotesOff)
+            return $ Right AllNotesOff
+      _ -> mzero
+
 embedPrograms ::
    Program ->
    EventList.T StrictTime [Either Program (NoteBoundary Bool)] ->
@@ -549,18 +626,23 @@
 embedPrograms initPgm =
    fmap catMaybes .
    flip evalState initPgm .
-   traverse (traverse
-      (-- evaluate program for every event in order to prevent a space leak
-       (\n -> state (\s -> (seq s n, s)))
-       <=<
-       either
-          (\pgm -> put pgm >> return Nothing)
-          (\bnd ->
-             gets (Just .
-             case bnd of
-                AllNotesOff -> const AllNotesOff
-                NoteBoundary p v press ->
-                   NoteBoundary p v . toMaybe press))))
+   traverse (traverse embedProgramState)
+
+embedProgramState ::
+   Either Program (NoteBoundary Bool) ->
+   State Program (Maybe (NoteBoundary (Maybe Program)))
+embedProgramState =
+   -- evaluate program for every event in order to prevent a space leak
+   (\n -> state (\s -> (seq s n, s)))
+   <=<
+   either
+      (\pgm -> put pgm >> return Nothing)
+      (\bnd ->
+         gets (Just .
+         case bnd of
+            AllNotesOff -> const AllNotesOff
+            NoteBoundary p v press ->
+               NoteBoundary p v . toMaybe press))
 
 
 matchNoteEvents ::
diff --git a/src/Synthesizer/Generic/ALSA/MIDI.hs b/src/Synthesizer/Generic/ALSA/MIDI.hs
--- a/src/Synthesizer/Generic/ALSA/MIDI.hs
+++ b/src/Synthesizer/Generic/ALSA/MIDI.hs
@@ -8,11 +8,11 @@
 import Synthesizer.EventList.ALSA.MIDI
    (LazyTime, StrictTime, Filter, Channel,
     Program, embedPrograms, makeInstrumentArray, getInstrumentFromArray,
-    Note(Note), matchNoteEvents, getNoteEvents,
-    chopLongTime, )
+    Note(Note), matchNoteEvents, getNoteEvents, )
 
 import qualified Sound.MIDI.Message.Channel as ChannelMsg
 
+import qualified Synthesizer.PiecewiseConstant.Signal as PC
 import qualified Synthesizer.Generic.Cut        as CutG
 import qualified Synthesizer.Generic.Signal     as SigG
 
@@ -61,8 +61,8 @@
       SigG.replicate
 --         (SigG.LazySize $ fromIntegral $ maxBound::Int)
          SigG.defaultLazySize
-         (fromInteger $ NonNegW.toNumber t) y) $
-   chopLongTime tl
+         (NonNegW.toNumber t) y) $
+   PC.chopLongTime tl
 
 {-
 ToDo: move to Generic.Signal
@@ -200,8 +200,8 @@
           EventListBT.toPairList xs
    in  (evaluateVectorHead ys t, ys)
 
-type Arranger signal =
-   EventList.T NonNegW.Int signal -> signal
+type FilterSequence signal =
+   Filter (EventList.T PC.ShortStrictTime signal)
 
 {- |
 The state action for the time
@@ -251,14 +251,12 @@
 {-# INLINE sequenceCore #-}
 sequenceCore ::
    (Monoid signal) =>
-   Arranger signal ->
    Channel ->
    Program ->
    Modulator Note signal ->
-   Filter signal
-sequenceCore arranger chan initPgm md =
-   fmap (arranger .
-         EventList.mapTime fromIntegral .
+   FilterSequence signal
+sequenceCore chan initPgm md =
+   fmap (EventList.mapTime fromIntegral .
          flatten .
          applyModulator md .
          matchNoteEvents .
@@ -279,12 +277,11 @@
 {-# INLINE sequence #-}
 sequence ::
    (Monoid signal, Trans.C y) =>
-   Arranger signal ->
    Channel ->
    Instrument y signal ->
-   Filter signal
-sequence arranger chan instr =
-   sequenceCore arranger chan errorNoProgram
+   FilterSequence signal
+sequence chan instr =
+   sequenceCore chan errorNoProgram
       (Modulator () return
           (return . renderInstrumentIgnoreProgram instr))
 
@@ -293,13 +290,12 @@
 sequenceModulated ::
    (CutG.Transform ctrl, CutG.NormalForm ctrl,
     Monoid signal, Trans.C y) =>
-   Arranger signal ->
    ctrl ->
    Channel ->
    (ctrl -> Instrument y signal) ->
-   Filter signal
-sequenceModulated arranger ctrl chan instr =
-   sequenceCore arranger chan errorNoProgram
+   FilterSequence signal
+sequenceModulated ctrl chan instr =
+   sequenceCore chan errorNoProgram
       (Modulator ctrl advanceModulationChunk
           (\note -> gets $ \c -> renderInstrumentIgnoreProgram (instr c) note))
 
@@ -307,14 +303,13 @@
 {-# INLINE sequenceMultiModulated #-}
 sequenceMultiModulated ::
    (Monoid signal, Trans.C y) =>
-   Arranger signal ->
    Channel ->
    instrument ->
    Modulator (instrument, Note) (Instrument y signal, Note) ->
-   Filter signal
-sequenceMultiModulated arranger chan instr
+   FilterSequence signal
+sequenceMultiModulated chan instr
       (Modulator modulatorInit modulatorTime modulatorBody) =
-   sequenceCore arranger chan errorNoProgram
+   sequenceCore chan errorNoProgram
       (Modulator modulatorInit modulatorTime
           (fmap (uncurry renderInstrumentIgnoreProgram) .
            modulatorBody .
@@ -323,14 +318,13 @@
 {-# INLINE sequenceMultiProgram #-}
 sequenceMultiProgram ::
    (Monoid signal, Trans.C y) =>
-   Arranger signal ->
    Channel ->
    Program ->
    [Instrument y signal] ->
-   Filter signal
-sequenceMultiProgram arranger chan initPgm instrs =
+   FilterSequence signal
+sequenceMultiProgram chan initPgm instrs =
    let bank = makeInstrumentArray instrs
-   in  sequenceCore arranger chan initPgm
+   in  sequenceCore chan initPgm
           (Modulator () return
               (return . renderInstrument
                  (getInstrumentFromArray bank initPgm)))
@@ -339,15 +333,14 @@
 sequenceModulatedMultiProgram ::
    (CutG.Transform ctrl, CutG.NormalForm ctrl,
     Monoid signal, Trans.C y) =>
-   Arranger signal ->
    ctrl ->
    Channel ->
    Program ->
    [ctrl -> Instrument y signal] ->
-   Filter signal
-sequenceModulatedMultiProgram arranger ctrl chan initPgm instrs =
+   FilterSequence signal
+sequenceModulatedMultiProgram ctrl chan initPgm instrs =
    let bank = makeInstrumentArray instrs
-   in  sequenceCore arranger chan initPgm
+   in  sequenceCore chan initPgm
           (Modulator
               ctrl advanceModulationChunk
               (\note -> gets $ \c -> renderInstrument
diff --git a/src/Synthesizer/MIDIValue.hs b/src/Synthesizer/MIDIValue.hs
--- a/src/Synthesizer/MIDIValue.hs
+++ b/src/Synthesizer/MIDIValue.hs
@@ -9,7 +9,6 @@
 
 import qualified Algebra.Transcendental as Trans
 import qualified Algebra.Field          as Field
-import qualified Algebra.Additive       as Additive
 
 import NumericPrelude.Numeric
 -- import NumericPrelude.Base
diff --git a/src/Synthesizer/MIDIValue/BendModulation.hs b/src/Synthesizer/MIDIValue/BendModulation.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/MIDIValue/BendModulation.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{- |
+Combine pitchbend and modulation in one data type.
+-}
+module Synthesizer.MIDIValue.BendModulation where
+
+import qualified Synthesizer.MIDIValue.BendWheelPressure as BWP
+import qualified Synthesizer.MIDIValue as MV
+
+import qualified Algebra.Transcendental as Trans
+import qualified Algebra.RealRing       as RealRing
+import qualified Algebra.Ring           as Ring
+
+import Foreign.Storable (Storable(sizeOf, alignment, peek, poke), )
+import qualified Foreign.Storable.Traversable as Store
+
+import qualified Data.Foldable as Fold
+import qualified Data.Traversable as Trav
+
+import Control.Applicative (Applicative, (<*>), pure, liftA2, )
+
+import Control.DeepSeq (NFData, rnf, )
+
+import NumericPrelude.Numeric
+import NumericPrelude.Base
+
+
+{- |
+'bend' is a frequency factor
+and 'depth' is a modulation depth to be interpreted by the instrument.
+-}
+data T a = Cons {bend, depth :: a}
+   deriving (Show, Eq)
+
+deflt :: (Ring.C a) => T a
+deflt = Cons one zero
+
+
+instance (NFData a) => NFData (T a) where
+   rnf bm =
+      case rnf (bend bm) of () -> rnf (depth bm)
+
+
+instance Functor T where
+   {-# INLINE fmap #-}
+   fmap f (Cons b m) = Cons (f b) (f m)
+
+-- useful for defining 'peek' instance
+instance Applicative T where
+   {-# INLINE pure #-}
+   pure a = Cons a a
+   {-# INLINE (<*>) #-}
+   (Cons fb fm) <*> (Cons b m) =
+      Cons (fb b) (fm m)
+
+instance Fold.Foldable T where
+   {-# INLINE foldMap #-}
+   foldMap = Trav.foldMapDefault
+
+-- this allows for kinds of generic programming
+instance Trav.Traversable T where
+   {-# INLINE sequenceA #-}
+   sequenceA (Cons b m) =
+      liftA2 Cons b m
+
+
+force :: T a -> T a
+force ~(Cons a b) = (Cons a b)
+
+instance (Storable a) => Storable (T a) where
+   {-# INLINE sizeOf #-}
+   sizeOf = Store.sizeOf . force
+   {-# INLINE alignment #-}
+   alignment = Store.alignment . force
+   {-# INLINE peek #-}
+   peek = Store.peekApplicative
+   {-# INLINE poke #-}
+   poke = Store.poke
+
+
+
+{- |
+Multiply the pitch bend by a given factor.
+This way you can e.g. shift the pitch bend from around 1
+to the actual frequency.
+-}
+shift ::
+   (Ring.C a) =>
+   a -> T a -> T a
+shift k (Cons b d) = Cons (k*b) d
+
+fromBendWheelPressure ::
+   (RealRing.C a, Trans.C a) =>
+   Int -> a -> a ->
+   BWP.T -> T a
+fromBendWheelPressure
+      pitchRange wheelDepth pressDepth bwp =
+   Cons
+      (MV.pitchBend (2^?(fromIntegral pitchRange/12)) 1 (BWP.bend_ bwp))
+      (MV.controllerLinear (0,wheelDepth) (BWP.wheel_ bwp) +
+       MV.controllerLinear (0,pressDepth) (BWP.pressure_ bwp))
diff --git a/src/Synthesizer/MIDIValue/BendWheelPressure.hs b/src/Synthesizer/MIDIValue/BendWheelPressure.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/MIDIValue/BendWheelPressure.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module Synthesizer.MIDIValue.BendWheelPressure where
+
+import qualified Data.Accessor.Basic as Accessor
+
+import Control.DeepSeq (NFData, rnf, )
+
+import NumericPrelude.Numeric
+import NumericPrelude.Base
+
+
+data T = Cons {bend_, wheel_, pressure_ :: Int}
+   deriving (Show, Eq)
+
+deflt :: T
+deflt = Cons 0 0 0
+
+
+bend, wheel, pressure :: Accessor.T T Int
+bend =
+   Accessor.fromSetGet
+      (\b (Cons _ w p) -> Cons b w p)
+      bend_
+
+wheel =
+   Accessor.fromSetGet
+      (\w (Cons b _ p) -> Cons b w p)
+      wheel_
+
+pressure =
+   Accessor.fromSetGet
+      (\p (Cons b w _) -> Cons b w p)
+      pressure_
+
+
+instance NFData T where
+   rnf (Cons b w p) =
+      case (rnf b, rnf w, rnf p) of
+         ((), (), ()) -> ()
diff --git a/src/Synthesizer/PiecewiseConstant/ALSA/MIDI.hs b/src/Synthesizer/PiecewiseConstant/ALSA/MIDI.hs
--- a/src/Synthesizer/PiecewiseConstant/ALSA/MIDI.hs
+++ b/src/Synthesizer/PiecewiseConstant/ALSA/MIDI.hs
@@ -4,60 +4,59 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 module Synthesizer.PiecewiseConstant.ALSA.MIDI (
    T,
-   subdivide,
-   subdivideInt,
    duration,
-   zipWith,
+   PC.zipWith,
 
    initWith,
    controllerLinear,
    controllerExponential,
    pitchBend,
    channelPressure,
-   BendModulation(BendModulation),
-   shiftBendModulation,
    bendWheelPressure,
+   checkBendWheelPressure,
+   bendWheelPressureZip,
    ) where
 
 import qualified Synthesizer.EventList.ALSA.MIDI as Ev
 import Synthesizer.EventList.ALSA.MIDI (LazyTime, StrictTime, Filter, Channel, )
 
-import qualified Synthesizer.MIDIValue as MV
+import qualified Sound.MIDI.ALSA.Check as Check
 import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
+import qualified Sound.ALSA.Sequencer.Event as Event
+import qualified Synthesizer.MIDIValue.BendModulation as BM
+import qualified Synthesizer.MIDIValue.BendWheelPressure as BWP
+import qualified Synthesizer.MIDIValue as MV
 
-import qualified Data.EventList.Relative.TimeTime  as EventListTT
+import qualified Synthesizer.PiecewiseConstant.Signal as PC
+
+-- import qualified Data.EventList.Relative.TimeTime  as EventListTT
 import qualified Data.EventList.Relative.TimeMixed as EventListTM
 import qualified Data.EventList.Relative.MixedTime as EventListMT
 import qualified Data.EventList.Relative.BodyTime  as EventListBT
 import qualified Data.EventList.Relative.TimeBody  as EventList
 
 import qualified Numeric.NonNegative.Class   as NonNeg
-import qualified Numeric.NonNegative.Wrapper as NonNegW
+-- import qualified Numeric.NonNegative.Wrapper as NonNegW
 import qualified Numeric.NonNegative.Chunky as NonNegChunky
-import Numeric.NonNegative.Class ((-|), )
 
 import qualified Algebra.Transcendental as Trans
-import qualified Algebra.RealRing      as RealRing
+import qualified Algebra.RealRing       as RealRing
 import qualified Algebra.Field          as Field
-import qualified Algebra.Ring           as Ring
-import qualified Algebra.Additive       as Additive
 
-import Control.Monad.Trans.State (evalState, get, put, )
-import Control.Monad (liftM, liftM2, )
-import Data.Traversable (traverse, )
+import qualified Data.Accessor.Monad.Trans.State as AccState
+import Control.Monad.Trans.State (State, evalState, state, get, put, )
+import Control.Monad (liftM, liftM2, msum, )
+import Data.Traversable (traverse, sequence, )
 import Data.Foldable (traverse_, )
-import Control.DeepSeq (NFData, rnf, )
 
-import Data.Maybe.HT (toMaybe, )
+import qualified Data.List.HT as ListHT
 import qualified Data.List as List
-import Data.Maybe (Maybe(Just, Nothing), maybe, )
-import Data.Ord (Ordering(LT,GT,EQ), min, compare, )
-import Data.Bool (Bool(False,True), (||), )
-import Data.Function ((.), ($), flip, id, )
+import Data.Either (Either(Left, Right), )
+import Data.Maybe (maybe, )
+import Data.Function ((.), ($), flip, )
 
 import NumericPrelude.Numeric
-import Prelude as P
-   (Eq, Show, uncurry, fmap, return, (>>), )
+import Prelude as P (Maybe, fmap, (>>), )
 
 
 type T = EventListBT.T StrictTime
@@ -67,41 +66,7 @@
 duration =
    NonNegChunky.fromChunks . EventListBT.getTimes
 
-{-
-ToDo: move to PiecewiseConstant.Signal or so.
--}
-{-# INLINE subdivide #-}
-subdivide ::
-   EventListBT.T LazyTime y -> EventListBT.T StrictTime y
-subdivide =
-   EventListBT.foldrPair
-      (\y lt r ->
-         List.foldr
-            (\dt ->
-               EventListMT.consBody y .
-               EventListMT.consTime dt) r $
-         NonNegChunky.toChunks (NonNegChunky.normalize lt))
-      EventListBT.empty
 
-{- |
-Subdivide lazy times into chunks that fit into the number range
-representable by @Int@.
--}
-{-# INLINE subdivideInt #-}
-subdivideInt ::
-   EventListBT.T LazyTime y -> EventListBT.T NonNegW.Int y
-subdivideInt =
-   EventListBT.mapTime
-      (NonNegW.fromNumber .
-       fromIntegral .
-       NonNegW.toNumber) .
-   subdivide .
-   EventListBT.mapTime
-      (NonNegChunky.fromChunks .
-       List.concatMap Ev.chopLongTime .
-       NonNegChunky.toChunks)
-
-
 {-# INLINE initWith #-}
 initWith ::
    (y -> c) ->
@@ -153,7 +118,7 @@
    Filter (T y)
 pitchBend chan range center =
    liftM (initWith (MV.pitchBend range center) center) $
-   Ev.getSlice (Ev.maybePitchBend chan)
+   Ev.getSlice (Check.pitchBend chan)
 --   getPitchBendEvents chan
 
 {-# INLINE channelPressure #-}
@@ -164,153 +129,60 @@
    Filter (T y)
 channelPressure chan maxVal initVal =
    liftM (initWith (MV.controllerLinear (0,maxVal)) initVal) $
-   Ev.getSlice (Ev.maybeChannelPressure chan)
+   Ev.getSlice (Check.channelPressure chan)
 
 
-data BendModulation a = BendModulation a a
-   deriving (P.Show, P.Eq)
-
-instance (NFData a) => NFData (BendModulation a) where
-   rnf (BendModulation bend depth) =
-      case rnf bend of () -> rnf depth
+{-# INLINE bendWheelPressure #-}
+bendWheelPressure ::
+   (RealRing.C y, Trans.C y) =>
+   Channel ->
+   Int -> y -> y ->
+   Filter (T (BM.T y))
+bendWheelPressure chan
+      pitchRange wheelDepth pressDepth =
+   let toBM = BM.fromBendWheelPressure pitchRange wheelDepth pressDepth
+   in  liftM (initWith toBM (toBM BWP.deflt)) $
+       state $
+       EventList.unzip .
+       fmap ListHT.unzipEithers .
+       flip evalState BWP.deflt .
+       traverse (traverse (separateBWP chan))
 
+separateBWP :: Channel -> Event.T -> State BWP.T (Either BWP.T Event.T)
+separateBWP chan ev =
+   fmap (maybe (Right ev) Left) $
+   checkBendWheelPressure chan ev
 
 {- |
-Multiply the pitch bend by a given factor.
-This way you can e.g. shift the pitch bend from around 1
-to the actual frequency.
+I hesitate to move this to MIDIValue or BendWheelPressure module
+because it depends on ALSA specific Event.
 -}
-shiftBendModulation ::
-   (Ring.C a) =>
-   a -> BendModulation a -> BendModulation a
-shiftBendModulation k (BendModulation bend depth) =
-   BendModulation (k*bend) depth
-
-
-_subdivideMaybe ::
-   EventListBT.T LazyTime y -> EventListBT.T StrictTime (Maybe y)
-_subdivideMaybe =
-   EventListBT.foldrPair
-      (\y lt r ->
-         case NonNegChunky.toChunks (NonNegChunky.normalize lt) of
-            [] -> r
-            (t:ts) ->
-               EventListBT.cons (Just y) t $
-               List.foldr (EventListBT.cons Nothing) r ts)
-      EventListBT.empty
+checkBendWheelPressure ::
+   Channel -> Event.T -> State BWP.T (Maybe BWP.T)
+checkBendWheelPressure chan ev =
+   sequence $
+   (fmap (>> get)) $
+   msum $ List.map ($ev) $
+      (fmap (AccState.set BWP.bend) . Check.pitchBend chan) :
+      (fmap (AccState.set BWP.wheel) . Check.controller chan VoiceMsg.modulation) :
+      (fmap (AccState.set BWP.pressure) . Check.channelPressure chan) :
+      []
 
 {- |
-When a lazy time value is split into chunks
-then do not just replicate the sample for the whole time,
-but insert 'Nothing's.
--}
-{-# INLINE subdivideMaybe #-}
-subdivideMaybe ::
-   EventListTT.T LazyTime y ->
-   EventListTT.T StrictTime (Maybe y)
-subdivideMaybe =
-   EventListTT.foldr
-      (\lt r ->
-         uncurry EventListMT.consTime $
-         case NonNegChunky.toChunks (NonNegChunky.normalize lt) of
-            [] ->
-               (NonNegW.fromNumber zero, r)
-            (t:ts) ->
-               (t, List.foldr (EventListBT.cons Nothing) r ts))
-      (\y r -> EventListMT.consBody (Just y) r)
-      EventListBT.empty
-
-{-# INLINE unionMaybe #-}
-unionMaybe ::
-   EventListTT.T StrictTime (Maybe y) ->
-   EventListTT.T LazyTime y
-unionMaybe =
-   EventListTT.foldr
-      (\t ->
-         EventListMT.mapTimeHead
-            (NonNegChunky.fromChunks . (t:) . NonNegChunky.toChunks))
-      (\my ->
-         case my of
-            Nothing -> id
-            Just y ->
-               EventListMT.consTime NonNegChunky.zero .
-               EventListMT.consBody y)
-      (EventListTT.pause NonNegChunky.zero)
-
-{-
-ToDo: move to PiecewiseConstant.Signal or so.
--}
-zipWithCore ::
-   (a -> b -> c) ->
-   a -> b ->
-   EventListTT.T StrictTime (Maybe a) ->
-   EventListTT.T StrictTime (Maybe b) ->
-   EventListTT.T StrictTime (Maybe c)
-zipWithCore f =
-   let switch ac ar g =
-          flip (EventListMT.switchBodyL EventListBT.empty) ar $ \am ar1 ->
-          g (maybe (False,ac) ((,) True) am) ar1
-       cont j ac bc as bs =
-          EventListMT.consBody (toMaybe j $ f ac bc) $
-          recourse ac bc as bs
-       recourse ac bc as bs =
-          flip EventListMT.switchTimeL as $ \at ar ->
-          flip EventListMT.switchTimeL bs $ \bt br ->
-          let ct = min at bt
-          in  -- ToDo: redundant comparison of 'at' and 'bt'
-              EventListMT.consTime ct $
-              case compare at bt of
-                 LT ->
-                    switch ac ar $ \(ab,a) ar1 ->
-                       cont ab a bc ar1 (EventListMT.consTime (bt-|ct) br)
-                 GT ->
-                    switch bc br $ \(bb,b) br1 ->
-                       cont bb ac b (EventListMT.consTime (at-|ct) ar) br1
-                 EQ ->
-                    switch ac ar $ \(ab,a) ar1 ->
-                    switch bc br $ \(bb,b) br1 ->
-                       cont (ab||bb) a b ar1 br1
-   in  recourse
-
-zipWith ::
-   (a -> b -> c) ->
-   EventListBT.T StrictTime a ->
-   EventListBT.T StrictTime b ->
-   EventListBT.T StrictTime c
-zipWith f as0 bs0 =
-   flip (EventListMT.switchBodyL EventListBT.empty) as0 $ \a0 as1 ->
-   flip (EventListMT.switchBodyL EventListBT.empty) bs0 $ \b0 bs1 ->
-   let c0 = f a0 b0
-   in  EventListMT.consBody c0 $
-       flip evalState c0 $
-       traverse (\mc -> maybe (return ()) put mc >> get) $
-       zipWithCore f a0 b0 (fmap Just as1) (fmap Just bs1)
-
-_zipWithLazy ::
-   (a -> b -> c) ->
-   EventListBT.T LazyTime a ->
-   EventListBT.T LazyTime b ->
-   EventListBT.T LazyTime c
-_zipWithLazy f as0 bs0 =
-   flip (EventListMT.switchBodyL EventListBT.empty) as0 $ \a0 as1 ->
-   flip (EventListMT.switchBodyL EventListBT.empty) bs0 $ \b0 bs1 ->
-   EventListMT.consBody (f a0 b0) $ unionMaybe $
-   zipWithCore f a0 b0 (subdivideMaybe as1) (subdivideMaybe bs1)
-{-
-*Synthesizer.PiecewiseConstant.ALSA.MIDI Data.EventList.Relative.MixedTime> zipWithLazy (,) ('a' ./ 2 /. 'b' ./ 7 /. EventListBT.empty) ('c' ./ (1 P.+ 1) /. 'd' ./ 1 /. EventListBT.empty)
+This one is certainly not as efficient as 'bendWheelPressure'
+since it first slices the event list
+and then zips the slices together.
 -}
-
-
-{-# INLINE bendWheelPressure #-}
-bendWheelPressure ::
+{-# INLINE bendWheelPressureZip #-}
+bendWheelPressureZip ::
    (RealRing.C y, Trans.C y) =>
    Channel ->
    Int -> y -> y ->
-   Filter (T (BendModulation y))
-bendWheelPressure chan
+   Filter (T (BM.T y))
+bendWheelPressureZip chan
      pitchRange wheelDepth pressDepth =
-   liftM2 (zipWith BendModulation)
+   liftM2 (PC.zipWith BM.Cons)
       (pitchBend chan (2^?(fromIntegral pitchRange/12)) 1)
-      (liftM2 (zipWith (+))
+      (liftM2 (PC.zipWith (+))
          (controllerLinear chan VoiceMsg.modulation (0,wheelDepth) 0)
          (channelPressure chan pressDepth 0))
diff --git a/src/Synthesizer/PiecewiseConstant/ALSA/MIDIControllerSet.hs b/src/Synthesizer/PiecewiseConstant/ALSA/MIDIControllerSet.hs
--- a/src/Synthesizer/PiecewiseConstant/ALSA/MIDIControllerSet.hs
+++ b/src/Synthesizer/PiecewiseConstant/ALSA/MIDIControllerSet.hs
@@ -3,24 +3,34 @@
 -}
 {-# LANGUAGE NoImplicitPrelude #-}
 module Synthesizer.PiecewiseConstant.ALSA.MIDIControllerSet (
-   T,
+   T(Cons),
+   mapStream,
+
    Controller(Controller,PitchBend,Pressure),
    fromChannel,
+   maybeController,
    controllerLinear,
    controllerExponential,
    pitchBend,
    channelPressure,
-   PC.BendModulation(PC.BendModulation),
-   PC.shiftBendModulation,
    bendWheelPressure,
+   checkBendWheelPressure,
+   bendWheelPressureZip,
+
+   -- * internal data needed in synthesizer-llvm
+   initial, stream,
    ) where
 
-import qualified Synthesizer.PiecewiseConstant.ALSA.MIDI as PC
+import qualified Synthesizer.PiecewiseConstant.Signal as PC
 import qualified Synthesizer.EventList.ALSA.MIDI as Ev
 import Synthesizer.EventList.ALSA.MIDI (StrictTime, Channel, )
 
-import qualified Synthesizer.MIDIValue as MV
+import qualified Sound.ALSA.Sequencer.Event as Event
+import qualified Sound.MIDI.ALSA.Check as Check
 import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
+import qualified Synthesizer.MIDIValue.BendModulation as BM
+import qualified Synthesizer.MIDIValue.BendWheelPressure as BWP
+import qualified Synthesizer.MIDIValue as MV
 
 import qualified Synthesizer.Generic.Cut as CutG
 import Control.DeepSeq (NFData, rnf, )
@@ -37,16 +47,17 @@
 -- import Numeric.NonNegative.Class ((-|), )
 
 import qualified Algebra.Transcendental as Trans
-import qualified Algebra.RealRing      as RealRing
+import qualified Algebra.RealRing       as RealRing
 import qualified Algebra.Field          as Field
 import qualified Algebra.Additive       as Additive
 
--- import qualified Data.Set as Set
 import qualified Data.Map as Map
 import Data.Map (Map, )
 
+import qualified Data.Accessor.Monad.Trans.State as AccState
+import qualified Data.Accessor.Basic as Acc
 import Control.Monad.Trans.State (State, evalState, state, get, put, )
-import Control.Monad (liftM2, msum, fmap, )
+import Control.Monad (liftM2, msum, )
 import Data.Traversable (traverse, )
 import Data.Foldable (traverse_, )
 import Data.Monoid (Monoid, mempty, mappend, )
@@ -99,13 +110,17 @@
 fromChannel chan =
    fmap (Cons Map.empty) $
    fmap (flip EventListTM.snocTime NonNeg98.zero) $
-   Ev.getSlice (\e -> msum $
-      (fmap (mapFst Controller) $ Ev.maybeAnyController chan e) :
-      (fmap ((,) PitchBend) $ Ev.maybePitchBend chan e) :
-      (fmap ((,) Pressure) $ Ev.maybeChannelPressure chan e) :
-      [])
+   Ev.getSlice (maybeController chan)
 
+maybeController ::
+   Channel -> Event.T -> Maybe (Controller, Int)
+maybeController chan e = msum $
+   (fmap (mapFst Controller) $ Check.anyController chan e) :
+   (fmap ((,) PitchBend) $ Check.pitchBend chan e) :
+   (fmap ((,) Pressure) $ Check.channelPressure chan e) :
+   []
 
+
 instance CutG.Read (T key a) where
    null =
       List.null . List.filter (> P.fromInteger 0) .
@@ -236,12 +251,13 @@
    error $
    "getSlice: uninitialized controller " ++ show c
 
+{-# INLINE getSlice #-}
 getSlice ::
    Controller ->
    (Int -> a) ->
    a -> Filter (PC.T a)
 getSlice c f deflt =
-   state (\xs ->
+   state $ \xs ->
       let (ys,zs) =
              EventListTT.unzip $
              fmap
@@ -258,7 +274,7 @@
              traverse
                 (\ys0 -> traverse_ (put . f) ys0 >> get)
       in  (EventListMT.consBody yin1 (fill ys),
-           Cons zis zs))
+           Cons zis zs)
 
 
 {-# INLINE controllerLinear #-}
@@ -301,13 +317,62 @@
 
 
 
+-- adapted from getSlice
 {-# INLINE bendWheelPressure #-}
 bendWheelPressure ::
    (RealRing.C y, Trans.C y) =>
    Int -> y -> y ->
-   Filter (PC.T (PC.BendModulation y))
+   Filter (PC.T (BM.T y))
 bendWheelPressure pitchRange wheelDepth pressDepth =
-   liftM2 (PC.zipWith PC.BendModulation)
+   state $ \xs ->
+      let (ys,zs) =
+             EventListTT.unzip $
+             fmap ListHT.unzipEithers $
+             flip evalState BWP.deflt $
+             traverse (traverse separateBWP) (stream xs)
+          move key field (bwp,mp) =
+             mapFst (maybe bwp (\y -> Acc.set field y bwp)) $
+             Map.updateLookupWithKey
+                (\ _k _a -> Nothing) key mp
+          (yin,zis) =
+             move PitchBend BWP.bend $
+             move (Controller VoiceMsg.modulation) BWP.wheel $
+             move Pressure BWP.pressure $
+             (BWP.deflt, initial xs)
+          fill =
+             flip evalState yin .
+             traverse
+                (\ys0 -> traverse_ put ys0 >> get)
+      in  (fmap (BM.fromBendWheelPressure pitchRange wheelDepth pressDepth) $
+           EventListMT.consBody yin (fill ys),
+           Cons zis zs)
+
+separateBWP ::
+   (Controller, Int) -> State BWP.T (Either BWP.T (Controller, Int))
+separateBWP ev =
+   fmap (maybe (Right ev) Left) $
+   checkBendWheelPressure ev
+
+checkBendWheelPressure ::
+   (Controller, Int) -> State BWP.T (Maybe BWP.T)
+checkBendWheelPressure (ctrl,val) =
+   let update field = AccState.set field val >> fmap Just get
+   in  case ctrl of
+          PitchBend -> update BWP.bend
+          Pressure -> update BWP.pressure
+          Controller cc ->
+             if cc == VoiceMsg.modulation
+               then update BWP.wheel
+               else return $ Nothing
+
+
+{-# INLINE bendWheelPressureZip #-}
+bendWheelPressureZip ::
+   (RealRing.C y, Trans.C y) =>
+   Int -> y -> y ->
+   Filter (PC.T (BM.T y))
+bendWheelPressureZip pitchRange wheelDepth pressDepth =
+   liftM2 (PC.zipWith BM.Cons)
       (pitchBend (2 ^? (fromIntegral pitchRange / 12)) 1)
       (liftM2 (PC.zipWith (+))
          (controllerLinear VoiceMsg.modulation (0,wheelDepth) 0)
diff --git a/src/Synthesizer/Storable/ALSA/MIDI.hs b/src/Synthesizer/Storable/ALSA/MIDI.hs
--- a/src/Synthesizer/Storable/ALSA/MIDI.hs
+++ b/src/Synthesizer/Storable/ALSA/MIDI.hs
@@ -33,9 +33,7 @@
 import Synthesizer.EventList.ALSA.MIDI
           (LazyTime, StrictTime, Filter, Note,
            Program, Channel, Controller,
-           getControllerEvents, getSlice,
-           maybePitchBend, maybeChannelPressure,
-           chopLongTime, )
+           getControllerEvents, getSlice, )
 import qualified Synthesizer.Generic.ALSA.MIDI as Gen
 import qualified Synthesizer.MIDIValue as MV
 
@@ -50,8 +48,10 @@
 import qualified Synthesizer.State.Filter.NonRecursive as FiltNRS
 import qualified Synthesizer.Basic.Wave         as Wave
 
+import qualified Sound.MIDI.ALSA.Check as Check
 import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
 
+import qualified Synthesizer.PiecewiseConstant.Signal as PC
 -- import qualified Data.EventList.Relative.TimeTime  as EventListTT
 -- import qualified Data.EventList.Relative.MixedTime as EventListMT
 -- import qualified Data.EventList.Relative.MixedBody as EventListMB
@@ -84,15 +84,15 @@
 chunkSizesFromStrictTime :: StrictTime -> NonNegChunky.T SigSt.ChunkSize
 chunkSizesFromStrictTime =
    NonNegChunky.fromChunks .
-   map (SVL.ChunkSize . fromInteger . NonNegW.toNumber) .
-   chopLongTime
+   map (SVL.ChunkSize . NonNegW.toNumber) .
+   PC.chopLongTime
 
 
 chunkSizesFromLazyTime :: LazyTime -> NonNegChunky.T SigSt.ChunkSize
 chunkSizesFromLazyTime =
    NonNegChunky.fromChunks .
-   map (SVL.ChunkSize . fromInteger . NonNegW.toNumber) .
-   concatMap chopLongTime .
+   map (SVL.ChunkSize . NonNegW.toNumber) .
+   concatMap PC.chopLongTime .
    NonNegChunky.toChunks .
    NonNegChunky.normalize
 
@@ -179,7 +179,7 @@
    Filter (SigSt.T y)
 pitchBend chan range center =
    liftM (piecewiseConstantInitWith (MV.pitchBend range center) center) $
-   getSlice (maybePitchBend chan)
+   getSlice (Check.pitchBend chan)
 --   getPitchBendEvents chan
 
 {-# INLINE channelPressure #-}
@@ -190,7 +190,7 @@
    Filter (SigSt.T y)
 channelPressure chan maxVal initVal =
    liftM (piecewiseConstantInitWith (MV.controllerLinear (0,maxVal)) initVal) $
-   getSlice (maybeChannelPressure chan)
+   getSlice (Check.channelPressure chan)
 
 
 {-
@@ -230,8 +230,9 @@
    Program ->
    Gen.Modulator Note (SigSt.T yv) ->
    Filter (SigSt.T yv)
-sequenceCore chunkSize =
-   Gen.sequenceCore (CutSt.arrangeEquidist chunkSize)
+sequenceCore chunkSize chan pgm modu =
+   fmap (CutSt.arrangeEquidist chunkSize) $
+   Gen.sequenceCore chan pgm modu
 
 
 {-# INLINE sequence #-}
@@ -241,8 +242,9 @@
    Channel ->
    Instrument y yv ->
    Filter (SigSt.T yv)
-sequence chunkSize =
-   Gen.sequence (CutSt.arrangeEquidist chunkSize)
+sequence chunkSize chan bank =
+   fmap (CutSt.arrangeEquidist chunkSize) $
+   Gen.sequence chan bank
 
 
 {-# INLINE sequenceModulated #-}
@@ -253,8 +255,9 @@
    Channel ->
    (SigSt.T c -> Instrument y yv) ->
    Filter (SigSt.T yv)
-sequenceModulated chunkSize =
-   Gen.sequenceModulated (CutSt.arrangeEquidist chunkSize)
+sequenceModulated chunkSize modu chan instr =
+   fmap (CutSt.arrangeEquidist chunkSize) $
+   Gen.sequenceModulated modu chan instr
 
 
 {-# INLINE sequenceMultiModulated #-}
@@ -265,8 +268,9 @@
    instrument ->
    Gen.Modulator (instrument, Note) (Instrument y yv, Note) ->
    Filter (SigSt.T yv)
-sequenceMultiModulated chunkSize =
-   Gen.sequenceMultiModulated (CutSt.arrangeEquidist chunkSize)
+sequenceMultiModulated chunkSize chan instr modu =
+   fmap (CutSt.arrangeEquidist chunkSize) $
+   Gen.sequenceMultiModulated chan instr modu
 
 
 applyModulation ::
@@ -310,5 +314,6 @@
    Program ->
    [Instrument y yv] ->
    Filter (SigSt.T yv)
-sequenceMultiProgram chunkSize =
-   Gen.sequenceMultiProgram (CutSt.arrangeEquidist chunkSize)
+sequenceMultiProgram chunkSize chan pgm bank =
+   fmap (CutSt.arrangeEquidist chunkSize) $
+   Gen.sequenceMultiProgram chan pgm bank
diff --git a/src/Synthesizer/Storable/ALSA/Play.hs b/src/Synthesizer/Storable/ALSA/Play.hs
--- a/src/Synthesizer/Storable/ALSA/Play.hs
+++ b/src/Synthesizer/Storable/ALSA/Play.hs
@@ -1,13 +1,23 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {- |
-Convert MIDI events of a MIDI controller to a control signal.
+Play audio signals via ALSA.
+The module could also be called @Output@,
+because with a @file@ sink, data can also be written to disk.
 -}
 module Synthesizer.Storable.ALSA.Play (
+   -- * auxiliary functions
+   Device,
+   defaultDevice,
+   defaultChunkSize,
+   makeSink,
+   write,
+   writeLazy,
+   -- * play functions
    auto,
    autoAndRecord,
+   autoAndRecordMany,
    monoToInt16,
    stereoToInt16,
-   defaultChunkSize,
    ) where
 
 import qualified Sound.ALSA.PCM as ALSA
@@ -22,7 +32,9 @@
 import Foreign.Storable (Storable, )
 import Foreign.Marshal.Array (advancePtr, )
 import Foreign.Ptr (Ptr, minusPtr, )
+import Data.Int (Int16, )
 import qualified System.IO as IO
+import qualified System.Exit as Exit
 
 -- import qualified Synthesizer.State.Signal     as SigS
 
@@ -32,30 +44,65 @@
 
 import qualified Algebra.RealRing as RealRing
 
+import qualified Data.Traversable as Trav
+import qualified Data.Foldable as Fold
+
 import NumericPrelude.Numeric
 import NumericPrelude.Base
 
 
+{- |
+A suggested default chunk size.
+It is not used by the functions in this module.
+-}
+{-
+Better move to Storable.Server.Common or Dimensional.Server.Common?
+-}
 defaultChunkSize :: SigSt.ChunkSize
+defaultChunkSize = SigSt.chunkSize 512
+{-
+At some epochs this chunk size leads to buffer underruns.
+I cannot reproduce this:
+Some months it works this way on Suse but not on Ubuntu or vice versa.
+Other months it works the other way round.
 defaultChunkSize = SigSt.chunkSize 256
+-}
 
 
+type Device = String
+
+defaultDevice :: Device
+defaultDevice = "default"
+
+
+{- |
+Useful values for the output device are
+
+* @\"default\"@ for mixing with the output of other applications.
+
+* @\"plughw:0,0\"@ for accessing sound output in an exclusive way.
+
+* @\"tee:default,'output.raw',raw\"@ for playing and simultaneously writing raw data to disk.
+
+* @\"tee:default,'output.wav',wav\"@ for playing and writing to WAVE file format.
+  Note that the length cannot be written,
+  when the program is terminated,
+  leaving the file in an invalid format.
+-}
 makeSink ::
    (ALSA.SampleFmt y, RealRing.C t) =>
-   t ->
-   ALSA.SampleFreq ->
+   Device {- ^ ALSA output device -} ->
+   t {- ^ period (buffer) size expressed in seconds -} ->
+   ALSA.SampleFreq {- ^ sample rate -} ->
    ALSA.SoundSink y ALSA.Pcm
-makeSink periodTime rate =
-   let {-# INLINE soundFormat #-}
-       soundFormat :: ALSA.SoundFmt y
-       soundFormat =
-          ALSA.SoundFmt {
-             ALSA.sampleFreq = rate
-          }
-   in  ALSA.alsaSoundSinkTime "plughw:0,0" soundFormat $
-       ALSA.SoundBufferTime
-          (round (5000000*periodTime))
-          (round (1000000*periodTime))
+makeSink device periodTime rate =
+   ALSA.alsaSoundSinkTime device
+      (ALSA.SoundFmt {
+         ALSA.sampleFreq = rate
+      }) $
+   ALSA.SoundBufferTime
+      (round (5000000*periodTime))
+      (round (1000000*periodTime))
 
 {-
 alsaOpen: only few buffer underruns with
@@ -72,33 +119,49 @@
 -}
 {-# INLINE auto #-}
 auto ::
-   (ALSA.SampleFmt y, RealRing.C t) =>
-   t {- ^ period (buffer) size expressed in seconds -} ->
-   ALSA.SampleFreq {- ^ sample rate -} ->
+   (ALSA.SampleFmt y) =>
+   ALSA.SoundSink y handle ->
    SigSt.T y -> IO ()
-auto periodTime rate ys =
-   let sink = makeSink periodTime rate
-   in  ALSA.withSoundSink sink $ \to ->
-       flip mapM_ (SVL.chunks ys) $ \c ->
-       SVB.withStartPtr c $ \ptr size ->
-       ALSA.soundSinkWrite sink to ptr size
+auto sink ys =
+   ALSA.withSoundSink sink $ \to ->
+   writeLazy sink to ys
 
+{-# INLINE writeLazy #-}
+writeLazy ::
+   (Storable a) =>
+   ALSA.SoundSink a handle -> handle ->
+   SVL.Vector a -> IO ()
+writeLazy sink to ys =
+   mapM_ (write sink to) (SVL.chunks ys)
+
+{-# INLINE write #-}
+write ::
+   (Storable a) =>
+   ALSA.SoundSink a handle -> handle ->
+   SVB.Vector a -> IO ()
+write sink to c =
+   SVB.withStartPtr c $ \ptr size ->
+   ALSA.soundSinkWrite sink to ptr size
+
+
 -- cf. Alsa.hs
 {-# INLINE arraySize #-}
 arraySize :: Storable y => Ptr y -> Int -> Int
 arraySize p n = advancePtr p n `minusPtr` p
 
+{- |
+Play a signal and write it to disk via SoX simultaneously.
+Consider using 'auto' with @tee@ device.
+-}
 {-# INLINE autoAndRecord #-}
 autoAndRecord ::
-   (ALSA.SampleFmt y, SoxFrame.C y, RealRing.C t) =>
-   t ->
+   (ALSA.SampleFmt y, SoxFrame.C y) =>
    FilePath ->
-   ALSA.SampleFreq ->
-   SigSt.T y -> IO ()
-autoAndRecord periodTime fileName rate =
-   let sink = makeSink periodTime rate
+   ALSA.SoundSink y handle ->
+   SigSt.T y -> IO Exit.ExitCode
+autoAndRecord fileName sink =
+   let rate = ALSA.sampleFreq $ ALSA.soundSinkFmt sink
    in  (\act ->
-          fmap (const ()) .
           SoxWrite.simple act SoxOption.none fileName rate) $ \h ys ->
        ALSA.withSoundSink sink $ \to ->
        flip mapM_ (SVL.chunks ys) $ \c ->
@@ -107,22 +170,41 @@
        IO.hPutBuf h ptr (arraySize ptr size)
 
 
+{- |
+Play a signal and write it to multiple files.
+The Functor @f@ may be @Maybe@ for no or one file to write,
+or @[]@ for many files to write.
+-}
+{-# INLINE autoAndRecordMany #-}
+autoAndRecordMany ::
+   (ALSA.SampleFmt y, SoxFrame.C y,
+    Trav.Traversable f) =>
+   f FilePath ->
+   ALSA.SoundSink y handle ->
+   SigSt.T y -> IO (f Exit.ExitCode)
+autoAndRecordMany fileNames sink =
+   let rate = ALSA.sampleFreq $ ALSA.soundSinkFmt sink
+   in  (\act ->
+          SoxWrite.manyExtended act SoxOption.none SoxOption.none fileNames rate) $ \hs ys ->
+       ALSA.withSoundSink sink $ \to ->
+       flip mapM_ (SVL.chunks ys) $ \c ->
+       SVB.withStartPtr c $ \ptr size ->
+       ALSA.soundSinkWrite sink to ptr size >>
+       Fold.traverse_ (\h -> IO.hPutBuf h ptr (arraySize ptr size)) hs
+
+
 {-# INLINE monoToInt16 #-}
 monoToInt16 ::
-   (Storable y, RealRing.C y, RealRing.C t) =>
-   t ->
-   ALSA.SampleFreq ->
+   (Storable y, RealRing.C y) =>
+   ALSA.SoundSink Int16 handle ->
    SigSt.T y -> IO ()
-monoToInt16 periodTime rate xs =
-   auto periodTime rate
-      (SigSt.map BinSmp.int16FromCanonical xs)
+monoToInt16 sink xs =
+   auto sink (SigSt.map BinSmp.int16FromCanonical xs)
 
 {-# INLINE stereoToInt16 #-}
 stereoToInt16 ::
-   (Storable y, RealRing.C y, RealRing.C t) =>
-   t ->
-   ALSA.SampleFreq ->
+   (Storable y, RealRing.C y) =>
+   ALSA.SoundSink (Stereo.T Int16) handle ->
    SigSt.T (Stereo.T y) -> IO ()
-stereoToInt16 periodTime rate xs =
-   auto periodTime rate
-      (SigSt.map (fmap BinSmp.int16FromCanonical) xs)
+stereoToInt16 sink xs =
+   auto sink (SigSt.map (fmap BinSmp.int16FromCanonical) xs)
diff --git a/src/Synthesizer/Storable/ALSA/Server.hs b/src/Synthesizer/Storable/ALSA/Server.hs
--- a/src/Synthesizer/Storable/ALSA/Server.hs
+++ b/src/Synthesizer/Storable/ALSA/Server.hs
@@ -10,11 +10,10 @@
 import qualified Synthesizer.Storable.ALSA.Play as Play
 import qualified Synthesizer.Storable.Oscillator  as OsciSt
 import qualified Synthesizer.Storable.Signal      as SigSt
-
-import qualified Algebra.Additive  as Additive
+import qualified Data.StorableVector.Lazy as SVL
 
 import NumericPrelude.Numeric (zero, )
-import Prelude hiding (Real, round, break, id, (.), )
+import Prelude hiding (Real, break, id, (.), )
 
 
 {-
@@ -22,9 +21,7 @@
 -}
 main :: IO ()
 main =
-   case 110::Int of
-      000 -> Play.auto (periodTime::Real) 44100 $
-                OsciSt.static chunkSize Wave.sine zero (800/sampleRate::Real)
+   case 208::Int of
       001 -> print Test.keyboard3
       002 -> play (periodTime::Real) sampleRate Test.keyboard3
       003 -> Test.speed
@@ -66,18 +63,51 @@
       050 -> Test.speed
       051 -> Test.speedChunky
       052 -> Test.speedArrange
-      100 -> Run.pitchBend
-      101 -> Run.volumeFrequency
-      102 -> Run.keyboard
-      103 -> Run.keyboardMulti
-      104 -> Run.keyboardStereo
-      105 -> Run.keyboardPitchbend
-      106 -> Run.keyboardFM
-      107 -> Run.keyboardDetuneFM
-      108 -> Run.keyboardFilter
-      109 -> Run.keyboardSample
-      110 -> Run.keyboardVariousStereo
-      111 -> Run.keyboardSampleTFM
-      112 -> Run.keyboardNoisyTone
-      113 -> Run.keyboardFilteredNoisyTone
+      053 -> Play.auto
+{-
+                (ALSA.alsaSoundSinkTime Play.defaultDevice
+                    (ALSA.SoundFmt {
+                       ALSA.sampleFreq = sampleRate
+                    }) $
+                 ALSA.SoundBufferTime
+                    (round (5000000*periodTime::Real))
+                    (round (1000000*periodTime::Real))
+                ) $
+-}
+{-
+                (ALSA.fileSoundSink "test.f32"
+                   (ALSA.SoundFmt {
+                      ALSA.sampleFreq = sampleRate
+                   })) $
+-}
+                (Play.makeSink Play.defaultDevice (periodTime::Real) sampleRate) $
+             SVL.cycle $
+             SigSt.take 100000 $
+                OsciSt.static chunkSize (fmap (0.9*) Wave.sine) zero (1/100::Real)
+      054 -> Play.auto
+                (Play.makeSink Play.defaultDevice (periodTime::Real) sampleRate) $
+                OsciSt.static chunkSize (fmap (0.9*) Wave.sine)
+                   zero (600/sampleRate::Real)
+      055 -> play (periodTime::Real) sampleRate $
+                OsciSt.static chunkSize (fmap (0.9*) Wave.sine)
+                   zero (600/sampleRate::Real)
+      100 -> Run.volume
+      101 -> Run.frequency
+      102 -> Run.frequencyCausal
+      103 -> Run.pitchBend
+      104 -> Run.volumeFrequency
+      105 -> Run.volumeFrequencyCausal
+      200 -> Run.keyboard
+      201 -> Run.keyboardMulti
+      202 -> Run.keyboardStereo
+      203 -> Run.keyboardPitchbend
+      204 -> Run.keyboardFM
+      205 -> Run.keyboardDetuneFM
+      206 -> Run.keyboardFilter
+      207 -> Run.keyboardSample
+      208 -> Run.keyboardVariousStereo
+      209 -> Run.keyboardSampleTFM
+      210 -> Run.keyboardNoisyTone
+      211 -> Run.keyboardFilteredNoisyTone
+      300 -> Run.keyboardCausal
       _   -> error "not implemented server part"
diff --git a/src/Synthesizer/Storable/ALSA/Server/Common.hs b/src/Synthesizer/Storable/ALSA/Server/Common.hs
--- a/src/Synthesizer/Storable/ALSA/Server/Common.hs
+++ b/src/Synthesizer/Storable/ALSA/Server/Common.hs
@@ -17,6 +17,7 @@
 import qualified Data.EventList.Relative.TimeBody  as EventList
 
 import qualified Sound.Sox.Frame         as SoxFrame
+import qualified System.Exit as Exit
 
 import Control.Category ((.), )
 
@@ -56,7 +57,13 @@
    let (SVL.ChunkSize size) = chunkSize
    in  ToInteger.fromIntegral size Field./ Ring.fromInteger sampleRate
 
+device :: Play.Device
+device = Play.defaultDevice
 
+clientName :: MIDIEv.ClientName
+clientName = MIDIEv.ClientName "Haskell-Synthesizer"
+
+
 type Real = Float
 
 
@@ -67,7 +74,7 @@
 withMIDIEvents action proc =
    let rate = sampleRate
        per  = periodTime
-   in  MIDIEv.withMIDIEvents per rate $
+   in  MIDIEv.withMIDIEvents clientName per rate $
        action per rate . proc
 
 
@@ -76,7 +83,7 @@
    (RealField.C t, Additive.C y, ALSA.SampleFmt y) =>
    t -> t -> SigSt.T y -> IO ()
 play period rate =
-   Play.auto period (round rate) .
+   Play.auto (Play.makeSink device period (round rate)) .
    SigSt.append (SigSt.replicate chunkSize latency zero)
 --   FiltG.delayPosLazySize chunkSize latency
 --   FiltG.delayPos latency
@@ -85,9 +92,7 @@
 {-# INLINE playAndRecord #-}
 playAndRecord ::
    (RealField.C t, Additive.C y, ALSA.SampleFmt y, SoxFrame.C y) =>
-   FilePath -> t -> t -> SigSt.T y -> IO ()
+   FilePath -> t -> t -> SigSt.T y -> IO Exit.ExitCode
 playAndRecord fileName period rate =
-   Play.autoAndRecord period fileName (round rate) .
+   Play.autoAndRecord fileName (Play.makeSink device period (round rate)) .
    SigSt.append (SigSt.replicate chunkSize latency zero)
-
-
diff --git a/src/Synthesizer/Storable/ALSA/Server/Instrument.hs b/src/Synthesizer/Storable/ALSA/Server/Instrument.hs
--- a/src/Synthesizer/Storable/ALSA/Server/Instrument.hs
+++ b/src/Synthesizer/Storable/ALSA/Server/Instrument.hs
@@ -2,27 +2,31 @@
 
 import Synthesizer.Storable.ALSA.Server.Common
 
-import qualified Synthesizer.Storable.ALSA.MIDI as AlsaSt
 import Synthesizer.Storable.ALSA.MIDI (
    Instrument, chunkSizesFromLazyTime, )
 
-import qualified Synthesizer.EventList.ALSA.MIDI as MIDIEv
 import Synthesizer.EventList.ALSA.MIDI (LazyTime, )
 
+import qualified Synthesizer.CausalIO.ALSA.Process as PAlsa
+import qualified Synthesizer.CausalIO.Gate as Gate
+import qualified Synthesizer.CausalIO.Process as PIO
+
 import qualified Synthesizer.Basic.Wave          as Wave
 import qualified Synthesizer.Frame.Stereo        as Stereo
 
 import qualified Synthesizer.Causal.Process as Causal
-import qualified Synthesizer.Causal.Interpolation as Interpolation
 import qualified Synthesizer.Causal.Oscillator as OsciC
+import qualified Synthesizer.Causal.Interpolation as Interpolation
 import qualified Synthesizer.Causal.Filter.Recursive.Integration as IntegC
-import Control.Arrow ((<<<), (^<<), (<<^), (***), )
+import qualified Synthesizer.Causal.Filter.NonRecursive as FiltNRC
 import qualified Synthesizer.Interpolation.Module as Ip
+import Control.Arrow ((<<<), (^<<), (<<^), (***), )
 
 import qualified Synthesizer.Storable.Filter.NonRecursive as FiltNRSt
 import qualified Synthesizer.Storable.Signal      as SigSt
 import qualified Data.StorableVector.Lazy.Pattern as SigStV
 import qualified Data.StorableVector.Lazy         as SVL
+import qualified Data.StorableVector              as SV
 
 import qualified Synthesizer.Generic.Wave      as WaveG
 import qualified Synthesizer.State.Signal      as SigS
@@ -43,12 +47,6 @@
 import Control.Monad (mzero, )
 import Control.Category ((.), )
 
-import qualified Algebra.RealRing as RealRing
--- import qualified Algebra.Field     as Field
--- import qualified Algebra.Ring      as Ring
--- import qualified Algebra.ToInteger as ToInteger
-import qualified Algebra.Additive  as Additive
-
 import NumericPrelude.Numeric (zero, round, (*>), )
 import Prelude hiding (Real, round, break, id, (.), )
 
@@ -70,6 +68,17 @@
    SigStV.take (chunkSizesFromLazyTime dur) $
    ping vel freq
 
+pingCausal :: PAlsa.Instrument Real (SV.Vector Real)
+pingCausal vel freq =
+   (PIO.fromCausal $
+    Causal.applyStorableChunk $
+    Causal.feed $
+    FiltNRS.envelope
+       (CtrlS.exponential2 (0.2*sampleRate) (amplitudeFromVelocity vel)) $
+    OsciS.static Wave.saw zero (freq/sampleRate))
+   <<<
+   Gate.toStorableVector
+
 pingReleaseEnvelope :: Real -> LazyTime -> SigSt.T Real
 pingReleaseEnvelope vel dur =
    SigSt.switchR SigSt.empty
@@ -95,6 +104,34 @@
          (OsciS.static Wave.saw zero (freq*0.999/sampleRate))
          (OsciS.static Wave.saw zero (freq*1.001/sampleRate)))
       (pingReleaseEnvelope vel dur)
+
+pingReleaseEnvelopeCausal :: Real -> PIO.T PAlsa.GateChunk (SV.Vector Real)
+pingReleaseEnvelopeCausal vel =
+   PIO.continue
+      ((PIO.fromCausal $
+        Causal.applyStorableChunk $ Causal.feed $
+        CtrlS.exponential2 (0.4*sampleRate) (amplitudeFromVelocity vel))
+       <<<
+       Gate.toStorableVector
+       {-
+       <<<
+       arr (\x -> trace (show x) x) -})
+      (\y -> -- trace ("continue with " ++ show y) $
+         (PIO.fromCausal $
+          Causal.applyStorableChunk $ Causal.feed $
+          SigS.take (round (1*sampleRate :: Real)) $
+          CtrlS.exponential2 (0.1*sampleRate) y)
+         <<<
+         Gate.allToStorableVector)
+
+pingReleaseCausal :: PAlsa.Instrument Real (SV.Vector Real)
+pingReleaseCausal vel freq =
+   (PIO.fromCausal $
+    Causal.applyStorableChunk $
+    FiltNRC.envelope <<<
+    Causal.feedFst (OsciS.static Wave.saw zero (freq/sampleRate)))
+   <<<
+   pingReleaseEnvelopeCausal vel
 
 tine :: Instrument Real Real
 tine vel freq dur =
diff --git a/src/Synthesizer/Storable/ALSA/Server/Run.hs b/src/Synthesizer/Storable/ALSA/Server/Run.hs
--- a/src/Synthesizer/Storable/ALSA/Server/Run.hs
+++ b/src/Synthesizer/Storable/ALSA/Server/Run.hs
@@ -2,12 +2,19 @@
 
 import qualified Synthesizer.Storable.ALSA.Server.Instrument as Instr
 import Synthesizer.Storable.ALSA.Server.Common
-          (Real, withMIDIEvents, play, playAndRecord,
-           sampleRate, lazySize, chunkSize, channel, )
+          (Real, withMIDIEvents, play, device, clientName,
+           sampleRate, lazySize, chunkSize, periodTime, channel, )
 
 import qualified Synthesizer.Storable.ALSA.MIDI as AlsaSt
 import Synthesizer.Storable.ALSA.MIDI (applyModulation, )
 
+import qualified Synthesizer.CausalIO.ALSA.Process as PAlsa
+import qualified Synthesizer.CausalIO.Process as PIO
+
+import qualified Synthesizer.Causal.Oscillator as OsciC
+import qualified Synthesizer.Causal.Process as Causal
+import qualified Synthesizer.Causal.Filter.NonRecursive as FiltNRC
+
 import qualified Synthesizer.Basic.Wave          as Wave
 
 import qualified Synthesizer.Interpolation.Module as Ip
@@ -15,8 +22,11 @@
 import qualified Synthesizer.Storable.Oscillator  as OsciSt
 import qualified Synthesizer.Storable.Signal      as SigSt
 import qualified Data.StorableVector.Lazy         as SVL
+import qualified Data.StorableVector              as SV
+import Foreign.Storable (Storable, )
 
 import qualified Synthesizer.Generic.Loop      as LoopG
+import qualified Synthesizer.Generic.Signal    as SigG
 import qualified Synthesizer.State.Signal      as SigS
 import qualified Synthesizer.Plain.Filter.Recursive    as FiltR
 import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter
@@ -25,8 +35,7 @@
 
 import Control.Monad.Trans.State (evalState, )
 import Control.Category ((.), )
-
-import qualified Algebra.Additive  as Additive
+import Control.Arrow (arr, second, (&&&), )
 
 import Data.Tuple.HT (mapSnd, )
 
@@ -41,16 +50,37 @@
    (withMIDIEvents play $
       SigSt.zipWith (*)
          (OsciSt.static chunkSize Wave.sine zero (800/sampleRate)) .
-      evalState (AlsaSt.controllerLinear channel VoiceMsg.mainVolume (0,1) (0::Real)))
+      evalState (AlsaSt.controllerLinear channel VoiceMsg.mainVolume (0,1) (0.2::Real)))
 
 frequency :: IO ()
 frequency =
    withMIDIEvents play $
       OsciSt.freqMod chunkSize Wave.sine zero .
-      evalState (AlsaSt.controllerLinear channel VoiceMsg.mainVolume
-         (400/sampleRate, 1200/sampleRate) (800/sampleRate::Real))
+      evalState (AlsaSt.controllerExponential channel VoiceMsg.modulation
+         (400/sampleRate, 1600/sampleRate) (800/sampleRate::Real))
 
 
+{-# INLINE storableChunk #-}
+storableChunk ::
+   (SigG.Read sig a, Storable a) =>
+   sig a -> SV.Vector a
+storableChunk chunk =
+   SigS.toStrictStorableSignal (SigG.length chunk) $
+   SigG.toState chunk
+
+frequencyCausal :: IO ()
+frequencyCausal =
+   PAlsa.playFromEvents device clientName 0.01 (periodTime::Double) sampleRate
+      ((PIO.fromCausal $
+        Causal.applyStorableChunk $
+        OsciC.freqMod (fmap (0.99*) Wave.sine) zero)
+       .
+       arr storableChunk
+       .
+       (PAlsa.controllerExponential channel VoiceMsg.modulation
+          (400/sampleRate, 1600/sampleRate) (800/sampleRate::Real)))
+
+
 pitchBend :: IO ()
 pitchBend =
    withMIDIEvents play $
@@ -68,7 +98,26 @@
             SigSt.zipWith (*) vol
                (OsciSt.freqMod chunkSize Wave.sine zero freq)))
 
+volumeFrequencyCausal :: IO ()
+volumeFrequencyCausal =
+   PAlsa.playFromEvents device clientName 0.01 (periodTime::Double) sampleRate
+      ((PIO.fromCausal $
+        Causal.applyStorableChunk $
+        FiltNRC.envelope
+        .
+        second (OsciC.freqMod Wave.sine zero))
+       .
+       arr (uncurry (SV.zipWith (,)))
+       .
+       (arr storableChunk
+        .
+        PAlsa.controllerLinear channel VoiceMsg.mainVolume (0,0.99) (0.5::Real)
+        &&&
+        arr storableChunk
+        .
+        PAlsa.pitchBend channel 2 (880/sampleRate::Real)))
 
+
 keyboard :: IO ()
 keyboard =
    withMIDIEvents play $
@@ -180,7 +229,7 @@
       let loopedString =
              LoopG.timeReverse lazySize Ip.linear Ip.linear
                 LoopG.timeControlZigZag 8750 500 string
-      withMIDIEvents (playAndRecord "session.wav") $
+      withMIDIEvents play $
          SigSt.map ((0.2::Real)*>) .
          evalState (AlsaSt.sequenceMultiProgram chunkSize channel
                (VoiceMsg.toProgram 0) $
@@ -270,3 +319,12 @@
                  applyModulation speed .
                  applyModulation cutoff .
                  applyModulation resonance))
+
+
+
+keyboardCausal :: IO ()
+keyboardCausal =
+   PAlsa.playFromEvents device clientName 0.01 (periodTime::Double) sampleRate $
+      arr (SV.map (0.2*))
+      .
+      PAlsa.sequenceStorable channel (\ _pgm -> Instr.pingReleaseCausal)
diff --git a/src/Synthesizer/Storable/ALSA/Server/Test.hs b/src/Synthesizer/Storable/ALSA/Server/Test.hs
--- a/src/Synthesizer/Storable/ALSA/Server/Test.hs
+++ b/src/Synthesizer/Storable/ALSA/Server/Test.hs
@@ -41,7 +41,6 @@
 import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
 
 import qualified Data.EventList.Relative.TimeBody  as EventList
-import qualified Data.EventList.Relative.MixedBody as EventListMB
 import qualified Data.EventList.Relative.BodyTime  as EventListBT
 import Data.EventList.Relative.MixedBody ((/.), (./), )
 
@@ -55,9 +54,6 @@
 import qualified Numeric.NonNegative.Wrapper as NonNegW
 import qualified Numeric.NonNegative.Chunky as NonNegChunky
 
-import qualified Algebra.RealRing as RealRing
-import qualified Algebra.Additive  as Additive
-
 import Data.Maybe.HT (toMaybe, )
 
 import NumericPrelude.Numeric (zero, round, (^?), )
@@ -220,7 +216,8 @@
 arrangeSpaceLeak0 :: IO ()
 arrangeSpaceLeak0 =
    SVL.writeFile "test.f32" $
-   evalState (Gen.sequence (CutSt.arrange chunkSize) channel
+   CutSt.arrange chunkSize $
+   evalState (Gen.sequence channel
       (error "no sound" :: Instrument Real Real)) $
    let evs = EventList.cons 10 [] evs
    in  evs
@@ -228,8 +225,9 @@
 arrangeSpaceLeak1 :: IO ()
 arrangeSpaceLeak1 =
    SVL.writeFile "test.f32" $
+   CutSt.arrange chunkSize $
    evalState
-      (Gen.sequenceModulated (CutSt.arrange chunkSize)
+      (Gen.sequenceModulated
          (SigSt.iterate chunkSize (1+) 0) channel
          (error "no sound" :: SigSt.T Real -> Instrument Real Real)) $
    let evs = EventList.cons 10 [] evs
@@ -263,8 +261,9 @@
 arrangeSpaceLeak3 :: IO ()
 arrangeSpaceLeak3 =
    SVL.writeFile "test.f32" $
+   CutSt.arrange chunkSize $
    evalState
-      (Gen.sequenceModulated (CutSt.arrange chunkSize)
+      (Gen.sequenceModulated
          (SigSt.iterate chunkSize (1e-7 +) 1) channel
          Instr.stringStereoFM) $
 --         (const Instr.pingDur :: SigSt.T Real -> Instrument Real Real)) $
@@ -285,9 +284,8 @@
 chordSpaceLeak1 :: IO ()
 chordSpaceLeak1 =
    SVL.writeFile "test.f32" $
-   evalState
-      (Gen.sequence (CutSt.arrange chunkSize)
-          channel Instr.pingDur) $
+   CutSt.arrange chunkSize $
+   evalState (Gen.sequence channel Instr.pingDur) $
    let evs t = EventList.cons t [] (evs (20-t))
    in  EventList.cons 10 [makeNote Event.NoteOn 60] $
        EventList.cons 10 [makeNote Event.NoteOn 64] $
@@ -297,9 +295,10 @@
 sequencePitchBend :: IO ()
 sequencePitchBend =
    SVL.writeFile "test.f32" $
+      CutSt.arrange chunkSize $
       evalState
          (let fm y = (EventListBT.cons $! y) 10 (fm (2-y))
-          in  Gen.sequenceModulated (CutSt.arrange chunkSize) (fm 1) channel
+          in  Gen.sequenceModulated (fm 1) channel
                  (error "no sound" ::
                      PC.T Real -> Instrument Real Real)) $
       let evs = EventList.cons 10 [] evs
@@ -308,12 +307,13 @@
 sequencePitchBend1 :: IO ()
 sequencePitchBend1 =
    SVL.writeFile "test.f32" $
+      CutSt.arrange chunkSize $
       evalState
          (let fm y = EventListBT.cons y 10 (fm (2-y))
               instr :: PC.T Real -> Instrument Real Real
               instr = error "no sound"
           in  Gen.sequenceCore
-                 (CutSt.arrange chunkSize) channel Gen.errorNoProgram
+                 channel Gen.errorNoProgram
                  (Gen.Modulator (fm 1) Gen.advanceModulationChunk
                      (\note -> gets $ \c ->
                          Gen.renderInstrumentIgnoreProgram (instr c) note))) $
@@ -548,8 +548,8 @@
 sequenceStaccato1 :: IO ()
 sequenceStaccato1 =
    SVL.writeFile "test.f32" $
-      evalState
-         (do Gen.sequence (CutSt.arrange chunkSize) channel dummySound) $
+      CutSt.arrange chunkSize $
+      evalState (Gen.sequence channel dummySound) $
       let evs t =
              EventList.cons t [makeNote Event.NoteOn  60] $
              EventList.cons t [makeNote Event.NoteOff 60] $
diff --git a/src/Test.hs b/src/Test.hs
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -7,7 +7,6 @@
 import qualified Sound.ALSA.Sequencer.Event as Event
 import qualified Synthesizer.Generic.ALSA.MIDI as Gen
 import qualified Synthesizer.Storable.ALSA.Play as Play
-import qualified Synthesizer.Storable.ALSA.MIDI as AlsaSt
 import Synthesizer.Storable.ALSA.MIDI (
    Instrument, chunkSizesFromLazyTime, )
 
@@ -88,7 +87,8 @@
 sequenceSpaceLeakEmpty :: Bool
 sequenceSpaceLeakEmpty =
    evaluatePrefix $
-   evalState (Gen.sequence (CutSt.arrange chunkSize) channel
+   CutSt.arrange chunkSize $
+   evalState (Gen.sequence channel
       (error "no sound" :: Instrument Real Real)) $
    let evs = consNone 10 evs
    in  evs
@@ -96,8 +96,9 @@
 sequenceSpaceLeakModulatedEmpty :: Bool
 sequenceSpaceLeakModulatedEmpty =
    evaluatePrefix $
+   CutSt.arrange chunkSize $
    evalState
-      (Gen.sequenceModulated (CutSt.arrange chunkSize)
+      (Gen.sequenceModulated
          (SigSt.iterate chunkSize (1+) 0) channel
          (error "no sound" :: SigSt.T Real -> Instrument Real Real)) $
    let evs = consNone 10 evs
@@ -107,9 +108,10 @@
 sequenceSpaceLeakLazyDrop :: Bool
 sequenceSpaceLeakLazyDrop =
    evaluatePrefix $
+   CutSt.arrange chunkSize $
    evalState
       (let fm y = (EventListBT.cons $! y) 10 (fm (2-y))
-       in  Gen.sequenceModulated (CutSt.arrange chunkSize) (fm 1) channel
+       in  Gen.sequenceModulated (fm 1) channel
               (error "no sound" ::
                   PC.T Real -> Instrument Real Real)) $
    let evs = consNone 10 evs
@@ -131,8 +133,9 @@
 sequenceSpaceLeakModulatedInfinite :: Bool
 sequenceSpaceLeakModulatedInfinite =
    evaluatePrefix $
+   CutSt.arrange chunkSize $
    evalState
-      (Gen.sequenceModulated (CutSt.arrange chunkSize)
+      (Gen.sequenceModulated
          (SigSt.iterate chunkSize (1e-7 +) 1) channel
          stringStereoFM) $
    let evs t = consNone t (evs (20-t))
@@ -142,8 +145,9 @@
 sequenceSpaceLeakModulatedChordStep :: Bool
 sequenceSpaceLeakModulatedChordStep =
    evaluatePrefix $
+   CutSt.arrange chunkSize $
    evalState
-      (Gen.sequenceModulated (CutSt.arrange chunkSize)
+      (Gen.sequenceModulated
          (SigSt.iterate chunkSize (1e-7 +) 1) channel
          stringStereoFM) $
    let evs t = consNone t (evs (20-t))
@@ -155,8 +159,9 @@
 sequenceSpaceLeakModulatedChordSimultaneous :: Bool
 sequenceSpaceLeakModulatedChordSimultaneous =
    evaluatePrefix $
+   CutSt.arrange chunkSize $
    evalState
-      (Gen.sequenceModulated (CutSt.arrange chunkSize)
+      (Gen.sequenceModulated
          (SigSt.iterate chunkSize (1e-7 +) 1) channel
          stringStereoFM) $
    let evs t = EventList.cons t [] (evs (20-t))
@@ -169,8 +174,9 @@
 sequenceSpaceLeakStaccato :: Bool
 sequenceSpaceLeakStaccato =
    evaluatePrefix $
+   CutSt.arrange chunkSize $
    evalState
-      (Gen.sequenceModulated (CutSt.arrange chunkSize)
+      (Gen.sequenceModulated
          (SigSt.iterate chunkSize (1e-7 +) 1) channel
          stringStereoFM) $
    let evs t =
diff --git a/synthesizer-alsa.cabal b/synthesizer-alsa.cabal
--- a/synthesizer-alsa.cabal
+++ b/synthesizer-alsa.cabal
@@ -1,11 +1,10 @@
 Name:           synthesizer-alsa
-Version:        0.3
+Version:        0.4
 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/Synthesizer
-Package-URL:    http://code.haskell.org/synthesizer/alsa/
 Category:       Sound, Music
 Synopsis:       Control synthesizer effects via ALSA/MIDI
 Description:
@@ -14,10 +13,19 @@
   that can be used for audio effects.
   As demonstration there is a keyboard controlled music synthesizer.
 Stability:      Experimental
-Tested-With:    GHC==6.4.1, GHC==6.8.2, GHC==6.10.4
-Cabal-Version:  >=1.2
+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
+Cabal-Version:  >=1.6
 Build-Type:     Simple
 
+Source-Repository this
+  Tag:         0.4
+  Type:        darcs
+  Location:    http://code.haskell.org/synthesizer/alsa/
+
+Source-Repository head
+  Type:        darcs
+  Location:    http://code.haskell.org/synthesizer/alsa/
+
 Flag splitBase
   description: Choose the new smaller, split-up base package.
 
@@ -35,34 +43,41 @@
 
 Library
   Build-Depends:
-    synthesizer-dimensional >=0.5 && < 0.6,
-    synthesizer-core >=0.4 && < 0.5,
-    sox >=0.2 && <0.3,
-    midi-alsa >=0.1 && <0.2,
-    alsa-seq >=0.5 && <0.6,
+    synthesizer-dimensional >=0.6 && <0.7,
+    synthesizer-core >=0.5 && <0.6,
+    sox >=0.2.1 && <0.3,
+    midi-alsa >=0.1.2 && <0.2,
+    alsa-seq >=0.5.1 && <0.6,
     alsa-pcm >=0.5 && <0.6,
     alsa-core >=0.5 && <0.6,
     midi >=0.1.1 && <0.2,
+    storable-record >=0.0.2 && <0.1,
     storablevector >=0.2.5 && <0.3,
     deepseq >=1.1 && <1.2,
-    numeric-prelude >=0.2 && <0.3,
+    numeric-prelude >=0.3 && <0.4,
     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.4,
+    containers >=0.1 && <0.5,
     array >=0.1 && <0.4,
     transformers >=0.2 && <0.3,
     utility-ht >=0.0.1 && <0.1
 
   If flag(splitBase)
     Build-Depends:
-      base >= 3 && <6,
       random >= 1.0 && < 1.1,
-      old-time >= 1.0 && < 1.1
+      old-time >= 1.0 && < 1.1,
+      base >= 3 && <5
   Else
     Build-Depends:
       base >= 1.0 && < 2
 
+  If impl(ghc>=7.0)
+    GHC-Options: -fwarn-unused-do-bind
+    CPP-Options: -DNoImplicitPrelude=RebindableSyntax
+    Extensions: CPP
+
   GHC-Options:    -Wall
   Hs-source-dirs: src
   Exposed-modules:
@@ -74,10 +89,16 @@
     Synthesizer.Generic.ALSA.MIDI
     Synthesizer.Dimensional.ALSA.MIDI
     Synthesizer.Dimensional.ALSA.Play
+    Synthesizer.CausalIO.ALSA.Process
+    Synthesizer.CausalIO.ALSA.MIDIControllerSet
+    Synthesizer.CausalIO.ALSA.MIDIControllerSelection
     -- these modules would be better located in midi package,
     -- but they are based on NumericPrelude
     Synthesizer.MIDIValue
+    Synthesizer.MIDIValue.BendModulation
+    Synthesizer.MIDIValue.BendWheelPressure
     Synthesizer.Dimensional.MIDIValue
+    Synthesizer.Dimensional.MIDIValuePlain
 
 Executable realtimesynth
   If !flag(buildExamples)
@@ -86,6 +107,10 @@
     GHC-Options: -O2 -fvia-C -optc-O2 -optc-msse3 -optc-ffast-math
   GHC-Options: -Wall -fexcess-precision -threaded
 -- -ddump-simpl-stats -ddump-asm
+  If impl(ghc>=7.0)
+    GHC-Options: -fwarn-unused-do-bind
+    CPP-Options: -DNoImplicitPrelude=RebindableSyntax
+    Extensions: CPP
   Hs-Source-Dirs: src
   Other-modules:
     Synthesizer.Storable.ALSA.Server.Common
@@ -101,6 +126,10 @@
     GHC-Options: -O2 -fvia-C -optc-O2 -optc-ffast-math
   GHC-Options: -Wall -fexcess-precision -threaded
 -- -ddump-simpl-stats
+  If impl(ghc>=7.0)
+    GHC-Options: -fwarn-unused-do-bind
+    CPP-Options: -DNoImplicitPrelude=RebindableSyntax
+    Extensions: CPP
   Hs-Source-Dirs: src
   Other-modules:
     Synthesizer.Dimensional.ALSA.Server.Common
@@ -116,5 +145,9 @@
     GHC-Options: -O2 -fvia-C -optc-O2 -optc-msse3 -optc-ffast-math
   GHC-Options: -Wall -fexcess-precision -threaded
 -- -ddump-simpl-stats -ddump-asm
+  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
