{-
A set of example instruments to be used in MIDI rendering.

Shall we make the sample rate a parameter
or shall we leave these examples at a low level?
Sample-rate-aware instruments can be found in
"Synthesizer.MIDI.Dimensional.Example.Instrument"
-}
module Synthesizer.MIDI.Example.Instrument where

import Synthesizer.MIDI.Storable (
   Instrument, chunkSizesFromLazyTime, )

import Synthesizer.MIDI.EventList (LazyTime, )

import qualified Synthesizer.MIDI.CausalIO.Process as MIO
import qualified Synthesizer.CausalIO.Gate as Gate
import qualified Synthesizer.CausalIO.Process as PIO

import qualified Synthesizer.Basic.Wave          as Wave
import qualified Synthesizer.Frame.Stereo        as Stereo

import qualified Synthesizer.Causal.Process as Causal
import qualified Synthesizer.Causal.Oscillator as OsciC
import qualified Synthesizer.Causal.Interpolation as Interpolation
import qualified Synthesizer.Causal.Filter.Recursive.Integration as IntegC
import qualified Synthesizer.Causal.Filter.NonRecursive as FiltNRC
import qualified Synthesizer.Interpolation.Module as Ip
import Control.Arrow ((<<<), (^<<), (<<^), (***), )

import qualified Synthesizer.Storable.Filter.NonRecursive as FiltNRSt
import qualified Synthesizer.Storable.Signal      as SigSt
import qualified Data.StorableVector.Lazy.Pattern as SigStV
import qualified Data.StorableVector.Lazy         as SVL
import qualified Data.StorableVector              as SV

import qualified Synthesizer.Generic.Wave      as WaveG
import qualified Synthesizer.State.Signal      as SigS
import qualified Synthesizer.State.Control     as CtrlS
import qualified Synthesizer.State.Noise       as NoiseS
import qualified Synthesizer.State.Oscillator  as OsciS
import qualified Synthesizer.State.Displacement as DispS
import qualified Synthesizer.State.Filter.NonRecursive as FiltNRS
import qualified Synthesizer.Plain.Filter.Recursive    as FiltR
import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter
-- import qualified Synthesizer.Generic.Filter.NonRecursive as FiltG
-- import qualified Synthesizer.Basic.Phase       as Phase

import qualified Sound.Sox.Read          as SoxRead
import qualified Sound.Sox.Option.Format as SoxOption

import Control.Monad.Trans.State (get, modify, )
import Control.Monad (mzero, )
import Control.Category ((.), )

import qualified Algebra.Ring as Ring

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



type Real = Float

sampleRate :: Ring.C a => a
sampleRate :: forall a. C a => a
sampleRate = forall a. C a => Integer -> a
fromInteger Integer
44100

chunkSize :: SVL.ChunkSize
chunkSize :: ChunkSize
chunkSize = Int -> ChunkSize
SVL.chunkSize Int
512


{-# INLINE amplitudeFromVelocity #-}
amplitudeFromVelocity :: Real -> Real
amplitudeFromVelocity :: Real -> Real
amplitudeFromVelocity Real
vel = Real
4forall a. C a => a -> a -> a
**Real
vel

{-# INLINE ping #-}
ping :: Real -> Real -> SigSt.T Real
ping :: Real -> Real -> T Real
ping Real
vel Real
freq =
   forall a. Storable a => ChunkSize -> T a -> T a
SigS.toStorableSignal ChunkSize
chunkSize forall a b. (a -> b) -> a -> b
$
   forall a. C a => T a -> T a -> T a
FiltNRS.envelope (forall a. C a => a -> a -> T a
CtrlS.exponential2 (Real
0.2forall a. C a => a -> a -> a
*forall a. C a => a
sampleRate) (Real -> Real
amplitudeFromVelocity Real
vel)) forall a b. (a -> b) -> a -> b
$
   forall a b. C a => T a b -> T a -> a -> T b
OsciS.static forall a. C a => T a a
Wave.saw forall a. C a => a
zero (Real
freqforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate)

pingDur :: Instrument Real Real
pingDur :: Instrument Real Real
pingDur Real
vel Real
freq LazyTime
dur =
   forall a. Storable a => LazySize -> Vector a -> Vector a
SigStV.take (LazyTime -> LazySize
chunkSizesFromLazyTime LazyTime
dur) forall a b. (a -> b) -> a -> b
$
   Real -> Real -> T Real
ping Real
vel Real
freq

pingCausal :: MIO.Instrument Real (SV.Vector Real)
pingCausal :: Instrument Real (Vector Real)
pingCausal Real
vel Real
freq =
   (forall b a. Monoid b => T a b -> T a b
PIO.fromCausal forall a b. (a -> b) -> a -> b
$
    forall a b.
(Storable a, Storable b) =>
T a b -> T (Vector a) (Vector b)
Causal.applyStorableChunk forall a b. (a -> b) -> a -> b
$
    forall (sig :: * -> *) a. Read sig a => sig a -> T () a
Causal.feed forall a b. (a -> b) -> a -> b
$
    forall a. C a => T a -> T a -> T a
FiltNRS.envelope
       (forall a. C a => a -> a -> T a
CtrlS.exponential2 (Real
0.2forall a. C a => a -> a -> a
*forall a. C a => a
sampleRate) (Real -> Real
amplitudeFromVelocity Real
vel)) forall a b. (a -> b) -> a -> b
$
    forall a b. C a => T a b -> T a -> a -> T b
OsciS.static forall a. C a => T a a
Wave.saw forall a. C a => a
zero (Real
freqforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate))
   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 (Chunk a) (Vector ())
Gate.toStorableVector

pingReleaseEnvelope :: Real -> LazyTime -> SigSt.T Real
pingReleaseEnvelope :: Real -> LazyTime -> T Real
pingReleaseEnvelope Real
vel LazyTime
dur =
   forall a b.
Storable a =>
b -> (Vector a -> a -> b) -> Vector a -> b
SigSt.switchR forall a. Storable a => Vector a
SigSt.empty
      (\T Real
body Real
x ->
          forall a. Storable a => Vector a -> Vector a -> Vector a
SigSt.append T Real
body forall a b. (a -> b) -> a -> b
$
          forall a. Storable a => ChunkSize -> T a -> T a
SigS.toStorableSignal ChunkSize
chunkSize forall a b. (a -> b) -> a -> b
$
          forall a. Int -> T a -> T a
SigS.take (forall a b. (C a, C b) => a -> b
round (Real
0.3forall a. C a => a -> a -> a
*forall a. C a => a
sampleRate :: Real)) forall a b. (a -> b) -> a -> b
$
          forall a. C a => a -> a -> T a
CtrlS.exponential2 (Real
0.1forall a. C a => a -> a -> a
*forall a. C a => a
sampleRate) Real
x) forall a b. (a -> b) -> a -> b
$
   forall a. Storable a => LazySize -> T a -> T a
SigS.toStorableSignalVary (LazyTime -> LazySize
chunkSizesFromLazyTime LazyTime
dur) forall a b. (a -> b) -> a -> b
$
   forall a. C a => a -> a -> T a
CtrlS.exponential2 (Real
0.4forall a. C a => a -> a -> a
*forall a. C a => a
sampleRate) (Real -> Real
amplitudeFromVelocity Real
vel)

pingRelease :: Instrument Real Real
pingRelease :: Instrument Real Real
pingRelease Real
vel Real
freq LazyTime
dur =
   forall b c a.
(Storable b, Storable c) =>
(a -> b -> c) -> T a -> T b -> T c
SigS.zipWithStorable forall a. C a => a -> a -> a
(*)
      (forall a b. C a => T a b -> T a -> a -> T b
OsciS.static forall a. C a => T a a
Wave.saw forall a. C a => a
zero (Real
freqforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate))
      (Real -> LazyTime -> T Real
pingReleaseEnvelope Real
vel LazyTime
dur)

pingStereoRelease :: Instrument Real (Stereo.T Real)
pingStereoRelease :: Instrument Real (T Real)
pingStereoRelease Real
vel Real
freq LazyTime
dur =
--   SigS.zipWithStorable (\y c -> fmap (c*) y)
   forall b c a.
(Storable b, Storable c) =>
(a -> b -> c) -> T a -> T b -> T c
SigS.zipWithStorable (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a v. C a v => a -> v -> v
(*>))
      (forall a b c. (a -> b -> c) -> T a -> T b -> T c
SigS.zipWith forall a. a -> a -> T a
Stereo.cons
         (forall a b. C a => T a b -> T a -> a -> T b
OsciS.static forall a. C a => T a a
Wave.saw forall a. C a => a
zero (Real
freqforall a. C a => a -> a -> a
*Real
0.999forall a. C a => a -> a -> a
/forall a. C a => a
sampleRate))
         (forall a b. C a => T a b -> T a -> a -> T b
OsciS.static forall a. C a => T a a
Wave.saw forall a. C a => a
zero (Real
freqforall a. C a => a -> a -> a
*Real
1.001forall a. C a => a -> a -> a
/forall a. C a => a
sampleRate)))
      (Real -> LazyTime -> T Real
pingReleaseEnvelope Real
vel LazyTime
dur)

pingReleaseEnvelopeCausal :: Real -> PIO.T MIO.GateChunk (SV.Vector Real)
pingReleaseEnvelopeCausal :: Real -> T GateChunk (Vector Real)
pingReleaseEnvelopeCausal Real
vel =
   forall a (sig :: * -> *) b.
(Transform a, Transform sig b) =>
T a (sig b) -> (b -> T a (sig b)) -> T a (sig b)
PIO.continue
      ((forall b a. Monoid b => T a b -> T a b
PIO.fromCausal forall a b. (a -> b) -> a -> b
$
        forall a b.
(Storable a, Storable b) =>
T a b -> T (Vector a) (Vector b)
Causal.applyStorableChunk forall a b. (a -> b) -> a -> b
$ forall (sig :: * -> *) a. Read sig a => sig a -> T () a
Causal.feed forall a b. (a -> b) -> a -> b
$
        forall a. C a => a -> a -> T a
CtrlS.exponential2 (Real
0.4forall a. C a => a -> a -> a
*forall a. C a => a
sampleRate) (Real -> Real
amplitudeFromVelocity Real
vel))
       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 (Chunk a) (Vector ())
Gate.toStorableVector
       {-
       <<<
       arr (\x -> trace (show x) x) -})
      (\Real
y -> -- trace ("continue with " ++ show y) $
         (forall b a. Monoid b => T a b -> T a b
PIO.fromCausal forall a b. (a -> b) -> a -> b
$
          forall a b.
(Storable a, Storable b) =>
T a b -> T (Vector a) (Vector b)
Causal.applyStorableChunk forall a b. (a -> b) -> a -> b
$ forall (sig :: * -> *) a. Read sig a => sig a -> T () a
Causal.feed forall a b. (a -> b) -> a -> b
$
          forall a. Int -> T a -> T a
SigS.take (forall a b. (C a, C b) => a -> b
round (Real
1forall a. C a => a -> a -> a
*forall a. C a => a
sampleRate :: Real)) forall a b. (a -> b) -> a -> b
$
          forall a. C a => a -> a -> T a
CtrlS.exponential2 (Real
0.1forall a. C a => a -> a -> a
*forall a. C a => a
sampleRate) Real
y)
         forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
         forall (arrow :: * -> * -> *) a.
Arrow arrow =>
arrow (Chunk a) (Vector ())
Gate.allToStorableVector)

pingReleaseCausal :: MIO.Instrument Real (SV.Vector Real)
pingReleaseCausal :: Instrument Real (Vector Real)
pingReleaseCausal Real
vel Real
freq =
   (forall b a. Monoid b => T a b -> T a b
PIO.fromCausal forall a b. (a -> b) -> a -> b
$
    forall a b.
(Storable a, Storable b) =>
T a b -> T (Vector a) (Vector b)
Causal.applyStorableChunk forall a b. (a -> b) -> a -> b
$
    forall a. C a => T (a, a) a
FiltNRC.envelope forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
    forall (sig :: * -> *) a b. Read sig a => sig a -> T b (a, b)
Causal.feedFst (forall a b. C a => T a b -> T a -> a -> T b
OsciS.static forall a. C a => T a a
Wave.saw forall a. C a => a
zero (Real
freqforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate)))
   forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
   Real -> T GateChunk (Vector Real)
pingReleaseEnvelopeCausal Real
vel

tine :: Instrument Real Real
tine :: Instrument Real Real
tine Real
vel Real
freq LazyTime
dur =
   forall b c a.
(Storable b, Storable c) =>
(a -> b -> c) -> T a -> T b -> T c
SigS.zipWithStorable forall a. C a => a -> a -> a
(*)
      (forall a b. C a => T a b -> a -> T a -> T b
OsciS.phaseMod forall a. C a => T a a
Wave.sine (Real
freqforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate)
         (forall a. C a => T a -> T a -> T a
FiltNRS.envelope
            (forall a. C a => a -> a -> T a
CtrlS.exponential (Real
1forall a. C a => a -> a -> a
*forall a. C a => a
sampleRate) (Real
velforall a. C a => a -> a -> a
+Real
1))
            (forall a b. C a => T a b -> T a -> a -> T b
OsciS.static forall a. C a => T a a
Wave.sine forall a. C a => a
zero (Real
2forall a. C a => a -> a -> a
*Real
freqforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate))))
      (Real -> LazyTime -> T Real
pingReleaseEnvelope Real
0 LazyTime
dur)

tineStereo :: Instrument Real (Stereo.T Real)
tineStereo :: Instrument Real (T Real)
tineStereo Real
vel Real
freq LazyTime
dur =
   let ctrl :: Real -> T Real
ctrl Real
f =
          forall a. C a => T a -> T a -> T a
FiltNRS.envelope
             (forall a. C a => a -> a -> T a
CtrlS.exponential (Real
1forall a. C a => a -> a -> a
*forall a. C a => a
sampleRate) (Real
velforall a. C a => a -> a -> a
+Real
1))
             (forall a b. C a => T a b -> T a -> a -> T b
OsciS.static forall a. C a => T a a
Wave.sine forall a. C a => a
zero (Real
2forall a. C a => a -> a -> a
*Real
fforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate))
   in  forall b c a.
(Storable b, Storable c) =>
(a -> b -> c) -> T a -> T b -> T c
SigS.zipWithStorable (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a v. C a v => a -> v -> v
(*>))
          (forall a b c. (a -> b -> c) -> T a -> T b -> T c
SigS.zipWith forall a. a -> a -> T a
Stereo.cons
             (forall a b. C a => T a b -> a -> T a -> T b
OsciS.phaseMod forall a. C a => T a a
Wave.sine (Real
freqforall a. C a => a -> a -> a
*Real
0.995forall a. C a => a -> a -> a
/forall a. C a => a
sampleRate) (Real -> T Real
ctrl Real
freq))
             (forall a b. C a => T a b -> a -> T a -> T b
OsciS.phaseMod forall a. C a => T a a
Wave.sine (Real
freqforall a. C a => a -> a -> a
*Real
1.005forall a. C a => a -> a -> a
/forall a. C a => a
sampleRate) (Real -> T Real
ctrl Real
freq)))
          (Real -> LazyTime -> T Real
pingReleaseEnvelope Real
0 LazyTime
dur)


softStringReleaseEnvelope ::
   Real -> LazyTime -> SigSt.T Real
softStringReleaseEnvelope :: Real -> LazyTime -> T Real
softStringReleaseEnvelope Real
vel LazyTime
dur =
   let attackTime :: Int
attackTime = forall a. C a => a
sampleRate
       amp :: Real
amp = Real -> Real
amplitudeFromVelocity Real
vel
       cnst :: T Real
cnst = forall a. a -> T a
CtrlS.constant Real
amp
       {-
       release <- take attackTime beginning
       would yield a space leak, thus we first split 'beginning'
       and then concatenate it again
       -}
       {-
       We can not easily generate attack and sustain separately,
       because we want to use the chunk structure implied by 'dur'.
       -}
       (T Real
attack, T Real
sustain) =
          forall a. Storable a => Int -> Vector a -> (Vector a, Vector a)
SigSt.splitAt Int
attackTime forall a b. (a -> b) -> a -> b
$
          forall a. Storable a => LazySize -> T a -> T a
SigS.toStorableSignalVary (LazyTime -> LazySize
chunkSizesFromLazyTime LazyTime
dur) forall a b. (a -> b) -> a -> b
$
          forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. T a -> T a -> T a
SigS.append T Real
cnst forall a b. (a -> b) -> a -> b
$
          forall a b. (a -> b) -> T a -> T b
SigS.map ((Real
ampforall a. C a => a -> a -> a
*) 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 => a -> a
sin) forall a b. (a -> b) -> a -> b
$
          forall y. C y => Int -> (y, y) -> T y
CtrlS.line Int
attackTime (Real
0, forall a. C a => a
piforall a. C a => a -> a -> a
/Real
2)
       release :: T Real
release = forall a. Storable a => Vector a -> Vector a
SigSt.reverse T Real
attack
   in  T Real
attack forall a. Storable a => Vector a -> Vector a -> Vector a
`SigSt.append` T Real
sustain forall a. Storable a => Vector a -> Vector a -> Vector a
`SigSt.append` T Real
release

-- it's better to avoid inlining here
softString :: Instrument Real (Stereo.T Real)
softString :: Instrument Real (T Real)
softString Real
vel Real
freq LazyTime
dur =
   let f :: Real
f = Real
freqforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate
       {-# INLINE osci #-}
       osci :: Real -> T Real
osci Real
d =
          forall a b. C a => T a b -> T a -> a -> T b
OsciS.static forall a. C a => T a a
Wave.saw forall a. C a => a
zero (Real
d forall a. C a => a -> a -> a
* Real
f)
   in  forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall b c a.
(Storable b, Storable c) =>
(a -> b -> c) -> T a -> T b -> T c
SigS.zipWithStorable (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a v. C a v => a -> v -> v
(*>)))
          (Real -> LazyTime -> T Real
softStringReleaseEnvelope Real
vel LazyTime
dur)
          (forall a b. (a -> b) -> T a -> T b
SigS.map ((Real
0.3::Real)forall a v. C a v => a -> v -> v
*>) forall a b. (a -> b) -> a -> b
$
           forall a b c. (a -> b -> c) -> T a -> T b -> T c
SigS.zipWith forall a. a -> a -> T a
Stereo.cons
             (forall v. C v => T v -> T v -> T v
DispS.mix
                (Real -> T Real
osci Real
1.005)
                (Real -> T Real
osci Real
0.998))
             (forall v. C v => T v -> T v -> T v
DispS.mix
                (Real -> T Real
osci Real
1.002)
                (Real -> T Real
osci Real
0.995)))


softStringReleaseEnvelopeCausal ::
   Real -> LazyTime -> SigSt.T Real
softStringReleaseEnvelopeCausal :: Real -> LazyTime -> T Real
softStringReleaseEnvelopeCausal Real
vel LazyTime
dur =
   forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
Causal.apply
      (Real -> T Bool Real
softStringReleaseEnvelopeCausalProcess Real
vel)
      (forall a. Storable a => Vector a -> Vector a -> Vector a
SigSt.append
         (forall a. Storable a => LazySize -> a -> Vector a
SigStV.replicate (LazyTime -> LazySize
chunkSizesFromLazyTime LazyTime
dur) Bool
True)
         (forall a. Storable a => ChunkSize -> a -> Vector a
SigSt.repeat ChunkSize
chunkSize Bool
False))


{-# INLINE softStringReleaseEnvelopeCausalProcess #-}
softStringReleaseEnvelopeCausalProcess ::
   Real -> Causal.T Bool Real
softStringReleaseEnvelopeCausalProcess :: Real -> T Bool Real
softStringReleaseEnvelopeCausalProcess Real
vel =
   let vol :: Real
vol = Real -> Real
amplitudeFromVelocity Real
vel
       attackTime :: Real
attackTime = forall a. C a => a
sampleRate
       {-# INLINE sine #-}
       sine :: Real -> Real
sine Real
x = forall a. C a => a -> a
sin (Real
xforall a. C a => a -> a -> a
*forall a. C a => a
piforall a. C a => a -> a -> a
/(Real
2forall a. C a => a -> a -> a
*Real
attackTime))
   in  forall a s b. (a -> StateT s Maybe b) -> s -> T a b
Causal.fromStateMaybe
          (\Bool
b ->
             forall (m :: * -> *) s. Monad m => StateT s m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Real
n ->
             if Bool
b
               then
                 if Real
nforall a. Eq a => a -> a -> Bool
==Real
attackTime
                   then forall (m :: * -> *) a. Monad m => a -> m a
return Real
vol
                   else
                     forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (Real
1forall a. C a => a -> a -> a
+) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                     forall (m :: * -> *) a. Monad m => a -> m a
return (Real
vol forall a. C a => a -> a -> a
* Real -> Real
sine Real
n)
               else
                 if Real
nforall a. Eq a => a -> a -> Bool
==Real
0
                   then forall (m :: * -> *) a. MonadPlus m => m a
mzero
                   else
                     forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (forall a. C a => a -> a -> a
subtract Real
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                     forall (m :: * -> *) a. Monad m => a -> m a
return (Real
vol forall a. C a => a -> a -> a
* Real -> Real
sine Real
n))
          forall a. C a => a
zero

{-# INLINE softStringCausalProcess #-}
softStringCausalProcess :: Real -> Causal.T Real (Stereo.T Real)
softStringCausalProcess :: Real -> T Real (T Real)
softStringCausalProcess Real
freq =
   let f :: Real
f = Real
freqforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate
       {-# INLINE osci #-}
       osci :: Real -> T Real
osci Real
d =
          forall a b. C a => T a b -> T a -> a -> T b
OsciS.static forall a. C a => T a a
Wave.saw forall a. C a => a
zero (Real
d forall a. C a => a -> a -> a
* Real
f)
   in  forall (sig :: * -> *) b a c.
Read sig b =>
T (a, b) c -> sig b -> T a c
Causal.applySnd
          (forall a b. (a -> b) -> T a b
Causal.map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a v. C a v => a -> v -> v
(*>)))
          (forall a b. (a -> b) -> T a -> T b
SigS.map ((Real
0.3::Real)forall a v. C a v => a -> v -> v
*>) forall a b. (a -> b) -> a -> b
$
           forall a b c. (a -> b -> c) -> T a -> T b -> T c
SigS.zipWith forall a. a -> a -> T a
Stereo.cons
             (forall v. C v => T v -> T v -> T v
DispS.mix
                (Real -> T Real
osci Real
1.005)
                (Real -> T Real
osci Real
0.998))
             (forall v. C v => T v -> T v -> T v
DispS.mix
                (Real -> T Real
osci Real
1.002)
                (Real -> T Real
osci Real
0.995)))

softStringCausal :: Instrument Real (Stereo.T Real)
softStringCausal :: Instrument Real (T Real)
softStringCausal Real
vel Real
freq LazyTime
dur =
   forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
Causal.apply
      (Real -> T Real (T Real)
softStringCausalProcess Real
freq forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
       Real -> T Bool Real
softStringReleaseEnvelopeCausalProcess Real
vel)
      (forall a. Storable a => Vector a -> Vector a -> Vector a
SigSt.append
         (forall a. Storable a => LazySize -> a -> Vector a
SigStV.replicate (LazyTime -> LazySize
chunkSizesFromLazyTime LazyTime
dur) Bool
True)
         (forall a. Storable a => ChunkSize -> a -> Vector a
SigSt.repeat ChunkSize
chunkSize Bool
False))


stringStereoFM :: SigSt.T Real -> Instrument Real (Stereo.T Real)
stringStereoFM :: T Real -> Instrument Real (T Real)
stringStereoFM T Real
fmSt Real
vel Real
freq LazyTime
dur =
   let fm :: T Real
fm = forall a. Storable a => T a -> T a
SigS.fromStorableSignal T Real
fmSt
   in  forall a. Storable a => LazySize -> T a -> T a
SigS.toStorableSignalVary (LazyTime -> LazySize
chunkSizesFromLazyTime LazyTime
dur) forall a b. (a -> b) -> a -> b
$
       forall a v. C a v => a -> T v -> T v
FiltNRS.amplifyVector (Real -> Real
amplitudeFromVelocity Real
vel) forall a b. (a -> b) -> a -> b
$
       forall a b c. (a -> b -> c) -> T a -> T b -> T c
SigS.zipWith forall a. a -> a -> T a
Stereo.cons
          (forall a b. C a => T a b -> T a -> T a -> T b
OsciS.freqMod forall a. C a => T a a
Wave.saw forall a. C a => a
zero forall a b. (a -> b) -> a -> b
$
           forall a. C a => a -> T a -> T a
FiltNRS.amplify (Real
freqforall a. C a => a -> a -> a
*Real
0.999forall a. C a => a -> a -> a
/forall a. C a => a
sampleRate) T Real
fm)
          (forall a b. C a => T a b -> T a -> T a -> T b
OsciS.freqMod forall a. C a => T a a
Wave.saw forall a. C a => a
zero forall a b. (a -> b) -> a -> b
$
           forall a. C a => a -> T a -> T a
FiltNRS.amplify (Real
freqforall a. C a => a -> a -> a
*Real
1.001forall a. C a => a -> a -> a
/forall a. C a => a
sampleRate) T Real
fm)

stringStereoDetuneFM ::
   SigSt.T Real -> SigSt.T Real -> Instrument Real (Stereo.T Real)
stringStereoDetuneFM :: T Real -> T Real -> Instrument Real (T Real)
stringStereoDetuneFM T Real
detuneSt T Real
fmSt Real
vel Real
freq LazyTime
dur =
   let fm :: T Real
fm = forall a. Storable a => T a -> T a
SigS.fromStorableSignal T Real
fmSt
       detune :: T Real
detune = forall a. Storable a => T a -> T a
SigS.fromStorableSignal T Real
detuneSt
       {-# INLINE osci #-}
       osci :: T Real -> T Real
osci =
          forall a b. C a => T a b -> T a -> T a -> T b
OsciS.freqMod forall a. C a => T a a
Wave.saw forall a. C a => a
zero 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 => a -> T a -> T a
FiltNRS.amplify (Real
freqforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate) 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 -> T a
FiltNRS.envelope T Real
fm
   in  forall a. Storable a => LazySize -> T a -> T a
SigS.toStorableSignalVary (LazyTime -> LazySize
chunkSizesFromLazyTime LazyTime
dur) forall a b. (a -> b) -> a -> b
$
       forall a v. C a v => a -> T v -> T v
FiltNRS.amplifyVector (Real -> Real
amplitudeFromVelocity Real
vel) forall a b. (a -> b) -> a -> b
$
       forall a b c. (a -> b -> c) -> T a -> T b -> T c
SigS.zipWith forall a. a -> a -> T a
Stereo.cons
          (T Real -> T Real
osci forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> T a -> T b
SigS.map (Real
1forall a. C a => a -> a -> a
-) T Real
detune)
          (T Real -> T Real
osci forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> T a -> T b
SigS.map (Real
1forall a. C a => a -> a -> a
+) T Real
detune)

{-# INLINE sampledSoundGenerator #-}
sampledSoundGenerator :: (Real, SigSt.T Real) -> Real -> SigS.T Real
sampledSoundGenerator :: (Real, T Real) -> Real -> T Real
sampledSoundGenerator (Real
period, T Real
sample) Real
freq =
   forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
Causal.apply
      (forall t y. C t => y -> T t y -> t -> T y -> T t y
Interpolation.relativeZeroPad forall a. C a => a
zero forall t y. C t y => T t y
Ip.linear forall a. C a => a
zero
          (forall a. Storable a => T a -> T a
SigS.fromStorableSignal T Real
sample)) forall a b. (a -> b) -> a -> b
$
   forall a. a -> T a
SigS.repeat (Real
freqforall a. C a => a -> a -> a
/forall a. C a => a
sampleRateforall a. C a => a -> a -> a
*Real
period)

sampledSound :: (Real, SigSt.T Real) -> Instrument Real Real
sampledSound :: (Real, T Real) -> Instrument Real Real
sampledSound (Real, T Real)
sound Real
vel Real
freq LazyTime
dur =
   forall a. Storable a => LazySize -> T a -> T a
SigS.toStorableSignalVary (LazyTime -> LazySize
chunkSizesFromLazyTime LazyTime
dur) forall a b. (a -> b) -> a -> b
$
   forall a b. (a -> b) -> T a -> T b
SigS.map (Real -> Real
amplitudeFromVelocity Real
vel forall a. C a => a -> a -> a
*) forall a b. (a -> b) -> a -> b
$
   (Real, T Real) -> Real -> T Real
sampledSoundGenerator (Real, T Real)
sound Real
freq

sampledSoundDetuneStereo ::
   Real -> (Real, SigSt.T Real) -> Instrument Real (Stereo.T Real)
sampledSoundDetuneStereo :: Real -> (Real, T Real) -> Instrument Real (T Real)
sampledSoundDetuneStereo Real
detune (Real, T Real)
sound Real
vel Real
freq LazyTime
dur =
   forall a. Storable a => LazySize -> T a -> T a
SigS.toStorableSignalVary (LazyTime -> LazySize
chunkSizesFromLazyTime LazyTime
dur) forall a b. (a -> b) -> a -> b
$
   forall a b. (a -> b) -> T a -> T b
SigS.map (Real -> Real
amplitudeFromVelocity Real
vel forall a v. C a v => a -> v -> v
*>) forall a b. (a -> b) -> a -> b
$
   forall a b c. (a -> b -> c) -> T a -> T b -> T c
SigS.zipWith forall a. a -> a -> T a
Stereo.cons
      ((Real, T Real) -> Real -> T Real
sampledSoundGenerator (Real, T Real)
sound (Real
freqforall a. C a => a -> a -> a
*(Real
1forall a. C a => a -> a -> a
-Real
detune)))
      ((Real, T Real) -> Real -> T Real
sampledSoundGenerator (Real, T Real)
sound (Real
freqforall a. C a => a -> a -> a
*(Real
1forall a. C a => a -> a -> a
+Real
detune)))

sampleReleaseEnvelope :: Real -> Real -> LazyTime -> SigSt.T Real
sampleReleaseEnvelope :: Instrument Real Real
sampleReleaseEnvelope Real
halfLife Real
vel LazyTime
dur =
   let amp :: Real
amp = Real -> Real
amplitudeFromVelocity Real
vel
   in  forall a. Storable a => Vector a -> Vector a -> Vector a
SigSt.append
          (forall a. Storable a => LazySize -> T a -> T a
SigS.toStorableSignalVary (LazyTime -> LazySize
chunkSizesFromLazyTime LazyTime
dur) forall a b. (a -> b) -> a -> b
$
           forall a. a -> T a
CtrlS.constant Real
amp)
          (forall a. Storable a => ChunkSize -> T a -> T a
SigS.toStorableSignal ChunkSize
chunkSize forall a b. (a -> b) -> a -> b
$
           forall a. Int -> T a -> T a
SigS.take (forall a b. (C a, C b) => a -> b
round (Real
5forall a. C a => a -> a -> a
*Real
halfLifeforall a. C a => a -> a -> a
*forall a. C a => a
sampleRate :: Real)) forall a b. (a -> b) -> a -> b
$
           forall a. C a => a -> a -> T a
CtrlS.exponential2 (Real
halfLifeforall a. C a => a -> a -> a
*forall a. C a => a
sampleRate) Real
amp)

sampledSoundDetuneStereoRelease ::
   Real -> Real -> (Real, SigSt.T Real) -> Instrument Real (Stereo.T Real)
sampledSoundDetuneStereoRelease :: Real -> Real -> (Real, T Real) -> Instrument Real (T Real)
sampledSoundDetuneStereoRelease Real
release Real
detune (Real, T Real)
sound Real
vel Real
freq LazyTime
dur =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall b c a.
(Storable b, Storable c) =>
(a -> b -> c) -> T a -> T b -> T c
SigS.zipWithStorable (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a v. C a v => a -> v -> v
(*>)))
      (Instrument Real Real
sampleReleaseEnvelope Real
release Real
vel LazyTime
dur) forall a b. (a -> b) -> a -> b
$
   forall a b c. (a -> b -> c) -> T a -> T b -> T c
SigS.zipWith forall a. a -> a -> T a
Stereo.cons
      ((Real, T Real) -> Real -> T Real
sampledSoundGenerator (Real, T Real)
sound (Real
freqforall a. C a => a -> a -> a
*(Real
1forall a. C a => a -> a -> a
-Real
detune)))
      ((Real, T Real) -> Real -> T Real
sampledSoundGenerator (Real, T Real)
sound (Real
freqforall a. C a => a -> a -> a
*(Real
1forall a. C a => a -> a -> a
+Real
detune)))


readPianoSample :: IO (Real, SigSt.T Real)
readPianoSample :: IO (Real, T Real)
readPianoSample =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) Real
96) forall a b. (a -> b) -> a -> b
$
   forall (m :: * -> *) signal.
(Handle -> m signal) -> Handle signal -> m signal
SoxRead.withHandle1 (forall a. Storable a => ChunkSize -> Handle -> IO (Vector a)
SVL.hGetContentsSync ChunkSize
chunkSize) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
   forall y (sig :: * -> *).
C y =>
T -> FilePath -> IO (Handle (sig y))
SoxRead.open T
SoxOption.none FilePath
"a-piano3"

readStringSample :: IO (Real, SigSt.T Real)
readStringSample :: IO (Real, T Real)
readStringSample =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) Real
64) forall a b. (a -> b) -> a -> b
$
   forall (m :: * -> *) signal.
(Handle -> m signal) -> Handle signal -> m signal
SoxRead.withHandle1 (forall a. Storable a => ChunkSize -> Handle -> IO (Vector a)
SVL.hGetContentsSync ChunkSize
chunkSize) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
   forall y (sig :: * -> *).
C y =>
T -> FilePath -> IO (Handle (sig y))
SoxRead.open T
SoxOption.none FilePath
"strings7.s8"


{- |
Resample a sampled sound with a smooth loop
using our time manipulation algorithm.
Time is first controlled linearly,
then switches to a sine or triangular control.
Loop start must be large enough in order provide enough spare data
for interpolation at the beginning
and loop start plus length must preserve according space at the end.
One period is enough space for linear interpolation.
The infinite sound we generate is not just a cycle,
that uses bounded space.
Instead we need to compute all the time.
In order to avoid duplicate interpolation,
we have merged resampling and time looping.
-}
{-# INLINE sampledSoundTimeLoop #-}
sampledSoundTimeLoop ::
   (Real -> Real -> Real -> Real -> SigS.T Real) ->
   (Real, SigSt.T Real) -> Real -> Real -> Instrument Real Real
sampledSoundTimeLoop :: (Real -> Real -> Real -> Real -> T Real)
-> (Real, T Real) -> Real -> Real -> Instrument Real Real
sampledSoundTimeLoop Real -> Real -> Real -> Real -> T Real
loopTimeMod
     (Real
period, T Real
sample) Real
loopLen Real
loopStart Real
vel Real
freq LazyTime
dur =
   let wave :: Real -> T Real Real
wave = forall a (sig :: * -> *) v.
(C a, Transform sig v) =>
T a v -> T a v -> a -> sig v -> a -> T a v
WaveG.sampledTone forall t y. C t y => T t y
Ip.linear forall t y. C t y => T t y
Ip.linear Real
period T Real
sample
   in  forall a. Storable a => LazySize -> T a -> T a
SigS.toStorableSignalVary (LazyTime -> LazySize
chunkSizesFromLazyTime LazyTime
dur) forall a b. (a -> b) -> a -> b
$
       (((Real
0.2 forall a. C a => a -> a -> a
* Real -> Real
amplitudeFromVelocity Real
vel) forall a. C a => a -> a -> a
*) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
        forall a c b. C a => (c -> T a b) -> T a -> a -> T c b
OsciC.shapeMod Real -> T Real Real
wave forall a. C a => a
zero (Real
freqforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate))
       forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
`Causal.apply`
          Real -> Real -> Real -> Real -> T Real
loopTimeMod Real
period (Real
loopLenforall a. C a => a -> a -> a
/Real
2) (Real
loopStart forall a. C a => a -> a -> a
+ Real
loopLenforall a. C a => a -> a -> a
/Real
2) Real
freq

{-
Graphics.Gnuplot.Simple.plotList [] (SigS.toList $ SigS.take 20000 $ loopTimeMod 64 1000 2000 440)
-}
loopTimeModSine :: Real -> Real -> Real -> Real -> SigS.T Real
loopTimeModSine :: Real -> Real -> Real -> Real -> T Real
loopTimeModSine Real
period Real
loopDepth Real
loopCenter Real
freq =
   let rate :: Real
rate = Real
freqforall a. C a => a -> a -> a
*Real
periodforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate
   in  forall a. T a -> T a -> T a
SigS.append
          (forall a. (a -> Bool) -> T a -> T a
SigS.takeWhile (Real
loopCenterforall a. Ord a => a -> a -> Bool
>=) forall a b. (a -> b) -> a -> b
$
           forall a. (a -> a) -> a -> T a
SigS.iterate (Real
rateforall a. C a => a -> a -> a
+) forall a. C a => a
zero)
          (forall a b. (a -> b) -> T a -> T b
SigS.map (\Real
t -> Real
loopCenter forall a. C a => a -> a -> a
+ Real
loopDepth forall a. C a => a -> a -> a
* forall a. C a => a -> a
sin Real
t) forall a b. (a -> b) -> a -> b
$
           forall a. (a -> a) -> a -> T a
SigS.iterate ((Real
rateforall a. C a => a -> a -> a
/Real
loopDepth)forall a. C a => a -> a -> a
+) forall a. C a => a
zero)

loopTimeModZigZag :: Real -> Real -> Real -> Real -> SigS.T Real
loopTimeModZigZag :: Real -> Real -> Real -> Real -> T Real
loopTimeModZigZag Real
period Real
loopDepth Real
loopCenter Real
freq =
   let rate :: Real
rate = Real
freqforall a. C a => a -> a -> a
*Real
periodforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate
   in  forall a. T a -> T a -> T a
SigS.append
          (forall a. (a -> Bool) -> T a -> T a
SigS.takeWhile (Real
loopCenterforall a. Ord a => a -> a -> Bool
>=) forall a b. (a -> b) -> a -> b
$
           forall a. (a -> a) -> a -> T a
SigS.iterate (Real
rateforall a. C a => a -> a -> a
+) forall a. C a => a
zero)
          (forall a b. (a -> b) -> T a -> T b
SigS.map (\Real
t -> Real
loopCenter forall a. C a => a -> a -> a
+ Real
loopDepth forall a. C a => a -> a -> a
* Real
t) forall a b. (a -> b) -> a -> b
$
           forall a b. C a => T a b -> T a -> a -> T b
OsciS.static forall a. (Ord a, C a) => T a a
Wave.triangle forall a. C a => a
zero (Real
rateforall a. C a => a -> a -> a
/(Real
4forall a. C a => a -> a -> a
*Real
loopDepth)))



timeModulatedSample :: (Real, SigSt.T Real) ->
   SigSt.T Real -> SigSt.T Real -> SigSt.T Real -> Instrument Real Real
timeModulatedSample :: (Real, T Real)
-> T Real -> T Real -> T Real -> Instrument Real Real
timeModulatedSample (Real
period, T Real
sample) T Real
offsetMod T Real
speedMod T Real
freqMod Real
vel Real
freq LazyTime
dur =
   let wave :: Real -> T Real Real
wave = forall a (sig :: * -> *) v.
(C a, Transform sig v) =>
T a v -> T a v -> a -> sig v -> a -> T a v
WaveG.sampledTone forall t y. C t y => T t y
Ip.linear forall t y. C t y => T t y
Ip.linear Real
period T Real
sample
   in  forall a. Storable a => LazySize -> Vector a -> Vector a
SigStV.take (LazyTime -> LazySize
chunkSizesFromLazyTime LazyTime
dur) forall a b. (a -> b) -> a -> b
$
{-
       (((0.2 * amplitudeFromVelocity vel) *) ^<<
        OsciC.freqMod Wave.saw zero <<<
        Causal.map ((freq/sampleRate) *))
       `Causal.apply` freqMod
-}
       (((Real
0.2 forall a. C a => a -> a -> a
* Real -> Real
amplitudeFromVelocity Real
vel) forall a. C a => a -> a -> a
*) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
        forall a c b. C a => (c -> T a b) -> T a -> T (c, a) b
OsciC.shapeFreqMod Real -> T Real Real
wave forall a. C a => a
zero 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) -> (a, b) -> c
uncurry forall a. C a => a -> a -> a
(+) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< forall (sig :: * -> *) a b. Read sig a => sig a -> T b (a, b)
Causal.feedFst T Real
offsetMod forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall v. C v => T v v
IntegC.run) forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
***
         forall a b. (a -> b) -> T a b
Causal.map ((Real
freqforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate) forall a. C a => a -> a -> a
*))
       forall (sig :: * -> *) a b c.
Read sig a =>
T (a, b) c -> sig a -> T b c
`Causal.applyFst` T Real
speedMod
       forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
`Causal.apply` T Real
freqMod


colourNoise ::
   SigSt.T Real -> SigSt.T Real ->
   Instrument Real Real
colourNoise :: T Real -> T Real -> Instrument Real Real
colourNoise T Real
resonanceMod T Real
freqMod Real
vel Real
freq LazyTime
dur =
   forall a. Storable a => LazySize -> T a -> T a
SigS.toStorableSignalVary (LazyTime -> LazySize
chunkSizesFromLazyTime LazyTime
dur) forall a b. (a -> b) -> a -> b
$
   ((((forall a. C a => a -> a
sqrt forall a. C a => a
sampleRateforall a. C a => a -> a -> a
/Real
2000 forall a. C a => a -> a -> a
* Real -> Real
amplitudeFromVelocity Real
vel) forall a. C a => a -> a -> a
*) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Result a -> a
UniFilter.lowpass) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
    forall a v. (C a, C a v) => T (Parameter a, v) (Result v)
UniFilter.causal)
   forall (sig :: * -> *) a b c.
Read sig a =>
T (a, b) c -> sig a -> T b c
`Causal.applyFst`
      forall a b c. (a -> b -> c) -> T a -> T b -> T c
SigS.zipWith
         (\Real
r Real
f -> forall a. C a => Pole a -> Parameter a
UniFilter.parameter forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Pole a
FiltR.Pole Real
r (Real
fforall a. C a => a -> a -> a
*Real
freqforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate))
         (forall a. Storable a => T a -> T a
SigS.fromStorableSignal T Real
resonanceMod)
         (forall a. Storable a => T a -> T a
SigS.fromStorableSignal T Real
freqMod)
   forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
`Causal.apply` forall y. (C y, Random y) => T y
NoiseS.white


toneFromNoise ::
   SigSt.T Real -> SigSt.T Real ->
   Instrument Real Real
toneFromNoise :: T Real -> T Real -> Instrument Real Real
toneFromNoise T Real
speedMod T Real
freqMod Real
vel Real
freq LazyTime
dur =
   forall a. Storable a => LazySize -> T a -> T a
SigS.toStorableSignalVary (LazyTime -> LazySize
chunkSizesFromLazyTime LazyTime
dur) forall a b. (a -> b) -> a -> b
$
   (((Real
0.1 forall a. C a => a -> a -> a
* Real -> Real
amplitudeFromVelocity Real
vel) forall a. C a => a -> a -> a
*) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
    forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
T t y -> T t y -> t -> sig y -> t -> T t -> T (t, t) y
OsciC.shapeFreqModFromSampledTone
       forall t y. C t y => T t y
Ip.linear forall t y. C t y => T t y
Ip.linear
       Real
100 (forall a. Storable a => ChunkSize -> T a -> T a
SigS.toStorableSignal ChunkSize
chunkSize forall y. (C y, Random y) => T y
NoiseS.white)
       forall a. C a => a
zero forall a. C a => a
zero 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 d.
Arrow a =>
a b c -> a (d, b) (d, c)
Causal.second (forall a b. (a -> b) -> T a b
Causal.map ((Real
freqforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate)forall a. C a => a -> a -> a
*)))
   forall (sig :: * -> *) a b c.
Read sig a =>
T (a, b) c -> sig a -> T b c
`Causal.applyFst`
      forall a. Storable a => T a -> T a
SigS.fromStorableSignal T Real
speedMod
   forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
`Causal.apply`
      forall a. Storable a => T a -> T a
SigS.fromStorableSignal T Real
freqMod

{-
I like to control the filter parameters
before phase and time modulation.
Unfortunately this means,
that we have to translate those control signals back
using the speed profile, which is tricky.
We need an inverse frequency modulation, that is:

freqMod ctrl (invFreqMod ctrl signal) = signal

The problem is, that the chunk boundaries will not match.
invFreqMod must be a StorableSignal function and it is not causal
in any of its inputs.
-}
toneFromFilteredNoise ::
   SigSt.T Real -> SigSt.T Real ->
   SigSt.T Real -> SigSt.T Real ->
   Instrument Real Real
toneFromFilteredNoise :: T Real -> T Real -> T Real -> T Real -> Instrument Real Real
toneFromFilteredNoise T Real
resonanceMod T Real
cutoffMod T Real
speedMod T Real
freqMod Real
vel Real
freq LazyTime
dur =
   let period :: Real
period = Real
100
       filtNoise :: T Real
filtNoise =
          (((Real -> Real
amplitudeFromVelocity Real
vel forall a. C a => a -> a -> a
*) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Result a -> a
UniFilter.lowpass) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
           forall a v. (C a, C a v) => T (Parameter a, v) (Result v)
UniFilter.causal forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (sig :: * -> *) a b. Read sig a => sig a -> T b (b, a)
Causal.feedSnd forall y. (C y, Random y) => T y
NoiseS.white
           forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ (\(Real
r,Real
f) -> forall a. C a => Pole a -> Parameter a
UniFilter.parameter forall a b. (a -> b) -> a -> b
$
                  forall a. a -> a -> Pole a
FiltR.Pole Real
r (Real
fforall a. C a => a -> a -> a
/Real
period)))
          forall (sig :: * -> *) a b c.
Read sig a =>
T (a, b) c -> sig a -> T b c
`Causal.applyFst`
             forall v (sig :: * -> *) t.
(Storable v, Read sig t, C t, Ord t) =>
ChunkSize -> sig t -> T v -> T v
FiltNRSt.inverseFrequencyModulationFloor ChunkSize
chunkSize T Real
speedMod T Real
resonanceMod
          forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
`Causal.apply`
             forall v (sig :: * -> *) t.
(Storable v, Read sig t, C t, Ord t) =>
ChunkSize -> sig t -> T v -> T v
FiltNRSt.inverseFrequencyModulationFloor ChunkSize
chunkSize T Real
speedMod T Real
cutoffMod
   in  forall a. Storable a => LazySize -> Vector a -> Vector a
SigStV.take (LazyTime -> LazySize
chunkSizesFromLazyTime LazyTime
dur) forall a b. (a -> b) -> a -> b
$
       (((Real
0.1 forall a. C a => a -> a -> a
* Real -> Real
amplitudeFromVelocity Real
vel) forall a. C a => a -> a -> a
*) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
        forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
T t y -> T t y -> t -> sig y -> t -> T t -> T (t, t) y
OsciC.shapeFreqModFromSampledTone
           forall t y. C t y => T t y
Ip.linear forall t y. C t y => T t y
Ip.linear
           Real
period T Real
filtNoise
           forall a. C a => a
zero forall a. C a => a
zero 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 d.
Arrow a =>
a b c -> a (d, b) (d, c)
Causal.second (forall a b. (a -> b) -> T a b
Causal.map ((Real
freqforall a. C a => a -> a -> a
/forall a. C a => a
sampleRate)forall a. C a => a -> a -> a
*)))
       forall (sig :: * -> *) a b c.
Read sig a =>
T (a, b) c -> sig a -> T b c
`Causal.applyFst` T Real
speedMod
       forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
T a b -> sig a -> sig b
`Causal.apply`    T Real
freqMod