{-# 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
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
{-# 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)
{-# 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)
{-# 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 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)
{-# 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 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) =>
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
.
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 ->
[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