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

import qualified Sound.MIDI.Message.Class.Check as Check

import qualified Synthesizer.MIDI.PiecewiseConstant as MidiPC
import qualified Synthesizer.MIDI.EventList as MidiEL
import qualified Synthesizer.MIDI.Generic as MidiG
import Synthesizer.MIDI.EventList
          (Channel, Controller, Note(Note), Program, )
import Synthesizer.MIDI.Generic (errorNoProgram, )

import qualified Synthesizer.MIDI.Value as MV
import qualified Synthesizer.MIDI.Dimensional.Value as DMV

import qualified Synthesizer.Dimensional.Causal.Process    as Causal
import qualified Synthesizer.Dimensional.Causal.Filter     as Filt

import qualified Synthesizer.Dimensional.Rate as Rate
import qualified Synthesizer.Dimensional.Rate.Oscillator as OsciR
import qualified Synthesizer.Dimensional.Signal.Private as SigA
import qualified Synthesizer.Dimensional.Process as Proc
import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Dimensional.Amplitude.Displacement as DispA
import qualified Synthesizer.Dimensional.Amplitude.Filter as FiltA
import qualified Synthesizer.Dimensional.Wave as WaveD

import qualified Synthesizer.Basic.Wave          as Wave

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
import qualified Synthesizer.Generic.Signal       as SigG
import qualified Synthesizer.Storable.Cut         as CutSt
import qualified Synthesizer.Storable.Signal      as SigSt
import qualified Data.StorableVector.Lazy         as SVL

import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg

import qualified Data.EventList.Relative.TimeBody  as EventList

import Foreign.Storable (Storable, )

import qualified Number.NonNegative as NonNegW
import qualified Number.NonNegativeChunky as Chunky

import qualified Numeric.NonNegative.Chunky as Chunky98

import qualified Algebra.DimensionTerm as Dim
import qualified Number.DimensionTerm as DN

import qualified Algebra.Transcendental as Trans
import qualified Algebra.Module         as Module
import qualified Algebra.RealField      as RealField
import qualified Algebra.Field          as Field

import Control.Category ((.), )
import Control.Applicative (Applicative, pure, (<*>), liftA2, )
import Control.Monad.Trans.State (State, evalState, state, gets, )
import Control.Monad (liftM, )

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


type Signal s v y signal =
   AmpSignal s (Amp.Dimensional v y) signal

type AmpSignal s amp signal =
   SigA.T (Rate.Phantom s) amp signal

{- |
This type ensures that all signals generated from the event list
share the same sample rate.
-}
newtype Filter event s u t a =
   Filter (MidiEL.Filter event (Proc.T s u t a))

{-# INLINE runFilter #-}
runFilter ::
   Check.C event =>
   EventList.T MidiEL.StrictTime [event] ->
   Filter event s u t a -> Proc.T s u t a
runFilter :: forall event s u t a.
C event =>
T StrictTime [event] -> Filter event s u t a -> T s u t a
runFilter T StrictTime [event]
evs (Filter Filter event (T s u t a)
f) =
   forall s a. State s a -> s -> a
evalState Filter event (T s u t a)
f T StrictTime [event]
evs

instance Functor (Filter event s u t) where
   fmap :: forall a b.
(a -> b) -> Filter event s u t a -> Filter event s u t b
fmap a -> b
f (Filter Filter event (T s u t a)
flt) =
      forall event s u t a.
Filter event (T s u t a) -> Filter event s u t a
Filter (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Filter event (T s u t a)
flt)

instance Applicative (Filter event s u t) where
   pure :: forall a. a -> Filter event s u t a
pure a
x = forall event s u t a.
Filter event (T s u t a) -> Filter event s u t a
Filter (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x))
   Filter Filter event (T s u t (a -> b))
f <*> :: forall a b.
Filter event s u t (a -> b)
-> Filter event s u t a -> Filter event s u t b
<*> Filter Filter event (T s u t a)
x =
      forall event s u t a.
Filter event (T s u t a) -> Filter event s u t a
Filter (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) Filter event (T s u t (a -> b))
f Filter event (T s u t a)
x)


{-# INLINE piecewiseConstant #-}
piecewiseConstant ::
   (SigG.Write sig y) =>
   SigA.T rate amp (MidiPC.T y) ->
   SigA.T rate amp (sig y)
piecewiseConstant :: forall (sig :: * -> *) y rate amp.
Write sig y =>
T rate amp (T y) -> T rate amp (sig y)
piecewiseConstant =
   forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
SigA.processBody forall (sig :: * -> *) y. Write sig y => T StrictTime y -> sig y
MidiG.piecewiseConstant

{-# INLINE controllerLinear #-}
controllerLinear ::
   (Check.C event, Field.C y, Ord y, Dim.C u, Dim.C v) =>
   Channel -> Controller ->
   (DN.T v y, DN.T v y) -> DN.T v y ->
   Filter event s u t (Signal s v y (MidiPC.T y))
controllerLinear :: forall event y u v s t.
(C event, C y, Ord y, C u, C v) =>
Channel
-> Controller
-> (T v y, T v y)
-> T v y
-> Filter event s u t (Signal s v y (T y))
controllerLinear Channel
chan Controller
ctrl (T v y, T v y)
bnd T v y
initial =
   forall event s u t a.
Filter event (T s u t a) -> Filter event s u t a
Filter forall a b. (a -> b) -> a -> b
$
   forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
      (let amp :: T v y
amp = forall a. Ord a => a -> a -> a
max T v y
initial (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Ord a => a -> a -> a
max (T v y, T v y)
bnd)
       in  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 amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody T v y
amp forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
           forall y c. (y -> c) -> c -> T StrictTime [y] -> T c
MidiPC.initWith
              (forall y v. (C y, C v) => T v y -> (T v y, T v y) -> Int -> y
DMV.controllerLinear T v y
amp (T v y, T v y)
bnd) (forall u a. (C u, C a) => T u a -> T u a -> a
DN.divToScalar T v y
initial T v y
amp)) forall a b. (a -> b) -> a -> b
$
   forall event.
C event =>
Channel -> Controller -> Filter event (T StrictTime [Int])
MidiEL.getControllerEvents Channel
chan Controller
ctrl


{-# INLINE controllerExponential #-}
controllerExponential ::
   (Check.C event, Trans.C y, Ord y, Dim.C u, Dim.C v) =>
   Channel -> Controller ->
   (DN.T v y, DN.T v y) -> DN.T v y ->
   Filter event s u t (Signal s v y (MidiPC.T y))
controllerExponential :: forall event y u v s t.
(C event, C y, Ord y, C u, C v) =>
Channel
-> Controller
-> (T v y, T v y)
-> T v y
-> Filter event s u t (Signal s v y (T y))
controllerExponential Channel
chan Controller
ctrl (T v y, T v y)
bnd T v y
initial =
   forall event s u t a.
Filter event (T s u t a) -> Filter event s u t a
Filter forall a b. (a -> b) -> a -> b
$
   forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
      (let amp :: T v y
amp = forall a. Ord a => a -> a -> a
max T v y
initial (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Ord a => a -> a -> a
max (T v y, T v y)
bnd)
       in  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 amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody T v y
amp forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
           forall y c. (y -> c) -> c -> T StrictTime [y] -> T c
MidiPC.initWith
              (forall y v. (C y, C v) => T v y -> (T v y, T v y) -> Int -> y
DMV.controllerExponential T v y
amp (T v y, T v y)
bnd) (forall u a. (C u, C a) => T u a -> T u a -> a
DN.divToScalar T v y
initial T v y
amp)) forall a b. (a -> b) -> a -> b
$
   forall event.
C event =>
Channel -> Controller -> Filter event (T StrictTime [Int])
MidiEL.getControllerEvents Channel
chan Controller
ctrl


{- |
@pitchBend channel range center@:
emits frequencies on an exponential scale from
@center/range@ to @center*range@.
-}
{-# INLINE pitchBend #-}
pitchBend ::
   (Check.C event, Trans.C y, Ord y, Dim.C u, Dim.C v) =>
   Channel ->
   y -> DN.T v y ->
   Filter event s u t (Signal s v y (MidiPC.T y))
pitchBend :: forall event y u v s t.
(C event, C y, Ord y, C u, C v) =>
Channel -> y -> T v y -> Filter event s u t (Signal s v y (T y))
pitchBend Channel
chan y
range T v y
center =
   forall event s u t a.
Filter event (T s u t a) -> Filter event s u t a
Filter forall a b. (a -> b) -> a -> b
$
   forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
      (let amp :: T v y
amp = forall u a. (C u, C a) => a -> T u a -> T u a
DN.scale (forall a. Ord a => a -> a -> a
max y
range (forall a. C a => a -> a
recip y
range)) T v y
center
       in  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 amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody T v y
amp forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
           forall y c. (y -> c) -> c -> T StrictTime [y] -> T c
MidiPC.initWith
              (forall y v. (C y, C v) => T v y -> y -> T v y -> Int -> y
DMV.pitchBend T v y
amp y
range T v y
center) (forall u a. (C u, C a) => T u a -> T u a -> a
DN.divToScalar T v y
center T v y
amp)) forall a b. (a -> b) -> a -> b
$
   forall event a.
(event -> Maybe a) -> Filter event (T StrictTime [a])
MidiEL.getSlice (forall event. C event => Channel -> event -> Maybe Int
Check.pitchBend Channel
chan)
--   MidiEL.getPitchBendEvents chan


{-# INLINE channelPressure #-}
channelPressure ::
   (Check.C event, Trans.C y, Ord y, Dim.C u, Dim.C v) =>
   Channel ->
   DN.T v y -> DN.T v y ->
   Filter event s u t (Signal s v y (MidiPC.T y))
channelPressure :: forall event y u v s t.
(C event, C y, Ord y, C u, C v) =>
Channel
-> T v y -> T v y -> Filter event s u t (Signal s v y (T y))
channelPressure Channel
chan T v y
maxVal T v y
initVal =
   forall event s u t a.
Filter event (T s u t a) -> Filter event s u t a
Filter forall a b. (a -> b) -> a -> b
$
   forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
      (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 amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody T v y
maxVal forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
       forall y c. (y -> c) -> c -> T StrictTime [y] -> T c
MidiPC.initWith
          (forall y v. (C y, C v) => T v y -> (T v y, T v y) -> Int -> y
DMV.controllerLinear T v y
maxVal (forall a. C a => a
zero,T v y
maxVal))
          (forall u a. (C u, C a) => T u a -> T u a -> a
DN.divToScalar T v y
initVal T v y
maxVal)) forall a b. (a -> b) -> a -> b
$
   forall event a.
(event -> Maybe a) -> Filter event (T StrictTime [a])
MidiEL.getSlice (forall event. C event => Channel -> event -> Maybe Int
Check.channelPressure Channel
chan)
--   MidiEL.getPitchBendEvents chan


{-# INLINE bendWheelPressure #-}
bendWheelPressure ::
   (Check.C event,
    SigG.Write sig q, SigG.Transform sig q,
    RealField.C q, Trans.C q, Module.C q q, Dim.C u) =>
   Channel ->
   Int -> DN.T (Dim.Recip u) q -> q -> q ->
   Filter event s u q (Signal s Dim.Scalar q (sig q))
bendWheelPressure :: forall event (sig :: * -> *) q u s.
(C event, Write sig q, Transform sig q, C q, C q, C q q, C u) =>
Channel
-> Int
-> T (Recip u) q
-> q
-> q
-> Filter event s u q (Signal s Scalar q (sig q))
bendWheelPressure Channel
chan
     Int
pitchRange T (Recip u) q
speed q
wheelDepth q
pressDepth =
   forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (\T (Phantom s) (Dimensional Scalar q) (T StrictTime q)
bend T (Phantom s) (Dimensional Scalar q) (T StrictTime q)
fm T (Phantom s) (Dimensional Scalar q) (T StrictTime q)
press  T (Phantom s) (Flat q) (T q)
osci T (Core s)
  (T (Flat q) q, T (Dimensional Scalar q) q)
  (T (Dimensional Scalar q) q)
env ->
         let modu :: T (Phantom s) (Dimensional Scalar q) (T q)
modu =
                forall y u rate.
(C y, C u) =>
T u y
-> T rate (Dimensional u y) (T y) -> T rate (Dimensional u y) (T y)
DispA.raise T Scalar q
1 forall a b. (a -> b) -> a -> b
$
                forall y flat s amp.
(C y flat, C y) =>
T (Phantom s) flat (T y)
-> T (Phantom s) amp (T y) -> T (Phantom s) amp (T y)
FiltA.envelope
                   T (Phantom s) (Flat q) (T q)
osci
                   (forall y yv u s.
(C y, C y, C y yv, C u) =>
R s u y yv -> R s u y yv -> R s u y yv
DispA.mix
                      (forall (sig :: * -> *) yv rate amp.
Read sig yv =>
T rate amp (sig yv) -> T rate amp (T yv)
SigA.restore T (Phantom s) (Dimensional Scalar q) (T StrictTime q)
fm)
                      (forall (sig :: * -> *) yv rate amp.
Read sig yv =>
T rate amp (sig yv) -> T rate amp (T yv)
SigA.restore T (Phantom s) (Dimensional Scalar q) (T StrictTime q)
press))

         in  forall (sig :: * -> *) yv0 yv1 s amp0 amp1.
(Transform sig yv0, Transform sig yv1) =>
Single s amp0 amp1 yv0 yv1
-> T (Phantom s) amp0 (sig yv0) -> T (Phantom s) amp1 (sig yv1)
Causal.apply
                (T (Core s)
  (T (Flat q) q, T (Dimensional Scalar q) q)
  (T (Dimensional Scalar q) q)
env forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (sig :: * -> *) yv s amp restSample.
Read sig yv =>
T (Phantom s) amp (sig yv) -> T s restSample (restSample, T amp yv)
Causal.feedSnd T (Phantom s) (Dimensional Scalar q) (T q)
modu forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall y flat s. C y flat => Single s flat (Flat y) y y
Causal.canonicalizeFlat)
                (forall (sig :: * -> *) y rate amp.
Write sig y =>
T rate amp (T y) -> T rate amp (sig y)
piecewiseConstant T (Phantom s) (Dimensional Scalar q) (T StrictTime q)
bend))

    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
$: forall event y u v s t.
(C event, C y, Ord y, C u, C v) =>
Channel -> y -> T v y -> Filter event s u t (Signal s v y (T y))
pitchBend Channel
chan (q
2forall a. C a => a -> a -> a
^?(forall a b. (C a, C b) => a -> b
fromIntegral Int
pitchRangeforall a. C a => a -> a -> a
/q
12)) (forall a. a -> Scalar a
DN.scalar q
1)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
$: forall event y u v s t.
(C event, C y, Ord y, C u, C v) =>
Channel
-> Controller
-> (T v y, T v y)
-> T v y
-> Filter event s u t (Signal s v y (T y))
controllerLinear Channel
chan Controller
VoiceMsg.modulation (forall a. C a => a
zero, forall a. a -> Scalar a
DN.scalar q
wheelDepth) forall a. C a => a
zero
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
$: forall event y u v s t.
(C event, C y, Ord y, C u, C v) =>
Channel
-> T v y -> T v y -> Filter event s u t (Signal s v y (T y))
channelPressure Channel
chan (forall a. a -> Scalar a
DN.scalar q
pressDepth) T Scalar q
0

    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
$: forall event s u t a.
Filter event (T s u t a) -> Filter event s u t a
Filter (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall t u amp y s.
(C t, C u) =>
T t (T amp y) -> T t -> T (Recip u) t -> T s u t (Signal s amp y)
OsciR.static (forall y t. C y => T t y -> T t (Flat y)
WaveD.flat forall a. C a => T a a
Wave.sine) forall a. C a => a
zero T (Recip u) q
speed)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
$: forall event s u t a.
Filter event (T s u t a) -> Filter event s u t a
Filter (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall y s u t amp.
C y =>
T s u t (T s (Flat y, Numeric amp y) (Numeric amp y))
Filt.envelope)


type LazyTime s = SigA.T (Rate.Phantom s) Amp.Abstract ChunkySize.T
-- type LazyTime s = SigA.T (Rate.Phantom s) Amp.Abstract SigStV.LazySize
-- type LazyTime s = SigA.T (Rate.Phantom s) Amp.Abstract MidiEL.LazyTime

type Instrument s u v q signal =
   ModulatedInstrument s u q (Signal s v q signal)

type ModulatedInstrument s u q signal =
   q -> DN.T (Dim.Recip u) q ->
   Proc.T s u q (LazyTime s -> signal)

type Bank s u q signal =
   Program -> ModulatedInstrument s u q signal


{-# INLINE chunkySizeFromLazyTime #-}
chunkySizeFromLazyTime :: MidiEL.LazyTime -> ChunkySize.T
chunkySizeFromLazyTime :: LazyTime -> T
chunkySizeFromLazyTime =
   forall a. C a => [a] -> T a
Chunky.fromChunks 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. (a -> b) -> [a] -> [b]
map (Int -> LazySize
SigG.LazySize 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
NonNegW.toNumber) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
   forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap StrictTime -> [T Int]
PC.chopLongTime 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]
Chunky98.toChunks forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
   forall a. C a => T a -> T a
Chunky98.normalize


{-# INLINE renderInstrument #-}
renderInstrument ::
   (Trans.C q) =>
   Bank s Dim.Time q signal ->
   Note ->
   Proc.T s Dim.Time q signal
renderInstrument :: forall q s signal.
C q =>
Bank s Time q signal -> Note -> T s Time q signal
renderInstrument Bank s Time q signal
instrument (Note Program
pgm Pitch
pitch Velocity
vel LazyTime
dur) =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ forall sig s. sig -> T (Phantom s) Abstract sig
SigA.abstractFromBody forall a b. (a -> b) -> a -> b
$ LazyTime -> T
chunkySizeFromLazyTime LazyTime
dur) forall a b. (a -> b) -> a -> b
$
   Bank s Time q signal
instrument Program
pgm
      (forall y. C y => Velocity -> y
MV.velocity Velocity
vel)
      (forall y. C y => Pitch -> Frequency y
DMV.frequencyFromPitch Pitch
pitch)

{- |
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
-}
{-# INLINE makeInstrumentSounds #-}
makeInstrumentSounds ::
   (Trans.C q) =>
   Bank s Dim.Time q signal ->
   EventList.T time [Note] ->
   Proc.T s Dim.Time q (EventList.T time [signal])
makeInstrumentSounds :: forall q s signal time.
C q =>
Bank s Time q signal
-> T time [Note] -> T s Time q (T time [signal])
makeInstrumentSounds Bank s Time q signal
bank =
   forall (m :: * -> *) body0 body1 time.
Monad m =>
(body0 -> m body1) -> T time body0 -> m (T time body1)
EventList.mapBodyM (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall q s signal.
C q =>
Bank s Time q signal -> Note -> T s Time q signal
renderInstrument Bank s Time q signal
bank))


{-# INLINE sequence #-}
sequence ::
   (Check.C event, RealFrac q, Storable y, Module.C q y, Trans.C q, Dim.C v) =>
   SVL.ChunkSize ->
   DN.T v q ->
   Channel ->
   Instrument s Dim.Time v q (SigSt.T y) ->
   Filter event s Dim.Time q (Signal s v q (SigSt.T y))
sequence :: forall event q y v s.
(C event, RealFrac q, Storable y, C q y, C q, C v) =>
ChunkSize
-> T v q
-> Channel
-> Instrument s Time v q (T y)
-> Filter event s Time q (Signal s v q (T y))
sequence ChunkSize
chunkSize T v q
amp Channel
chan Instrument s Time v q (T y)
instr =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall y q u s.
(Storable y, C q y, C u, C q) =>
ChunkSize
-> T u q -> T StrictTime [Signal s u q (T y)] -> Signal s u q (T y)
renderSequence ChunkSize
chunkSize T v q
amp) forall a b. (a -> b) -> a -> b
$
   forall event q s signal.
(C event, RealFrac q, C q) =>
Channel
-> Program
-> Bank s Time q signal
-> Filter event s Time q (T StrictTime [signal])
prepareTones Channel
chan Program
errorNoProgram (forall a b. a -> b -> a
const Instrument s Time v q (T y)
instr)

{-
{-# INLINE sequence #-}
sequence ::
   (Check.C event,
    RealFrac q, Storable y, Module.C q y, Trans.C q, Dim.C v) =>
   SVL.ChunkSize ->
   DN.T v q ->
   Channel ->
   Instrument s Dim.Time v q y ->
   Filter event (Proc.T s Dim.Time q (Signal s v q (SigSt.T y)))
sequence chunkSize amp chan instr =
   fmap ((CutA.arrangeStorableVolume undefined  {- chunkSize -} amp undefined $:) .
         fmap
            (EventListTM.switchTimeR const .
             EventListTT.mapTime fromIntegral .
             insertBreaksGen (SigA.fromBody amp SigSt.empty)) .
         makeInstrumentSounds instr .
         MidiEL.matchNoteEvents) $
   MidiEL.getNoteEvents chan
-}


{-# INLINE sequenceModulated #-}
sequenceModulated ::
   (Check.C event,
    CutG.Transform ctrl,  CutG.NormalForm ctrl,
    RealFrac q, Storable y,
    Module.C q y, Trans.C q, Dim.C v) =>
   SVL.ChunkSize ->
   DN.T v q ->
   Channel ->
   ModulatedInstrument s Dim.Time q
      (AmpSignal s amp ctrl -> Signal s v q (SigSt.T y)) ->
   Filter event s Dim.Time q
      (AmpSignal s amp ctrl -> Signal s v q (SigSt.T y))
sequenceModulated :: forall event ctrl q y v s amp.
(C event, Transform ctrl, NormalForm ctrl, RealFrac q, Storable y,
 C q y, C q, C v) =>
ChunkSize
-> T v q
-> Channel
-> ModulatedInstrument
     s Time q (AmpSignal s amp ctrl -> Signal s v q (T y))
-> Filter
     event s Time q (AmpSignal s amp ctrl -> Signal s v q (T y))
sequenceModulated ChunkSize
chunkSize T v q
amp Channel
chan ModulatedInstrument
  s Time q (AmpSignal s amp ctrl -> Signal s v q (T y))
instr =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ \AmpSignal s amp ctrl
ctrl ->
      forall y q u s.
(Storable y, C q y, C u, C q) =>
ChunkSize
-> T u q -> T StrictTime [Signal s u q (T y)] -> Signal s u q (T y)
renderSequence ChunkSize
chunkSize T v q
amp 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 (forall signal s amp body.
(Transform signal, NormalForm signal) =>
AmpSignal s amp signal
-> Modulator (AmpSignal s amp signal -> body) body
applyModulation AmpSignal s amp ctrl
ctrl)) forall a b. (a -> b) -> a -> b
$
   forall event q s signal.
(C event, RealFrac q, C q) =>
Channel
-> Program
-> Bank s Time q signal
-> Filter event s Time q (T StrictTime [signal])
prepareTones Channel
chan Program
errorNoProgram (forall a b. a -> b -> a
const ModulatedInstrument
  s Time q (AmpSignal s amp ctrl -> Signal s v q (T y))
instr)

{-# INLINE sequenceModulated2 #-}
sequenceModulated2 ::
   (Check.C event,
    CutG.Transform ctrl0, CutG.NormalForm ctrl0,
    CutG.Transform ctrl1, CutG.NormalForm ctrl1,
    RealFrac q, Storable y,
    Module.C q y, Trans.C q, Dim.C v) =>
   SVL.ChunkSize ->
   DN.T v q ->
   Channel ->
   ModulatedInstrument s Dim.Time q
      (AmpSignal s amp0 ctrl0 -> AmpSignal s amp1 ctrl1 -> Signal s v q (SigSt.T y)) ->
   Filter event s Dim.Time q
      (AmpSignal s amp0 ctrl0 -> AmpSignal s amp1 ctrl1 -> Signal s v q (SigSt.T y))
sequenceModulated2 :: forall event ctrl0 ctrl1 q y v s amp0 amp1.
(C event, Transform ctrl0, NormalForm ctrl0, Transform ctrl1,
 NormalForm ctrl1, RealFrac q, Storable y, C q y, C q, C v) =>
ChunkSize
-> T v q
-> Channel
-> ModulatedInstrument
     s
     Time
     q
     (AmpSignal s amp0 ctrl0
      -> AmpSignal s amp1 ctrl1 -> Signal s v q (T y))
-> Filter
     event
     s
     Time
     q
     (AmpSignal s amp0 ctrl0
      -> AmpSignal s amp1 ctrl1 -> Signal s v q (T y))
sequenceModulated2 ChunkSize
chunkSize T v q
amp Channel
chan ModulatedInstrument
  s
  Time
  q
  (AmpSignal s amp0 ctrl0
   -> AmpSignal s amp1 ctrl1 -> Signal s v q (T y))
instr =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\T StrictTime
  [AmpSignal s amp0 ctrl0
   -> AmpSignal s amp1 ctrl1 -> Signal s v q (T y)]
evs AmpSignal s amp0 ctrl0
ctrl0 AmpSignal s amp1 ctrl1
ctrl1 ->
      forall y q u s.
(Storable y, C q y, C u, C q) =>
ChunkSize
-> T u q -> T StrictTime [Signal s u q (T y)] -> Signal s u q (T y)
renderSequence ChunkSize
chunkSize T v q
amp 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
         (forall signal s amp body.
(Transform signal, NormalForm signal) =>
AmpSignal s amp signal
-> Modulator (AmpSignal s amp signal -> body) body
applyModulation AmpSignal s amp1 ctrl1
ctrl1 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
          forall signal s amp body.
(Transform signal, NormalForm signal) =>
AmpSignal s amp signal
-> Modulator (AmpSignal s amp signal -> body) body
applyModulation AmpSignal s amp0 ctrl0
ctrl0)
      forall a b. (a -> b) -> a -> b
$ T StrictTime
  [AmpSignal s amp0 ctrl0
   -> AmpSignal s amp1 ctrl1 -> Signal s v q (T y)]
evs) forall a b. (a -> b) -> a -> b
$
   forall event q s signal.
(C event, RealFrac q, C q) =>
Channel
-> Program
-> Bank s Time q signal
-> Filter event s Time q (T StrictTime [signal])
prepareTones Channel
chan Program
errorNoProgram (forall a b. a -> b -> a
const ModulatedInstrument
  s
  Time
  q
  (AmpSignal s amp0 ctrl0
   -> AmpSignal s amp1 ctrl1 -> Signal s v q (T y))
instr)


{-# INLINE sequenceMultiModulated #-}
sequenceMultiModulated ::
   (Check.C event, RealFrac q, Storable y,
    Module.C q y, Trans.C q, Dim.C v) =>
   SVL.ChunkSize ->
   DN.T v q ->
   Channel ->
   ModulatedInstrument s Dim.Time q instrument ->
   Filter event s Dim.Time q
      (MidiG.Modulator instrument (Signal s v q (SigSt.T y))) ->
   Filter event s Dim.Time q (Signal s v q (SigSt.T y))
sequenceMultiModulated :: forall event q y v s instrument.
(C event, RealFrac q, Storable y, C q y, C q, C v) =>
ChunkSize
-> T v q
-> Channel
-> ModulatedInstrument s Time q instrument
-> Filter
     event s Time q (Modulator instrument (Signal s v q (T y)))
-> Filter event s Time q (Signal s v q (T y))
sequenceMultiModulated ChunkSize
chunkSize T v q
amp Channel
chan ModulatedInstrument s Time q instrument
instr Filter event s Time q (Modulator instrument (Signal s v q (T y)))
modu =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall y q u s.
(Storable y, C q y, C u, C q) =>
ChunkSize
-> T u q -> T StrictTime [Signal s u q (T y)] -> Signal s u q (T y)
renderSequence ChunkSize
chunkSize T v q
amp) forall a b. (a -> b) -> a -> b
$
   (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Modulator a b -> T StrictTime [a] -> T StrictTime [b]
applyModulator Filter event s Time q (Modulator instrument (Signal s v q (T y)))
modu forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
$:
    forall event q s signal.
(C event, RealFrac q, C q) =>
Channel
-> Program
-> Bank s Time q signal
-> Filter event s Time q (T StrictTime [signal])
prepareTones Channel
chan Program
errorNoProgram (forall a b. a -> b -> a
const ModulatedInstrument s Time q instrument
instr))

{-# INLINE prepareTones #-}
prepareTones ::
   (Check.C event, RealFrac q, Trans.C q) =>
   -- ToDo: use time value
   Channel ->
   Program ->
   Bank s Dim.Time q signal ->
   Filter event s Dim.Time q (EventList.T MidiEL.StrictTime [signal])
prepareTones :: forall event q s signal.
(C event, RealFrac q, C q) =>
Channel
-> Program
-> Bank s Time q signal
-> Filter event s Time q (T StrictTime [signal])
prepareTones Channel
chan Program
initPgm Bank s Time q signal
instr =
   forall event s u t a.
Filter event (T s u t a) -> Filter event s u t a
Filter forall a b. (a -> b) -> a -> b
$
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall q s signal time.
C q =>
Bank s Time q signal
-> T time [Note] -> T s Time q (T time [signal])
makeInstrumentSounds Bank s Time q signal
instr 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]
MidiEL.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)]
MidiEL.embedPrograms Program
initPgm) forall a b. (a -> b) -> a -> b
$
   forall event.
C event =>
Channel
-> Filter event (T StrictTime [Either Program (NoteBoundary Bool)])
MidiEL.getNoteEvents Channel
chan

{-# INLINE applyModulation #-}
applyModulation ::
   (CutG.Transform signal, CutG.NormalForm signal) =>
   AmpSignal s amp signal ->
   MidiG.Modulator (AmpSignal s amp signal -> body) body
applyModulation :: forall signal s amp body.
(Transform signal, NormalForm signal) =>
AmpSignal s amp signal
-> Modulator (AmpSignal s amp signal -> body) body
applyModulation AmpSignal s amp signal
ctrl =
   forall note signal state.
state
-> (StrictTime -> State state StrictTime)
-> (note -> State state signal)
-> Modulator note signal
MidiG.Modulator AmpSignal s amp signal
ctrl forall signal s amp.
(Transform signal, NormalForm signal) =>
StrictTime -> State (AmpSignal s amp signal) StrictTime
advanceModulationChunk forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets

{-# INLINE applyModulator #-}
applyModulator ::
   MidiG.Modulator a b ->
   EventList.T MidiEL.StrictTime [a] ->
   EventList.T MidiEL.StrictTime [b]
applyModulator :: forall a b. Modulator a b -> T StrictTime [a] -> T StrictTime [b]
applyModulator =
   forall a b. Modulator a b -> T StrictTime [a] -> T StrictTime [b]
MidiG.applyModulator

{-# INLINE renderSequence #-}
renderSequence ::
   (Storable y, Module.C q y, Dim.C u, Field.C q) =>
   SVL.ChunkSize ->
   DN.T u q ->
   EventList.T MidiEL.StrictTime [Signal s u q (SigSt.T y)] ->
   Signal s u q (SigSt.T y)
renderSequence :: forall y q u s.
(Storable y, C q y, C u, C q) =>
ChunkSize
-> T u q -> T StrictTime [Signal s u q (T y)] -> Signal s u q (T y)
renderSequence ChunkSize
chunkSize T u q
amp =
   forall amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody T u q
amp forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
   forall v. (Storable v, C v) => ChunkSize -> T (T Int) (T v) -> T v
CutSt.arrangeEquidist ChunkSize
chunkSize forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
   {- This concatenates times across empty events,
      and thus is too strict.
   EventList.flatten .
   -}
   forall signal time.
(Monoid signal, C time) =>
T time [signal] -> T time signal
MidiG.flatten forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
   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 body0 body1 time.
(body0 -> body1) -> T time body0 -> T time body1
EventList.mapBody (forall a b. (a -> b) -> [a] -> [b]
map (forall y yv (sig :: * -> *) amp rate.
(C y yv, Transform sig yv) =>
(amp -> y) -> T rate (Numeric amp) (sig yv) -> sig yv
SigA.vectorSamples (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall u a. (C u, C a) => T u a -> T u a -> a
DN.divToScalar T u q
amp)))


{-# INLINE advanceModulationChunky #-}
advanceModulationChunky ::
   (CutG.Transform signal, CutG.NormalForm signal) =>
   MidiEL.LazyTime -> State (AmpSignal s amp signal) MidiEL.LazyTime
advanceModulationChunky :: forall signal s amp.
(Transform signal, NormalForm signal) =>
LazyTime -> State (AmpSignal s amp signal) LazyTime
advanceModulationChunky =
   forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. C a => [a] -> T a
Chunky98.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 s amp.
(Transform signal, NormalForm signal) =>
StrictTime -> State (AmpSignal s amp 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]
Chunky98.toChunks

{-# INLINE advanceModulationChunk #-}
advanceModulationChunk ::
   (CutG.Transform signal, CutG.NormalForm signal) =>
   MidiEL.StrictTime -> State (AmpSignal s amp signal) MidiEL.StrictTime
advanceModulationChunk :: forall signal s amp.
(Transform signal, NormalForm signal) =>
StrictTime -> State (AmpSignal s amp 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
$ \AmpSignal s amp signal
xs ->
   let ys :: AmpSignal s amp signal
ys = forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
SigA.processBody (forall sig. Transform sig => Int -> sig -> sig
CutG.drop (forall a b. (C a, C b) => a -> b
fromIntegral StrictTime
t)) AmpSignal s amp signal
xs
   in  (forall signal t. NormalForm signal => signal -> t -> t
MidiG.evaluateVectorHead (forall rate amplitude body. T rate amplitude body -> body
SigA.body AmpSignal s amp signal
ys) StrictTime
t, AmpSignal s amp signal
ys)


{-# INLINE sequenceMultiProgram #-}
sequenceMultiProgram ::
   (Check.C event, RealFrac q, Storable y, Module.C q y, Trans.C q, Dim.C v) =>
   SVL.ChunkSize ->
   DN.T v q ->
   Channel ->
   Program ->
--   Bank s Dim.Time q (Signal s v q (SigSt.T y)) ->
   [Instrument s Dim.Time v q (SigSt.T y)] ->
   Filter event s Dim.Time q (Signal s v q (SigSt.T y))
sequenceMultiProgram :: forall event q y v s.
(C event, RealFrac q, Storable y, C q y, C q, C v) =>
ChunkSize
-> T v q
-> Channel
-> Program
-> [Instrument s Time v q (T y)]
-> Filter event s Time q (Signal s v q (T y))
sequenceMultiProgram ChunkSize
chunkSize T v q
amp Channel
chan Program
initPgm [Instrument s Time v q (T y)]
instrs =
   let bank :: Array Program (Instrument s Time v q (T y))
bank = forall instr. [instr] -> Array Program instr
MidiEL.makeInstrumentArray [Instrument s Time v q (T y)]
instrs
   in  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall y q u s.
(Storable y, C q y, C u, C q) =>
ChunkSize
-> T u q -> T StrictTime [Signal s u q (T y)] -> Signal s u q (T y)
renderSequence ChunkSize
chunkSize T v q
amp) forall a b. (a -> b) -> a -> b
$
       forall event q s signal.
(C event, RealFrac q, C q) =>
Channel
-> Program
-> Bank s Time q signal
-> Filter event s Time q (T StrictTime [signal])
prepareTones Channel
chan Program
initPgm forall a b. (a -> b) -> a -> b
$
       forall instr. Array Program instr -> Program -> Program -> instr
MidiEL.getInstrumentFromArray Array Program (Instrument s Time v q (T y))
bank Program
initPgm