{-# LANGUAGE ExistentialQuantification #-}
{- |
Convert MIDI events of a MIDI controller to a control signal.
-}
{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.MIDI.Generic where

import Synthesizer.MIDI.EventList
   (LazyTime, StrictTime, Filter, Channel,
    Program, embedPrograms, makeInstrumentArray, getInstrumentFromArray,
    Note(Note), matchNoteEvents, getNoteEvents, )

import qualified Sound.MIDI.Message.Class.Check as Check
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

import qualified Synthesizer.MIDI.Value as MV

import qualified Data.EventList.Relative.MixedBody as EventListMB
import qualified Data.EventList.Relative.BodyTime  as EventListBT
import qualified Data.EventList.Relative.TimeBody  as EventList

import Data.Monoid (Monoid, mempty, )

import qualified Numeric.NonNegative.Class   as NonNeg
import qualified Numeric.NonNegative.Wrapper as NonNegW
import qualified Numeric.NonNegative.Chunky as NonNegChunky

import qualified Algebra.Transcendental as Trans

import Control.Arrow (Arrow, arr, first, )
import Control.Category (Category, id, (.), )
import qualified Control.Monad.Trans.State.Strict as MS
import Control.Monad.Trans.State
          (State, evalState, runState, state, gets, put, get, )
import Control.Monad (liftM, )
import Data.Traversable (traverse, )
import Data.Foldable (traverse_, )

import Control.DeepSeq (NFData, )

import NumericPrelude.Base hiding (id, (.), )
import NumericPrelude.Numeric
import Prelude ()



{-
ToDo: move to Generic.Signal
-}
replicateLong ::
   (SigG.Write sig y) =>
   StrictTime -> y -> sig y
replicateLong :: forall (sig :: * -> *) y. Write sig y => StrictTime -> y -> sig y
replicateLong StrictTime
tl y
y =
   forall sig. Monoid sig => [sig] -> sig
CutG.concat forall a b. (a -> b) -> a -> b
$
   forall a b. (a -> b) -> [a] -> [b]
map (\ShortStrictTime
t ->
      forall (sig :: * -> *) y.
(Write0 sig, Storage (sig y)) =>
LazySize -> Int -> y -> sig y
SigG.replicate
--         (SigG.LazySize $ fromIntegral $ maxBound::Int)
         LazySize
SigG.defaultLazySize
         (forall a. T a -> a
NonNegW.toNumber ShortStrictTime
t) y
y) forall a b. (a -> b) -> a -> b
$
   StrictTime -> [ShortStrictTime]
PC.chopLongTime StrictTime
tl

{-
ToDo: move to Generic.Signal
-}
{-# INLINE piecewiseConstant #-}
piecewiseConstant ::
   (SigG.Write sig y) =>
   EventListBT.T StrictTime y -> sig y
piecewiseConstant :: forall (sig :: * -> *) y. Write sig y => T StrictTime y -> sig y
piecewiseConstant =
   forall body time a.
(body -> time -> a -> a) -> a -> T time body -> a
EventListBT.foldrPair
      (\y
y StrictTime
t -> forall sig. Monoid sig => sig -> sig -> sig
SigG.append (forall (sig :: * -> *) y. Write sig y => StrictTime -> y -> sig y
replicateLong StrictTime
t y
y))
      forall sig. Monoid sig => sig
SigG.empty

{-# INLINE piecewiseConstantInit #-}
piecewiseConstantInit ::
   (SigG.Write sig y) =>
   y -> EventList.T StrictTime y -> sig y
piecewiseConstantInit :: forall (sig :: * -> *) y.
Write sig y =>
y -> T StrictTime y -> sig y
piecewiseConstantInit y
initial =
   (\ ~(StrictTime
t,sig y
rest) ->
      forall sig. Monoid sig => sig -> sig -> sig
SigG.append (forall (sig :: * -> *) y. Write sig y => StrictTime -> y -> sig y
replicateLong StrictTime
t y
initial) sig y
rest)
   forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
   forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> b -> T time body -> b
EventList.foldr
      (,)
      (\y
y ~(StrictTime
t,sig y
rest) ->
         forall sig. Monoid sig => sig -> sig -> sig
SigG.append (forall (sig :: * -> *) y. Write sig y => StrictTime -> y -> sig y
replicateLong StrictTime
t y
y) sig y
rest)
      (StrictTime
0, forall sig. Monoid sig => sig
SigG.empty)

{-# INLINE piecewiseConstantInitWith #-}
piecewiseConstantInitWith ::
   (SigG.Write sig c) =>
   (y -> c) ->
   c -> EventList.T StrictTime [y] -> sig c
piecewiseConstantInitWith :: forall (sig :: * -> *) c y.
Write sig c =>
(y -> c) -> c -> T StrictTime [y] -> sig c
piecewiseConstantInitWith y -> c
f c
initial =
   forall (sig :: * -> *) y.
Write sig y =>
y -> T StrictTime y -> sig y
piecewiseConstantInit c
initial forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState c
initial forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
   forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\[y]
evs -> forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. y -> c
f) [y]
evs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s. Monad m => StateT s m s
get)



type Instrument y signal = y -> y -> LazyTime -> signal
type Bank y signal = Program -> Instrument y signal

{- |
Instrument parameters are:
velocity from -1 to 1 (0 is the normal pressure, no pressure aka NoteOff is not supported),
frequency is given in Hertz
-}
renderInstrument ::
   (Trans.C y) =>
   Bank y signal ->
   Note ->
   signal
renderInstrument :: forall y signal. C y => Bank y signal -> Note -> signal
renderInstrument Bank y signal
instrument (Note Program
pgm Pitch
pitch Velocity
vel LazyTime
dur) =
   Bank y signal
instrument Program
pgm
      (forall y. C y => Velocity -> y
MV.velocity Velocity
vel)
      (forall y. C y => Pitch -> y
MV.frequencyFromPitch Pitch
pitch)
      LazyTime
dur

renderInstrumentIgnoreProgram ::
   (Trans.C y) =>
   Instrument y signal ->
   Note ->
   signal
renderInstrumentIgnoreProgram :: forall y signal. C y => Instrument y signal -> Note -> signal
renderInstrumentIgnoreProgram Instrument y signal
instrument =
   forall y signal. C y => Bank y signal -> Note -> signal
renderInstrument (forall a b. a -> b -> a
const Instrument y signal
instrument)


{- |
Turn an event list with bundles of elements
into an event list with single events.
ToDo: Move to event-list package?
-}
flatten ::
   (Monoid signal, NonNeg.C time) =>
   EventList.T time [signal] ->
   EventList.T time signal
flatten :: forall signal time.
(Monoid signal, C time) =>
T time [signal] -> T time signal
flatten =
   forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> b -> T time body -> b
EventList.foldr
      forall time body. time -> T time body -> T time body
EventListMB.consTime
      (\[signal]
bt T time signal
xs ->
         forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall body time. body -> T time body -> T time body
EventListMB.consBody forall a b. (a -> b) -> a -> b
$
         case [signal]
bt of
            [] -> (forall sig. Monoid sig => sig
mempty, T time signal
xs)
            signal
b:[signal]
bs -> (signal
b, forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall time body. time -> body -> T time body -> T time body
EventList.cons forall a. C a => a
NonNeg.zero) T time signal
xs [signal]
bs))
      forall time body. T time body
EventList.empty


applyModulation ::
   (CutG.Transform signal, CutG.NormalForm signal) =>
   signal ->
   Modulator (signal -> instr, note) (instr, note)
applyModulation :: forall signal instr note.
(Transform signal, NormalForm signal) =>
signal -> Modulator (signal -> instr, note) (instr, note)
applyModulation signal
ctrl =
   forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (a -> b) -> a -> b
$
   forall note signal state.
state
-> (StrictTime -> State state StrictTime)
-> (note -> State state signal)
-> Modulator note signal
Modulator signal
ctrl forall signal.
(Transform signal, NormalForm signal) =>
StrictTime -> State signal StrictTime
advanceModulationChunk forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets

{- |
We have to evaluate the head value at each 'drop'
in order to avoid growing thunks that lead to a space leak.
-}
evaluateVectorHead ::
   (CutG.NormalForm signal) =>
   signal -> t -> t
evaluateVectorHead :: forall signal t. NormalForm signal => signal -> t -> t
evaluateVectorHead signal
xs t
t =
   case forall sig. NormalForm sig => sig -> ()
CutG.evaluateHead signal
xs of () -> t
t
--   if CutG.null xs then t else t

advanceModulation ::
   (CutG.Transform signal, CutG.NormalForm signal) =>
   LazyTime -> State signal LazyTime
advanceModulation :: forall signal.
(Transform signal, NormalForm signal) =>
LazyTime -> State signal LazyTime
advanceModulation =
   forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. C a => [a] -> T a
NonNegChunky.fromChunks forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
   forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall signal.
(Transform signal, NormalForm signal) =>
StrictTime -> State signal StrictTime
advanceModulationChunk forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
   forall a. T a -> [a]
NonNegChunky.toChunks

advanceModulationChunk ::
   (CutG.Transform signal, CutG.NormalForm signal) =>
   StrictTime -> State signal StrictTime
advanceModulationChunk :: forall signal.
(Transform signal, NormalForm signal) =>
StrictTime -> State signal StrictTime
advanceModulationChunk StrictTime
t = forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ \signal
xs ->
   let ys :: signal
ys = forall sig. Transform sig => Int -> sig -> sig
CutG.drop (forall a b. (C a, C b) => a -> b
fromIntegral StrictTime
t) signal
xs
   in  (forall signal t. NormalForm signal => signal -> t -> t
evaluateVectorHead signal
ys StrictTime
t, signal
ys)

advanceModulationChunkStrict ::
   (CutG.Transform signal, CutG.NormalForm signal) =>
   StrictTime -> MS.State signal StrictTime
advanceModulationChunkStrict :: forall signal.
(Transform signal, NormalForm signal) =>
StrictTime -> State signal StrictTime
advanceModulationChunkStrict StrictTime
t = forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
MS.state forall a b. (a -> b) -> a -> b
$ \signal
xs ->
   let ys :: signal
ys = forall sig. Transform sig => Int -> sig -> sig
CutG.drop (forall a b. (C a, C b) => a -> b
fromIntegral StrictTime
t) signal
xs
   in  (forall signal t. NormalForm signal => signal -> t -> t
evaluateVectorHead signal
ys StrictTime
t, signal
ys)

advanceModulationChunkPC ::
   (NFData body) =>
   StrictTime ->
   State (EventListBT.T StrictTime body) StrictTime
advanceModulationChunkPC :: forall body.
NFData body =>
StrictTime -> State (T StrictTime body) StrictTime
advanceModulationChunkPC StrictTime
t = forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ \T StrictTime body
xs ->
   let ys :: T StrictTime body
ys =
          forall body time. [(body, time)] -> T time body
EventListBT.fromPairList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$
          forall time body. T time body -> [(body, time)]
EventListBT.toPairList T StrictTime body
xs
   in  (forall signal t. NormalForm signal => signal -> t -> t
evaluateVectorHead T StrictTime body
ys StrictTime
t, T StrictTime body
ys)

type FilterSequence event signal =
   Filter event (EventList.T PC.ShortStrictTime signal)

{- |
The state action for the time
should just return the argument time.
However we need this time (or alternatively another result type)
for triggering the 'drop' in 'advanceModulationChunk'.
Without this strict evaluation,
the drop will be delayed until the control curve is actually needed.
-}
data Modulator note signal =
   forall state.
   Modulator
      state
      (StrictTime -> State state StrictTime)
      (note -> State state signal)

instance Category Modulator where
   id :: forall a. Modulator a a
id = forall note signal state.
state
-> (StrictTime -> State state StrictTime)
-> (note -> State state signal)
-> Modulator note signal
Modulator () forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a. Monad m => a -> m a
return
   (Modulator state
yInit StrictTime -> State state StrictTime
yTime b -> State state c
yBody) . :: forall b c a. Modulator b c -> Modulator a b -> Modulator a c
. (Modulator state
xInit StrictTime -> State state StrictTime
xTime a -> State state b
xBody) =
      let compose :: (a -> State b a) -> (p -> State a a) -> p -> StateT (a, b) m a
compose a -> State b a
ym p -> State a a
xm p
r0 =
             forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state forall a b. (a -> b) -> a -> b
$ \(a
xState0,b
yState0) ->
                let (a
r1, a
xState1) = forall s a. State s a -> s -> (a, s)
runState (p -> State a a
xm p
r0) a
xState0
                    (a
r2, b
yState1) = forall s a. State s a -> s -> (a, s)
runState (a -> State b a
ym a
r1) b
yState0
                in  (a
r2, (a
xState1,b
yState1))
      in  forall note signal state.
state
-> (StrictTime -> State state StrictTime)
-> (note -> State state signal)
-> Modulator note signal
Modulator
             (state
xInit,state
yInit)
             (forall {m :: * -> *} {a} {b} {a} {p} {a}.
Monad m =>
(a -> State b a) -> (p -> State a a) -> p -> StateT (a, b) m a
compose StrictTime -> State state StrictTime
yTime StrictTime -> State state StrictTime
xTime)
             (forall {m :: * -> *} {a} {b} {a} {p} {a}.
Monad m =>
(a -> State b a) -> (p -> State a a) -> p -> StateT (a, b) m a
compose b -> State state c
yBody a -> State state b
xBody)

instance Arrow Modulator where
   arr :: forall b c. (b -> c) -> Modulator b c
arr b -> c
f = forall note signal state.
state
-> (StrictTime -> State state StrictTime)
-> (note -> State state signal)
-> Modulator note signal
Modulator () forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> c
f)
   first :: forall b c d. Modulator b c -> Modulator (b, d) (c, d)
first (Modulator state
xInit StrictTime -> State state StrictTime
xTime b -> State state c
xBody) =
      forall note signal state.
state
-> (StrictTime -> State state StrictTime)
-> (note -> State state signal)
-> Modulator note signal
Modulator state
xInit StrictTime -> State state StrictTime
xTime
         (\(b
a0,d
c) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\c
a1 -> (c
a1,d
c)) forall a b. (a -> b) -> a -> b
$ b -> State state c
xBody b
a0)


applyModulator ::
   Modulator a b ->
   EventList.T StrictTime [a] ->
   EventList.T StrictTime [b]
applyModulator :: forall a b. Modulator a b -> T StrictTime [a] -> T StrictTime [b]
applyModulator
      (Modulator state
modulatorInit StrictTime -> State state StrictTime
modulatorTime a -> State state b
modulatorBody) =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState state
modulatorInit forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
   forall (m :: * -> *) time0 time1 body0 body1.
Applicative m =>
(time0 -> m time1)
-> (body0 -> m body1) -> T time0 body0 -> m (T time1 body1)
EventList.traverse StrictTime -> State state StrictTime
modulatorTime (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> State state b
modulatorBody)


{-# INLINE sequenceCore #-}
sequenceCore ::
   (Check.C event, Monoid signal) =>
   Channel ->
   Program ->
   Modulator Note signal ->
   FilterSequence event signal
sequenceCore :: forall event signal.
(C event, Monoid signal) =>
Channel
-> Program -> Modulator Note signal -> FilterSequence event signal
sequenceCore Channel
chan Program
initPgm Modulator Note signal
md =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
EventList.mapTime forall a b. (C a, C b) => a -> b
fromIntegral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
         forall signal time.
(Monoid signal, C time) =>
T time [signal] -> T time signal
flatten forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
         forall a b. Modulator a b -> T StrictTime [a] -> T StrictTime [b]
applyModulator Modulator Note signal
md forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
         T StrictTime [NoteBoundary (Maybe Program)] -> T StrictTime [Note]
matchNoteEvents forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
         Program
-> T StrictTime [Either Program (NoteBoundary Bool)]
-> T StrictTime [NoteBoundary (Maybe Program)]
embedPrograms Program
initPgm) forall a b. (a -> b) -> a -> b
$
   forall event.
C event =>
Channel
-> Filter event (T StrictTime [Either Program (NoteBoundary Bool)])
getNoteEvents Channel
chan


errorNoProgram :: Program
errorNoProgram :: Program
errorNoProgram =
   Int -> Program
ChannelMsg.toProgram Int
0
{-
Since we compute the current program strictly in embedPrograms,
initializing with undefined does no longer work.
   error "MIDI program not initialized"
-}


{-# INLINE sequence #-}
sequence ::
   (Check.C event, Monoid signal, Trans.C y) =>
   Channel ->
   Instrument y signal ->
   FilterSequence event signal
sequence :: forall event signal y.
(C event, Monoid signal, C y) =>
Channel -> Instrument y signal -> FilterSequence event signal
sequence Channel
chan Instrument y signal
instr =
   forall event signal.
(C event, Monoid signal) =>
Channel
-> Program -> Modulator Note signal -> FilterSequence event signal
sequenceCore Channel
chan Program
errorNoProgram
      (forall note signal state.
state
-> (StrictTime -> State state StrictTime)
-> (note -> State state signal)
-> Modulator note signal
Modulator () forall (m :: * -> *) a. Monad m => a -> m a
return
          (forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall y signal. C y => Instrument y signal -> Note -> signal
renderInstrumentIgnoreProgram Instrument y signal
instr))


{-# INLINE sequenceModulated #-}
sequenceModulated ::
   (Check.C event, CutG.Transform ctrl, CutG.NormalForm ctrl,
    Monoid signal, Trans.C y) =>
   ctrl ->
   Channel ->
   (ctrl -> Instrument y signal) ->
   FilterSequence event signal
sequenceModulated :: forall event ctrl signal y.
(C event, Transform ctrl, NormalForm ctrl, Monoid signal, C y) =>
ctrl
-> Channel
-> (ctrl -> Instrument y signal)
-> FilterSequence event signal
sequenceModulated ctrl
ctrl Channel
chan ctrl -> Instrument y signal
instr =
   forall event signal.
(C event, Monoid signal) =>
Channel
-> Program -> Modulator Note signal -> FilterSequence event signal
sequenceCore Channel
chan Program
errorNoProgram
      (forall note signal state.
state
-> (StrictTime -> State state StrictTime)
-> (note -> State state signal)
-> Modulator note signal
Modulator ctrl
ctrl forall signal.
(Transform signal, NormalForm signal) =>
StrictTime -> State signal StrictTime
advanceModulationChunk
          (\Note
note -> forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets forall a b. (a -> b) -> a -> b
$ \ctrl
c -> forall y signal. C y => Instrument y signal -> Note -> signal
renderInstrumentIgnoreProgram (ctrl -> Instrument y signal
instr ctrl
c) Note
note))


{-# INLINE sequenceMultiModulated #-}
sequenceMultiModulated ::
   (Check.C event, Monoid signal, Trans.C y) =>
   Channel ->
   instrument ->
   Modulator (instrument, Note) (Instrument y signal, Note) ->
   FilterSequence event signal
sequenceMultiModulated :: forall event signal y instrument.
(C event, Monoid signal, C y) =>
Channel
-> instrument
-> Modulator (instrument, Note) (Instrument y signal, Note)
-> FilterSequence event signal
sequenceMultiModulated Channel
chan instrument
instr
      (Modulator state
modulatorInit StrictTime -> State state StrictTime
modulatorTime (instrument, Note) -> State state (Instrument y signal, Note)
modulatorBody) =
   forall event signal.
(C event, Monoid signal) =>
Channel
-> Program -> Modulator Note signal -> FilterSequence event signal
sequenceCore Channel
chan Program
errorNoProgram
      (forall note signal state.
state
-> (StrictTime -> State state StrictTime)
-> (note -> State state signal)
-> Modulator note signal
Modulator state
modulatorInit StrictTime -> State state StrictTime
modulatorTime
          (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall y signal. C y => Instrument y signal -> Note -> signal
renderInstrumentIgnoreProgram) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
           (instrument, Note) -> State state (Instrument y signal, Note)
modulatorBody forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
           (,) instrument
instr))

{-# INLINE sequenceMultiProgram #-}
sequenceMultiProgram ::
   (Check.C event, Monoid signal, Trans.C y) =>
   Channel ->
   Program ->
   [Instrument y signal] ->
   FilterSequence event signal
sequenceMultiProgram :: forall event signal y.
(C event, Monoid signal, C y) =>
Channel
-> Program -> [Instrument y signal] -> FilterSequence event signal
sequenceMultiProgram Channel
chan Program
initPgm [Instrument y signal]
instrs =
   let bank :: Array Program (Instrument y signal)
bank = forall instr. [instr] -> Array Program instr
makeInstrumentArray [Instrument y signal]
instrs
   in  forall event signal.
(C event, Monoid signal) =>
Channel
-> Program -> Modulator Note signal -> FilterSequence event signal
sequenceCore Channel
chan Program
initPgm
          (forall note signal state.
state
-> (StrictTime -> State state StrictTime)
-> (note -> State state signal)
-> Modulator note signal
Modulator () forall (m :: * -> *) a. Monad m => a -> m a
return
              (forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall y signal. C y => Bank y signal -> Note -> signal
renderInstrument
                 (forall instr. Array Program instr -> Program -> Program -> instr
getInstrumentFromArray Array Program (Instrument y signal)
bank Program
initPgm)))

{-# INLINE sequenceModulatedMultiProgram #-}
sequenceModulatedMultiProgram ::
   (CutG.Transform ctrl, CutG.NormalForm ctrl,
    Check.C event, Monoid signal, Trans.C y) =>
   ctrl ->
   Channel ->
   Program ->
   [ctrl -> Instrument y signal] ->
   FilterSequence event signal
sequenceModulatedMultiProgram :: forall ctrl event signal y.
(Transform ctrl, NormalForm ctrl, C event, Monoid signal, C y) =>
ctrl
-> Channel
-> Program
-> [ctrl -> Instrument y signal]
-> FilterSequence event signal
sequenceModulatedMultiProgram ctrl
ctrl Channel
chan Program
initPgm [ctrl -> Instrument y signal]
instrs =
   let bank :: Array Program (ctrl -> Instrument y signal)
bank = forall instr. [instr] -> Array Program instr
makeInstrumentArray [ctrl -> Instrument y signal]
instrs
   in  forall event signal.
(C event, Monoid signal) =>
Channel
-> Program -> Modulator Note signal -> FilterSequence event signal
sequenceCore Channel
chan Program
initPgm
          (forall note signal state.
state
-> (StrictTime -> State state StrictTime)
-> (note -> State state signal)
-> Modulator note signal
Modulator
              ctrl
ctrl forall signal.
(Transform signal, NormalForm signal) =>
StrictTime -> State signal StrictTime
advanceModulationChunk
              (\Note
note -> forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets forall a b. (a -> b) -> a -> b
$ \ctrl
c -> forall y signal. C y => Bank y signal -> Note -> signal
renderInstrument
                 (\Program
pgm -> forall instr. Array Program instr -> Program -> Program -> instr
getInstrumentFromArray Array Program (ctrl -> Instrument y signal)
bank Program
initPgm Program
pgm ctrl
c) Note
note))