{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.LLVM.Server.CausalPacked.Speech (
   loadMasks,
   loadMasksGrouped,
   loadMasksKeyboard,
   maskNamesGrouped,
   phonemeMask,
   vowelMask,
   vowelBand,
   filterFormant,
   filterFormants,
   VowelSynth,
   VowelSynthEnv,
   EnvelopeType(..),
   CarrierType(..),
   PhonemeType(..),
   ) where

import Synthesizer.LLVM.Server.CausalPacked.Instrument
          (StereoChunk, Control, Frequency, frequencyControl,
           WithEnvelopeControl, zipEnvelope,
           stringControlledEnvelope, pingControlledEnvelope)
import Synthesizer.LLVM.Server.CommonPacked (Vector)
import Synthesizer.LLVM.Server.Common
          (SampleRate(SampleRate), Real, wrapped,
           Arg(Frequency), constant, noiseReference)
import qualified Synthesizer.LLVM.Server.SampledSound as Sample

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.LLVM.Frame.Stereo as Stereo
import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
import qualified Synthesizer.LLVM.Filter.Universal as UniFilterL
import qualified Synthesizer.LLVM.Filter.NonRecursive as FiltNR
import qualified Synthesizer.LLVM.Causal.FunctionalPlug as FP
import qualified Synthesizer.LLVM.Causal.ControlledPacked as CtrlPS
import qualified Synthesizer.LLVM.Causal.Render as CausalRender
import qualified Synthesizer.LLVM.Causal.Process as Causal
import qualified Synthesizer.LLVM.Generator.SignalPacked as SigPS
import qualified Synthesizer.LLVM.Generator.Render as Render
import qualified Synthesizer.LLVM.Generator.Signal as Sig
import Synthesizer.LLVM.Causal.FunctionalPlug (($&), (&|&))
import Synthesizer.LLVM.Causal.Process (($*), ($<), ($>))

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

import qualified Synthesizer.PiecewiseConstant.Signal as PC

import qualified Synthesizer.Generic.Control as CtrlG
import qualified Synthesizer.Generic.Signal as SigG

import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter
import Synthesizer.Plain.Filter.Recursive (Pole(Pole))

import qualified Data.StorableVector.Lazy as SVL
import qualified Data.StorableVector as SV
import qualified Data.Map as Map ; import Data.Map (Map)

import qualified LLVM.Extra.Multi.Value as MultiValue

import qualified System.Path as Path
import System.Path ((</>), (<.>))

import Control.Arrow (arr, second, (^<<), (<<^), (***))
import Control.Category ((.))
import Control.Applicative (pure, liftA, liftA3, (<$>), (<*>))

import Data.Traversable (Traversable, traverse, forM)

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


{-
stimmhaft
a, e, i, o, u, ae, oe, ue
l, m, n, ng

Diphtong
ai, oi, au, ui, ei

stimmlos/Zischlaute
f, h, w, s, sch, th, ch (weich), ch (kochen), r

plosiv
b, p, g, k, d, t
-}

{-
Formanten:
a -  700 Hz
i -  400 Hz, 2200 Hz
o -  600 Hz, 3000 Hz
f -  white noise
sch - highpass cutoff 1500 Hz
-}

type
   VowelSynth =
      SampleRate Real -> VoiceMsg.Pitch ->
      PIO.T (Zip.T MIO.GateChunk StereoChunk) StereoChunk

{- |
Synthesize vowels using bandpass filters.
-}
vowelBand :: IO VowelSynth
vowelBand :: IO VowelSynth
vowelBand =
   ((SampleRate Real -> (Real, Real) -> T StereoChunk StereoChunk)
 -> VowelSynth)
-> IO
     (SampleRate Real -> (Real, Real) -> T StereoChunk StereoChunk)
-> IO VowelSynth
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA
      (\SampleRate Real -> (Real, Real) -> T StereoChunk StereoChunk
filt SampleRate Real
sr Pitch
p ->
         case Pitch -> Maybe (Real, Real)
formants Pitch
p of
            Maybe (Real, Real)
Nothing -> (T GateChunk StereoChunk -> StereoChunk)
-> T (T GateChunk StereoChunk) StereoChunk
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((T GateChunk StereoChunk -> StereoChunk)
 -> T (T GateChunk StereoChunk) StereoChunk)
-> (T GateChunk StereoChunk -> StereoChunk)
-> T (T GateChunk StereoChunk) StereoChunk
forall a b. (a -> b) -> a -> b
$ StereoChunk -> T GateChunk StereoChunk -> StereoChunk
forall a b. a -> b -> a
const StereoChunk
forall a. Storable a => Vector a
SV.empty
            Just (Real, Real)
fs ->
               SampleRate Real -> (Real, Real) -> T StereoChunk StereoChunk
filt SampleRate Real
sr (Real, Real)
fs
               T StereoChunk StereoChunk
-> T (T GateChunk StereoChunk) StereoChunk
-> T (T GateChunk StereoChunk) StereoChunk
forall b c a. T b c -> T a b -> T a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
               T (T GateChunk StereoChunk) StereoChunk
forall signal a. Transform signal => T (T (Chunk a) signal) signal
Gate.shorten)
      (DSL
  (SampleRate Real -> (Real, Real) -> T StereoChunk StereoChunk)
  (Element
     (In
        (SampleRate Real -> (Real, Real) -> T StereoChunk StereoChunk)))
  (Element
     (Out
        (SampleRate Real -> (Real, Real) -> T StereoChunk StereoChunk)))
-> IO
     (SampleRate Real -> (Real, Real) -> T StereoChunk StereoChunk)
forall f a al b bl.
(Run f, In f ~ a, Default a, Element a ~ al, Out f ~ b, Default b,
 Element b ~ bl) =>
DSL f al bl -> IO f
CausalRender.run (DSL
   (SampleRate Real -> (Real, Real) -> T StereoChunk StereoChunk)
   (Element
      (In
         (SampleRate Real -> (Real, Real) -> T StereoChunk StereoChunk)))
   (Element
      (Out
         (SampleRate Real -> (Real, Real) -> T StereoChunk StereoChunk)))
 -> IO
      (SampleRate Real -> (Real, Real) -> T StereoChunk StereoChunk))
-> DSL
     (SampleRate Real -> (Real, Real) -> T StereoChunk StereoChunk)
     (Element
        (In
           (SampleRate Real -> (Real, Real) -> T StereoChunk StereoChunk)))
     (Element
        (Out
           (SampleRate Real -> (Real, Real) -> T StereoChunk StereoChunk)))
-> IO
     (SampleRate Real -> (Real, Real) -> T StereoChunk StereoChunk)
forall a b. (a -> b) -> a -> b
$
       ((Arg Frequency (Exp Real), Arg Frequency (Exp Real))
 -> SampleRate (Exp Real) -> T (T (T Vector)) (T (T Vector)))
-> SampleRate (Exp Real)
-> Unwrapped
     ((Arg Frequency (Exp Real), Arg Frequency (Exp Real))
      -> SampleRate (Exp Real) -> T (T (T Vector)) (T (T Vector)))
forall a f. Wrapped a f => f -> SampleRate a -> Unwrapped f
wrapped (((Arg Frequency (Exp Real), Arg Frequency (Exp Real))
  -> SampleRate (Exp Real) -> T (T (T Vector)) (T (T Vector)))
 -> SampleRate (Exp Real)
 -> Unwrapped
      ((Arg Frequency (Exp Real), Arg Frequency (Exp Real))
       -> SampleRate (Exp Real) -> T (T (T Vector)) (T (T Vector))))
-> ((Arg Frequency (Exp Real), Arg Frequency (Exp Real))
    -> SampleRate (Exp Real) -> T (T (T Vector)) (T (T Vector)))
-> SampleRate (Exp Real)
-> Unwrapped
     ((Arg Frequency (Exp Real), Arg Frequency (Exp Real))
      -> SampleRate (Exp Real) -> T (T (T Vector)) (T (T Vector)))
forall a b. (a -> b) -> a -> b
$ \(Frequency Exp Real
low, Frequency Exp Real
high) (SampleRate Exp Real
_sr) ->
         T (T Vector) -> T (T Vector)
forall a. T (T a) -> T (T a)
Stereo.multiValue
         (T (T Vector) -> T (T Vector))
-> T (T (T Vector)) (T (T Vector))
-> T (T (T Vector)) (T (T Vector))
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
         T (T Vector) (T Vector) -> T (T (T Vector)) (T (T Vector))
forall a b.
(Phi a, Undefined a, Phi b, Undefined b) =>
T a b -> T (T a) (T b)
Causal.stereoFromMono
             (let lowpass :: ae -> ae -> T c c
lowpass ae
q ae
f =
                     Result c -> c
forall a. Result a -> a
UniFilter.bandpass
                     (Result c -> c)
-> T (Parameter (MultiValuesOf ae), c) (Result c)
-> T (Parameter (MultiValuesOf ae), c) c
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
                     T (Parameter (MultiValuesOf ae), c) (Result c)
forall parameter a b. C parameter a b => T (parameter, a) b
CtrlPS.process
                     T (Parameter (MultiValuesOf ae), c) c
-> SignalOf T (Parameter (MultiValuesOf ae)) -> T c c
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process a -> process b c
$<
                     Parameter ae -> T (Parameter (MultiValuesOf ae))
forall ae al. (Aggregate ae al, C al) => ae -> T al
Sig.constant (Pole ae -> Parameter ae
forall a. C a => Pole a -> Parameter a
UniFilter.parameter (Pole ae -> Parameter ae) -> Pole ae -> Parameter ae
forall a b. (a -> b) -> a -> b
$ ae -> ae -> Pole ae
forall a. a -> a -> Pole a
Pole ae
q ae
f)
              in  Exp Real -> Exp Real -> T (T Vector) (T Vector)
forall {c} {ae}.
(Write c, C ae (ExpressionsOf (Element c)),
 Aggregate ae (MultiValuesOf ae),
 Aggregate (ExpressionsOf (Element c)) (Element c), C (Element c),
 C (MultiValuesOf ae), C ae) =>
ae -> ae -> T c c
lowpass Exp Real
100 Exp Real
low T (T Vector) (T Vector)
-> T (T Vector) (T Vector) -> T (T Vector) (T Vector)
forall a. C a => a -> a -> a
+ Exp Real -> Exp Real -> T (T Vector) (T Vector)
forall {c} {ae}.
(Write c, C ae (ExpressionsOf (Element c)),
 Aggregate ae (MultiValuesOf ae),
 Aggregate (ExpressionsOf (Element c)) (Element c), C (Element c),
 C (MultiValuesOf ae), C ae) =>
ae -> ae -> T c c
lowpass Exp Real
20 Exp Real
high)
         T (T (T Vector)) (T (T Vector))
-> (T (T Vector) -> T (T Vector))
-> T (T (T Vector)) (T (T Vector))
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^
         T (T Vector) -> T (T Vector)
forall a. T (T a) -> T (T a)
Stereo.unMultiValue)

formants :: VoiceMsg.Pitch -> Maybe (Real, Real)
formants :: Pitch -> Maybe (Real, Real)
formants Pitch
p =
   case Pitch -> Int
VoiceMsg.fromPitch Pitch
p of
      Int
00 -> (Real, Real) -> Maybe (Real, Real)
forall a. a -> Maybe a
Just ( Real
320,  Real
800) -- u
      Int
02 -> (Real, Real) -> Maybe (Real, Real)
forall a. a -> Maybe a
Just ( Real
500, Real
1000) -- o
      Int
04 -> (Real, Real) -> Maybe (Real, Real)
forall a. a -> Maybe a
Just (Real
1000, Real
1400) -- a
      Int
05 -> (Real, Real) -> Maybe (Real, Real)
forall a. a -> Maybe a
Just (Real
1500,  Real
500) -- oe
      Int
07 -> (Real, Real) -> Maybe (Real, Real)
forall a. a -> Maybe a
Just (Real
1650,  Real
320) -- ue
      Int
09 -> (Real, Real) -> Maybe (Real, Real)
forall a. a -> Maybe a
Just (Real
1800,  Real
700) -- ae
      Int
11 -> (Real, Real) -> Maybe (Real, Real)
forall a. a -> Maybe a
Just (Real
2300,  Real
500) -- e
      Int
12 -> (Real, Real) -> Maybe (Real, Real)
forall a. a -> Maybe a
Just (Real
3200,  Real
320) -- i
      Int
_ -> Maybe (Real, Real)
forall a. Maybe a
Nothing


{- |
Synthesize vowels using sampled impulse responses.
-}
vowelMask ::
   IO (Map VoiceMsg.Pitch (SV.Vector Real) -> VowelSynth)
vowelMask :: IO (Map Pitch (Vector Real) -> VowelSynth)
vowelMask =
   ((Buffer Real -> T StereoChunk StereoChunk)
 -> Map Pitch (Vector Real) -> VowelSynth)
-> IO (Buffer Real -> T StereoChunk StereoChunk)
-> IO (Map Pitch (Vector Real) -> VowelSynth)
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA
      (\Buffer Real -> T StereoChunk StereoChunk
filt Map Pitch (Vector Real)
dict SampleRate Real
_sr Pitch
p ->
         case Pitch -> Map Pitch (Vector Real) -> Maybe (Vector Real)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Pitch
p Map Pitch (Vector Real)
dict of
            Maybe (Vector Real)
Nothing -> (T GateChunk StereoChunk -> StereoChunk)
-> T (T GateChunk StereoChunk) StereoChunk
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((T GateChunk StereoChunk -> StereoChunk)
 -> T (T GateChunk StereoChunk) StereoChunk)
-> (T GateChunk StereoChunk -> StereoChunk)
-> T (T GateChunk StereoChunk) StereoChunk
forall a b. (a -> b) -> a -> b
$ StereoChunk -> T GateChunk StereoChunk -> StereoChunk
forall a b. a -> b -> a
const StereoChunk
forall a. Storable a => Vector a
SV.empty
            Just Vector Real
mask -> Buffer Real -> T StereoChunk StereoChunk
filt (Vector Real -> Buffer Real
forall a. Vector a -> Buffer a
Render.buffer Vector Real
mask) T StereoChunk StereoChunk
-> T (T GateChunk StereoChunk) StereoChunk
-> T (T GateChunk StereoChunk) StereoChunk
forall b c a. T b c -> T a b -> T a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. T (T GateChunk StereoChunk) StereoChunk
forall signal a. Transform signal => T (T (Chunk a) signal) signal
Gate.shorten)
      (DSL
  (Buffer Real -> T StereoChunk StereoChunk)
  (Element (In (Buffer Real -> T StereoChunk StereoChunk)))
  (Element (Out (Buffer Real -> T StereoChunk StereoChunk)))
-> IO (Buffer Real -> T StereoChunk StereoChunk)
forall f a al b bl.
(Run f, In f ~ a, Default a, Element a ~ al, Out f ~ b, Default b,
 Element b ~ bl) =>
DSL f al bl -> IO f
CausalRender.run (DSL
   (Buffer Real -> T StereoChunk StereoChunk)
   (Element (In (Buffer Real -> T StereoChunk StereoChunk)))
   (Element (Out (Buffer Real -> T StereoChunk StereoChunk)))
 -> IO (Buffer Real -> T StereoChunk StereoChunk))
-> DSL
     (Buffer Real -> T StereoChunk StereoChunk)
     (Element (In (Buffer Real -> T StereoChunk StereoChunk)))
     (Element (Out (Buffer Real -> T StereoChunk StereoChunk)))
-> IO (Buffer Real -> T StereoChunk StereoChunk)
forall a b. (a -> b) -> a -> b
$ \Exp (StorableVector Real)
mask ->
         T (T Vector) -> T (T Vector)
forall a. T (T a) -> T (T a)
Stereo.multiValue
         (T (T Vector) -> T (T Vector))
-> T (T (T Vector)) (T (T Vector))
-> T (T (T Vector)) (T (T Vector))
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
         T (T Vector) (T Vector) -> T (T (T Vector)) (T (T Vector))
forall a b.
(Phi a, Undefined a, Phi b, Undefined b) =>
T a b -> T (T a) (T b)
Causal.stereoFromMono (Exp (StorableVector Real) -> T (T Vector) (T Vector)
forall n a v.
(Vector n a, PseudoRing a, C a, PseudoRing a, Value n a ~ v) =>
Exp (StorableVector a) -> T v v
FiltNR.convolvePacked Exp (StorableVector Real)
mask)
         T (T (T Vector)) (T (T Vector))
-> (T (T Vector) -> T (T Vector))
-> T (T (T Vector)) (T (T Vector))
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^
         T (T Vector) -> T (T Vector)
forall a. T (T a) -> T (T a)
Stereo.unMultiValue)


type
   VowelSynthEnv =
      SampleRate Real -> Real {- Velocity -} -> VoiceMsg.Pitch ->
      PIO.T (WithEnvelopeControl StereoChunk) StereoChunk

data EnvelopeType = Continuous | Percussive
   deriving (EnvelopeType -> EnvelopeType -> Bool
(EnvelopeType -> EnvelopeType -> Bool)
-> (EnvelopeType -> EnvelopeType -> Bool) -> Eq EnvelopeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnvelopeType -> EnvelopeType -> Bool
== :: EnvelopeType -> EnvelopeType -> Bool
$c/= :: EnvelopeType -> EnvelopeType -> Bool
/= :: EnvelopeType -> EnvelopeType -> Bool
Eq, Eq EnvelopeType
Eq EnvelopeType
-> (EnvelopeType -> EnvelopeType -> Ordering)
-> (EnvelopeType -> EnvelopeType -> Bool)
-> (EnvelopeType -> EnvelopeType -> Bool)
-> (EnvelopeType -> EnvelopeType -> Bool)
-> (EnvelopeType -> EnvelopeType -> Bool)
-> (EnvelopeType -> EnvelopeType -> EnvelopeType)
-> (EnvelopeType -> EnvelopeType -> EnvelopeType)
-> Ord EnvelopeType
EnvelopeType -> EnvelopeType -> Bool
EnvelopeType -> EnvelopeType -> Ordering
EnvelopeType -> EnvelopeType -> EnvelopeType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EnvelopeType -> EnvelopeType -> Ordering
compare :: EnvelopeType -> EnvelopeType -> Ordering
$c< :: EnvelopeType -> EnvelopeType -> Bool
< :: EnvelopeType -> EnvelopeType -> Bool
$c<= :: EnvelopeType -> EnvelopeType -> Bool
<= :: EnvelopeType -> EnvelopeType -> Bool
$c> :: EnvelopeType -> EnvelopeType -> Bool
> :: EnvelopeType -> EnvelopeType -> Bool
$c>= :: EnvelopeType -> EnvelopeType -> Bool
>= :: EnvelopeType -> EnvelopeType -> Bool
$cmax :: EnvelopeType -> EnvelopeType -> EnvelopeType
max :: EnvelopeType -> EnvelopeType -> EnvelopeType
$cmin :: EnvelopeType -> EnvelopeType -> EnvelopeType
min :: EnvelopeType -> EnvelopeType -> EnvelopeType
Ord, Int -> EnvelopeType -> ShowS
[EnvelopeType] -> ShowS
EnvelopeType -> String
(Int -> EnvelopeType -> ShowS)
-> (EnvelopeType -> String)
-> ([EnvelopeType] -> ShowS)
-> Show EnvelopeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvelopeType -> ShowS
showsPrec :: Int -> EnvelopeType -> ShowS
$cshow :: EnvelopeType -> String
show :: EnvelopeType -> String
$cshowList :: [EnvelopeType] -> ShowS
showList :: [EnvelopeType] -> ShowS
Show)

data CarrierType = Voiced | Unvoiced | Rasp
   deriving (CarrierType -> CarrierType -> Bool
(CarrierType -> CarrierType -> Bool)
-> (CarrierType -> CarrierType -> Bool) -> Eq CarrierType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CarrierType -> CarrierType -> Bool
== :: CarrierType -> CarrierType -> Bool
$c/= :: CarrierType -> CarrierType -> Bool
/= :: CarrierType -> CarrierType -> Bool
Eq, Eq CarrierType
Eq CarrierType
-> (CarrierType -> CarrierType -> Ordering)
-> (CarrierType -> CarrierType -> Bool)
-> (CarrierType -> CarrierType -> Bool)
-> (CarrierType -> CarrierType -> Bool)
-> (CarrierType -> CarrierType -> Bool)
-> (CarrierType -> CarrierType -> CarrierType)
-> (CarrierType -> CarrierType -> CarrierType)
-> Ord CarrierType
CarrierType -> CarrierType -> Bool
CarrierType -> CarrierType -> Ordering
CarrierType -> CarrierType -> CarrierType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CarrierType -> CarrierType -> Ordering
compare :: CarrierType -> CarrierType -> Ordering
$c< :: CarrierType -> CarrierType -> Bool
< :: CarrierType -> CarrierType -> Bool
$c<= :: CarrierType -> CarrierType -> Bool
<= :: CarrierType -> CarrierType -> Bool
$c> :: CarrierType -> CarrierType -> Bool
> :: CarrierType -> CarrierType -> Bool
$c>= :: CarrierType -> CarrierType -> Bool
>= :: CarrierType -> CarrierType -> Bool
$cmax :: CarrierType -> CarrierType -> CarrierType
max :: CarrierType -> CarrierType -> CarrierType
$cmin :: CarrierType -> CarrierType -> CarrierType
min :: CarrierType -> CarrierType -> CarrierType
Ord, Int -> CarrierType -> ShowS
[CarrierType] -> ShowS
CarrierType -> String
(Int -> CarrierType -> ShowS)
-> (CarrierType -> String)
-> ([CarrierType] -> ShowS)
-> Show CarrierType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CarrierType -> ShowS
showsPrec :: Int -> CarrierType -> ShowS
$cshow :: CarrierType -> String
show :: CarrierType -> String
$cshowList :: [CarrierType] -> ShowS
showList :: [CarrierType] -> ShowS
Show)

data PhonemeType = Filtered EnvelopeType CarrierType | Sampled
   deriving (PhonemeType -> PhonemeType -> Bool
(PhonemeType -> PhonemeType -> Bool)
-> (PhonemeType -> PhonemeType -> Bool) -> Eq PhonemeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PhonemeType -> PhonemeType -> Bool
== :: PhonemeType -> PhonemeType -> Bool
$c/= :: PhonemeType -> PhonemeType -> Bool
/= :: PhonemeType -> PhonemeType -> Bool
Eq, Eq PhonemeType
Eq PhonemeType
-> (PhonemeType -> PhonemeType -> Ordering)
-> (PhonemeType -> PhonemeType -> Bool)
-> (PhonemeType -> PhonemeType -> Bool)
-> (PhonemeType -> PhonemeType -> Bool)
-> (PhonemeType -> PhonemeType -> Bool)
-> (PhonemeType -> PhonemeType -> PhonemeType)
-> (PhonemeType -> PhonemeType -> PhonemeType)
-> Ord PhonemeType
PhonemeType -> PhonemeType -> Bool
PhonemeType -> PhonemeType -> Ordering
PhonemeType -> PhonemeType -> PhonemeType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PhonemeType -> PhonemeType -> Ordering
compare :: PhonemeType -> PhonemeType -> Ordering
$c< :: PhonemeType -> PhonemeType -> Bool
< :: PhonemeType -> PhonemeType -> Bool
$c<= :: PhonemeType -> PhonemeType -> Bool
<= :: PhonemeType -> PhonemeType -> Bool
$c> :: PhonemeType -> PhonemeType -> Bool
> :: PhonemeType -> PhonemeType -> Bool
$c>= :: PhonemeType -> PhonemeType -> Bool
>= :: PhonemeType -> PhonemeType -> Bool
$cmax :: PhonemeType -> PhonemeType -> PhonemeType
max :: PhonemeType -> PhonemeType -> PhonemeType
$cmin :: PhonemeType -> PhonemeType -> PhonemeType
min :: PhonemeType -> PhonemeType -> PhonemeType
Ord, Int -> PhonemeType -> ShowS
[PhonemeType] -> ShowS
PhonemeType -> String
(Int -> PhonemeType -> ShowS)
-> (PhonemeType -> String)
-> ([PhonemeType] -> ShowS)
-> Show PhonemeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PhonemeType -> ShowS
showsPrec :: Int -> PhonemeType -> ShowS
$cshow :: PhonemeType -> String
show :: PhonemeType -> String
$cshowList :: [PhonemeType] -> ShowS
showList :: [PhonemeType] -> ShowS
Show)

{- |
Like 'vowelMask', but it does not simply open and close the gate abruptly.
Instead we use an envelope for fading the filtered sound in and out.
-}
phonemeMask ::
   IO (Map VoiceMsg.Pitch (PhonemeType, SV.Vector Real) -> VowelSynthEnv)
phonemeMask :: IO (Map Pitch (PhonemeType, Vector Real) -> VowelSynthEnv)
phonemeMask =
   ((Buffer Real -> T (T Chunk StereoChunk) StereoChunk)
 -> (Buffer Real
     -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)
 -> (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)
 -> (Vector Real -> T Chunk StereoChunk)
 -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
 -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
 -> Map Pitch (PhonemeType, Vector Real)
 -> VowelSynthEnv)
-> IO
     ((Buffer Real -> T (T Chunk StereoChunk) StereoChunk)
      -> (Buffer Real
          -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)
      -> (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)
      -> (Vector Real -> T Chunk StereoChunk)
      -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
      -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
      -> Map Pitch (PhonemeType, Vector Real)
      -> VowelSynthEnv)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (\Buffer Real -> T (T Chunk StereoChunk) StereoChunk
filt Buffer Real -> Vector Real -> T (T Chunk StereoChunk) StereoChunk
filtRasp SampleRate Real -> Buffer Real -> T Chunk StereoChunk
filtNoise Vector Real -> T Chunk StereoChunk
smp SampleRate Real -> Real -> T EnvelopeControl Chunk
contEnv SampleRate Real -> Real -> T EnvelopeControl Chunk
percEnv Map Pitch (PhonemeType, Vector Real)
dict SampleRate Real
sr Real
vel Pitch
p ->
         case Pitch
-> Map Pitch (PhonemeType, Vector Real)
-> Maybe (PhonemeType, Vector Real)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Pitch
p Map Pitch (PhonemeType, Vector Real)
dict of
            Maybe (PhonemeType, Vector Real)
Nothing -> (WithEnvelopeControl StereoChunk -> StereoChunk)
-> T (WithEnvelopeControl StereoChunk) StereoChunk
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((WithEnvelopeControl StereoChunk -> StereoChunk)
 -> T (WithEnvelopeControl StereoChunk) StereoChunk)
-> (WithEnvelopeControl StereoChunk -> StereoChunk)
-> T (WithEnvelopeControl StereoChunk) StereoChunk
forall a b. (a -> b) -> a -> b
$ StereoChunk -> WithEnvelopeControl StereoChunk -> StereoChunk
forall a b. a -> b -> a
const StereoChunk
forall a. Storable a => Vector a
SV.empty
            Just (PhonemeType
typ, Vector Real
mask) ->
               let maskBuf :: Buffer Real
maskBuf = Vector Real -> Buffer Real
forall a. Vector a -> Buffer a
Render.buffer Vector Real
mask in
               case PhonemeType
typ of
                  Filtered EnvelopeType
env CarrierType
carrier ->
                     (case CarrierType
carrier of
                        CarrierType
Voiced -> Buffer Real -> T (T Chunk StereoChunk) StereoChunk
filt Buffer Real
maskBuf
                        CarrierType
Unvoiced -> SampleRate Real -> Buffer Real -> T Chunk StereoChunk
filtNoise SampleRate Real
sr Buffer Real
maskBuf T Chunk StereoChunk
-> T (T Chunk StereoChunk) Chunk
-> T (T Chunk StereoChunk) StereoChunk
forall b c a. T b c -> T a b -> T a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (T Chunk StereoChunk -> Chunk) -> T (T Chunk StereoChunk) Chunk
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr T Chunk StereoChunk -> Chunk
forall a b. T a b -> a
Zip.first
                        CarrierType
Rasp ->
                           Buffer Real -> Vector Real -> T (T Chunk StereoChunk) StereoChunk
filtRasp Buffer Real
maskBuf (Vector Real -> T (T Chunk StereoChunk) StereoChunk)
-> Vector Real -> T (T Chunk StereoChunk) StereoChunk
forall a b. (a -> b) -> a -> b
$
                              case SampleRate Real
sr of
                                 SampleRate Real
r ->
                                    Vector Real -> Vector Real
forall a. Storable a => Vector a -> Vector a
SVL.cycle (Vector Real -> Vector Real) -> Vector Real -> Vector Real
forall a b. (a -> b) -> a -> b
$ Int -> Vector Real -> Vector Real
forall a. Storable a => Int -> Vector a -> Vector a
SVL.take (Real -> Int
forall b. C b => Real -> b
forall a b. (C a, C b) => a -> b
round (Real -> Int) -> Real -> Int
forall a b. (a -> b) -> a -> b
$ Real
rReal -> Real -> Real
forall a. C a => a -> a -> a
/Real
20) (Vector Real -> Vector Real) -> Vector Real -> Vector Real
forall a b. (a -> b) -> a -> b
$
                                    LazySize -> Real -> Real -> Vector Real
forall y (sig :: * -> *).
(C y, Write sig y) =>
LazySize -> y -> y -> sig y
CtrlG.exponential LazySize
SigG.defaultLazySize
                                       (Real
rReal -> Real -> Real
forall a. C a => a -> a -> a
/Real
40) Real
1)
                     T (T Chunk StereoChunk) StereoChunk
-> T (WithEnvelopeControl StereoChunk) (T Chunk StereoChunk)
-> T (WithEnvelopeControl StereoChunk) StereoChunk
forall b c a. T b c -> T a b -> T a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
                     T EnvelopeControl Chunk
-> T (WithEnvelopeControl StereoChunk) (T Chunk StereoChunk)
forall (arrow :: * -> * -> *) a b.
(Arrow arrow, Transform a, Transform b) =>
arrow EnvelopeControl a -> arrow (WithEnvelopeControl b) (T a b)
zipEnvelope
                        (case EnvelopeType
env of
                           EnvelopeType
Continuous -> SampleRate Real -> Real -> T EnvelopeControl Chunk
contEnv SampleRate Real
sr Real
vel
                           EnvelopeType
Percussive -> SampleRate Real -> Real -> T EnvelopeControl Chunk
percEnv SampleRate Real
sr Real
vel)
                  PhonemeType
Sampled ->
                     Vector Real -> T Chunk StereoChunk
smp ([Vector Real] -> Vector Real
forall a. Storable a => [Vector a] -> Vector a
SVL.fromChunks ([Vector Real] -> Vector Real) -> [Vector Real] -> Vector Real
forall a b. (a -> b) -> a -> b
$ Vector Real -> [Vector Real]
forall a. a -> [a]
repeat Vector Real
mask)
                     T Chunk StereoChunk
-> T (WithEnvelopeControl StereoChunk) Chunk
-> T (WithEnvelopeControl StereoChunk) StereoChunk
forall b c a. T b c -> T a b -> T a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
                     (T Chunk StereoChunk -> Chunk) -> T (T Chunk StereoChunk) Chunk
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr T Chunk StereoChunk -> Chunk
forall a b. T a b -> a
Zip.first
                     T (T Chunk StereoChunk) Chunk
-> T (WithEnvelopeControl StereoChunk) (T Chunk StereoChunk)
-> T (WithEnvelopeControl StereoChunk) Chunk
forall b c a. T b c -> T a b -> T a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
                     T EnvelopeControl Chunk
-> T (WithEnvelopeControl StereoChunk) (T Chunk StereoChunk)
forall (arrow :: * -> * -> *) a b.
(Arrow arrow, Transform a, Transform b) =>
arrow EnvelopeControl a -> arrow (WithEnvelopeControl b) (T a b)
zipEnvelope (SampleRate Real -> Real -> T EnvelopeControl Chunk
contEnv SampleRate Real
sr Real
vel))
   IO
  ((Buffer Real -> T (T Chunk StereoChunk) StereoChunk)
   -> (Buffer Real
       -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)
   -> (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)
   -> (Vector Real -> T Chunk StereoChunk)
   -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
   -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
   -> Map Pitch (PhonemeType, Vector Real)
   -> VowelSynthEnv)
-> IO (Buffer Real -> T (T Chunk StereoChunk) StereoChunk)
-> IO
     ((Buffer Real
       -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)
      -> (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)
      -> (Vector Real -> T Chunk StereoChunk)
      -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
      -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
      -> Map Pitch (PhonemeType, Vector Real)
      -> VowelSynthEnv)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DSL
  (Buffer Real -> T (T Chunk StereoChunk) StereoChunk)
  (Element (In (Buffer Real -> T (T Chunk StereoChunk) StereoChunk)))
  (Element
     (Out (Buffer Real -> T (T Chunk StereoChunk) StereoChunk)))
-> IO (Buffer Real -> T (T Chunk StereoChunk) StereoChunk)
forall f a al b bl.
(Run f, In f ~ a, Default a, Element a ~ al, Out f ~ b, Default b,
 Element b ~ bl) =>
DSL f al bl -> IO f
CausalRender.run (DSL
   (Buffer Real -> T (T Chunk StereoChunk) StereoChunk)
   (Element (In (Buffer Real -> T (T Chunk StereoChunk) StereoChunk)))
   (Element
      (Out (Buffer Real -> T (T Chunk StereoChunk) StereoChunk)))
 -> IO (Buffer Real -> T (T Chunk StereoChunk) StereoChunk))
-> DSL
     (Buffer Real -> T (T Chunk StereoChunk) StereoChunk)
     (Element (In (Buffer Real -> T (T Chunk StereoChunk) StereoChunk)))
     (Element
        (Out (Buffer Real -> T (T Chunk StereoChunk) StereoChunk)))
-> IO (Buffer Real -> T (T Chunk StereoChunk) StereoChunk)
forall a b. (a -> b) -> a -> b
$ \Exp (StorableVector Real)
mask ->
         T (T Vector) -> T (T Vector)
forall a. T (T a) -> T (T a)
Stereo.multiValue (T (T Vector) -> T (T Vector))
-> T (T Vector, T (T Vector)) (T (T Vector))
-> T (T Vector, T (T Vector)) (T (T Vector))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          T (T Vector, T (T Vector)) (T (T Vector))
forall a. PseudoRing a => T (a, T a) (T a)
Causal.envelopeStereo
          T (T Vector, T (T Vector)) (T (T Vector))
-> T (T Vector, T (T Vector)) (T Vector, T (T Vector))
-> T (T Vector, T (T Vector)) (T (T Vector))
forall b c a. T b c -> T a b -> T a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
          T (T (T Vector)) (T (T Vector))
-> T (T Vector, T (T Vector)) (T Vector, T (T Vector))
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second
             (T (T Vector) (T Vector) -> T (T (T Vector)) (T (T Vector))
forall a b.
(Phi a, Undefined a, Phi b, Undefined b) =>
T a b -> T (T a) (T b)
Causal.stereoFromMono (Exp (StorableVector Real) -> T (T Vector) (T Vector)
forall n a v.
(Vector n a, PseudoRing a, C a, PseudoRing a, Value n a ~ v) =>
Exp (StorableVector a) -> T v v
FiltNR.convolvePacked Exp (StorableVector Real)
mask)
                  T (T (T Vector)) (T (T Vector))
-> (T (T Vector) -> T (T Vector))
-> T (T (T Vector)) (T (T Vector))
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ T (T Vector) -> T (T Vector)
forall a. T (T a) -> T (T a)
Stereo.unMultiValue))
   IO
  ((Buffer Real
    -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)
   -> (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)
   -> (Vector Real -> T Chunk StereoChunk)
   -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
   -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
   -> Map Pitch (PhonemeType, Vector Real)
   -> VowelSynthEnv)
-> IO
     (Buffer Real -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)
-> IO
     ((SampleRate Real -> Buffer Real -> T Chunk StereoChunk)
      -> (Vector Real -> T Chunk StereoChunk)
      -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
      -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
      -> Map Pitch (PhonemeType, Vector Real)
      -> VowelSynthEnv)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DSL
  (Buffer Real -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)
  (Element
     (In
        (Buffer Real
         -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)))
  (Element
     (Out
        (Buffer Real
         -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)))
-> IO
     (Buffer Real -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)
forall f a al b bl.
(Run f, In f ~ a, Default a, Element a ~ al, Out f ~ b, Default b,
 Element b ~ bl) =>
DSL f al bl -> IO f
CausalRender.run (DSL
   (Buffer Real -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)
   (Element
      (In
         (Buffer Real
          -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)))
   (Element
      (Out
         (Buffer Real
          -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)))
 -> IO
      (Buffer Real
       -> Vector Real -> T (T Chunk StereoChunk) StereoChunk))
-> DSL
     (Buffer Real -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)
     (Element
        (In
           (Buffer Real
            -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)))
     (Element
        (Out
           (Buffer Real
            -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)))
-> IO
     (Buffer Real -> Vector Real -> T (T Chunk StereoChunk) StereoChunk)
forall a b. (a -> b) -> a -> b
$ \Exp (StorableVector Real)
mask T (Element (T Vector))
env ->
         T (T Vector) -> T (T Vector)
forall a. T (T a) -> T (T a)
Stereo.multiValue (T (T Vector) -> T (T Vector))
-> T (T Vector, T (T Vector)) (T (T Vector))
-> T (T Vector, T (T Vector)) (T (T Vector))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          T (T Vector, T (T Vector)) (T (T Vector))
forall a. PseudoRing a => T (a, T a) (T a)
Causal.envelopeStereo
          T (T Vector, T (T Vector)) (T (T Vector))
-> T (T Vector, T (T Vector)) (T Vector, T (T Vector))
-> T (T Vector, T (T Vector)) (T (T Vector))
forall b c a. T b c -> T a b -> T a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
          ((T (T Vector, T Vector) (T Vector)
forall a. PseudoRing a => T (a, a) a
Causal.envelope T (T Vector, T Vector) (T Vector)
-> SignalOf T (T Vector) -> T (T Vector) (T Vector)
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process a -> process b c
$< T (Element (T Vector)) -> T (T Vector)
forall v a. (Write v, a ~ Element v) => T a -> T v
SigPS.pack T (Element (T Vector))
env)
           T (T Vector) (T Vector)
-> T (T (T Vector)) (T (T Vector))
-> T (T Vector, T (T Vector)) (T Vector, T (T Vector))
forall b c b' c'. T b c -> T b' c' -> T (b, b') (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
***
           (T (T Vector) (T Vector) -> T (T (T Vector)) (T (T Vector))
forall a b.
(Phi a, Undefined a, Phi b, Undefined b) =>
T a b -> T (T a) (T b)
Causal.stereoFromMono (Exp (StorableVector Real) -> T (T Vector) (T Vector)
forall n a v.
(Vector n a, PseudoRing a, C a, PseudoRing a, Value n a ~ v) =>
Exp (StorableVector a) -> T v v
FiltNR.convolvePacked Exp (StorableVector Real)
mask)
               T (T (T Vector)) (T (T Vector))
-> (T (T Vector) -> T (T Vector))
-> T (T (T Vector)) (T (T Vector))
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ T (T Vector) -> T (T Vector)
forall a. T (T a) -> T (T a)
Stereo.unMultiValue)))
   IO
  ((SampleRate Real -> Buffer Real -> T Chunk StereoChunk)
   -> (Vector Real -> T Chunk StereoChunk)
   -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
   -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
   -> Map Pitch (PhonemeType, Vector Real)
   -> VowelSynthEnv)
-> IO (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)
-> IO
     ((Vector Real -> T Chunk StereoChunk)
      -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
      -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
      -> Map Pitch (PhonemeType, Vector Real)
      -> VowelSynthEnv)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DSL
  (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)
  (Element
     (In (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)))
  (Element
     (Out (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)))
-> IO (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)
forall f a al b bl.
(Run f, In f ~ a, Default a, Element a ~ al, Out f ~ b, Default b,
 Element b ~ bl) =>
DSL f al bl -> IO f
CausalRender.run (DSL
   (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)
   (Element
      (In (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)))
   (Element
      (Out (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)))
 -> IO (SampleRate Real -> Buffer Real -> T Chunk StereoChunk))
-> DSL
     (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)
     (Element
        (In (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)))
     (Element
        (Out (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)))
-> IO (SampleRate Real -> Buffer Real -> T Chunk StereoChunk)
forall a b. (a -> b) -> a -> b
$
        (SampleRate (Exp Real) -> Exp Real -> Exp Real)
-> Exp Real
-> (Exp Real
    -> SampleRate (Exp Real)
    -> Exp (StorableVector Real)
    -> T (T Vector) (T (T Vector)))
-> SampleRate (Exp Real)
-> Exp (StorableVector Real)
-> T (T Vector) (T (T Vector))
forall a b c d.
(SampleRate a -> b -> c)
-> b -> (c -> SampleRate a -> d) -> SampleRate a -> d
constant SampleRate (Exp Real) -> Exp Real -> Exp Real
forall a. C a => SampleRate a -> a -> a
noiseReference Exp Real
1e7 ((Exp Real
  -> SampleRate (Exp Real)
  -> Exp (StorableVector Real)
  -> T (T Vector) (T (T Vector)))
 -> SampleRate (Exp Real)
 -> Exp (StorableVector Real)
 -> T (T Vector) (T (T Vector)))
-> (Exp Real
    -> SampleRate (Exp Real)
    -> Exp (StorableVector Real)
    -> T (T Vector) (T (T Vector)))
-> SampleRate (Exp Real)
-> Exp (StorableVector Real)
-> T (T Vector) (T (T Vector))
forall a b. (a -> b) -> a -> b
$ \Exp Real
noiseRef SampleRate (Exp Real)
_sr Exp (StorableVector Real)
mask ->
         T (T Vector) -> T (T Vector)
forall a. T (T a) -> T (T a)
Stereo.multiValue (T (T Vector) -> T (T Vector))
-> T (T Vector, T (T Vector)) (T (T Vector))
-> T (T Vector, T (T Vector)) (T (T Vector))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         T (T Vector, T (T Vector)) (T (T Vector))
forall a. PseudoRing a => T (a, T a) (T a)
Causal.envelopeStereo T (T Vector, T (T Vector)) (T (T Vector))
-> SignalOf T (T (T Vector)) -> T (T Vector) (T (T Vector))
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process b -> process a c
$>
             (Exp Word32 -> T (T Vector)) -> T (Exp Word32) -> T (T (T Vector))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> T a -> f (T b)
traverse
                (\Exp Word32
seed ->
                   Exp (StorableVector Real) -> T (T Vector) (T Vector)
forall n a v.
(Vector n a, PseudoRing a, C a, PseudoRing a, Value n a ~ v) =>
Exp (StorableVector a) -> T v v
FiltNR.convolvePacked Exp (StorableVector Real)
mask T (T Vector) (T Vector)
-> SignalOf T (T Vector) -> SignalOf T (T Vector)
forall (process :: * -> * -> *) a b.
C process =>
process a b -> SignalOf process a -> SignalOf process b
$* Exp Word32 -> Exp Real -> T (T Vector)
forall n a ar.
(NativeFloating n a ar, PseudoRing a, IntegerConstant a,
 Algebraic a, RationalConstant a, Positive n,
 Positive (n :*: D32)) =>
Exp Word32 -> Exp a -> T (Serial n a)
SigPS.noise Exp Word32
seed Exp Real
noiseRef)
                (Exp Word32 -> Exp Word32 -> T (Exp Word32)
forall a. a -> a -> T a
Stereo.cons Exp Word32
42 Exp Word32
23))
   IO
  ((Vector Real -> T Chunk StereoChunk)
   -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
   -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
   -> Map Pitch (PhonemeType, Vector Real)
   -> VowelSynthEnv)
-> IO (Vector Real -> T Chunk StereoChunk)
-> IO
     ((SampleRate Real -> Real -> T EnvelopeControl Chunk)
      -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
      -> Map Pitch (PhonemeType, Vector Real)
      -> VowelSynthEnv)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DSL
  (Vector Real -> T Chunk StereoChunk)
  (Element (In (Vector Real -> T Chunk StereoChunk)))
  (Element (Out (Vector Real -> T Chunk StereoChunk)))
-> IO (Vector Real -> T Chunk StereoChunk)
forall f a al b bl.
(Run f, In f ~ a, Default a, Element a ~ al, Out f ~ b, Default b,
 Element b ~ bl) =>
DSL f al bl -> IO f
CausalRender.run (DSL
   (Vector Real -> T Chunk StereoChunk)
   (Element (In (Vector Real -> T Chunk StereoChunk)))
   (Element (Out (Vector Real -> T Chunk StereoChunk)))
 -> IO (Vector Real -> T Chunk StereoChunk))
-> DSL
     (Vector Real -> T Chunk StereoChunk)
     (Element (In (Vector Real -> T Chunk StereoChunk)))
     (Element (Out (Vector Real -> T Chunk StereoChunk)))
-> IO (Vector Real -> T Chunk StereoChunk)
forall a b. (a -> b) -> a -> b
$ \T (Element (T Vector))
smp ->
         (\T Vector
x -> T Vector -> T Vector -> T (T Vector)
forall a. T a -> T a -> T (T a)
Stereo.consMultiValue T Vector
x T Vector
x)
         (T Vector -> T (T Vector))
-> T (T Vector) (T Vector) -> T (T Vector) (T (T Vector))
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
         (T (T Vector, T Vector) (T Vector)
forall a. PseudoRing a => T (a, a) a
Causal.envelope T (T Vector, T Vector) (T Vector)
-> SignalOf T (T Vector) -> T (T Vector) (T Vector)
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process b -> process a c
$> T (Element (T Vector)) -> T (T Vector)
forall v a. (Write v, a ~ Element v) => T a -> T v
SigPS.pack T (Element (T Vector))
smp))
   IO
  ((SampleRate Real -> Real -> T EnvelopeControl Chunk)
   -> (SampleRate Real -> Real -> T EnvelopeControl Chunk)
   -> Map Pitch (PhonemeType, Vector Real)
   -> VowelSynthEnv)
-> IO (SampleRate Real -> Real -> T EnvelopeControl Chunk)
-> IO
     ((SampleRate Real -> Real -> T EnvelopeControl Chunk)
      -> Map Pitch (PhonemeType, Vector Real) -> VowelSynthEnv)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (SampleRate Real -> Real -> T EnvelopeControl Chunk)
stringControlledEnvelope
   IO
  ((SampleRate Real -> Real -> T EnvelopeControl Chunk)
   -> Map Pitch (PhonemeType, Vector Real) -> VowelSynthEnv)
-> IO (SampleRate Real -> Real -> T EnvelopeControl Chunk)
-> IO (Map Pitch (PhonemeType, Vector Real) -> VowelSynthEnv)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Real
-> IO (SampleRate Real -> Real -> T EnvelopeControl Chunk)
pingControlledEnvelope (Real -> Maybe Real
forall a. a -> Maybe a
Just Real
0.01)


phonemeRr,
   phonemeU,
   phonemeO,
   phonemeA,
   phonemeOe,
   phonemeOn,
   phonemeUe,
   phonemeUn,
   phonemeAe,
   phonemeE,
   phonemeI,

   phonemeNg,
   phonemeL,
   phonemeM,
   phonemeN,
   phonemeR,
   phonemeJ,

   phonemeW,
   phonemeF,
   phonemeSch,
   phonemeH,
   phonemeTh,
   phonemeIch,
   phonemeAch,
   phonemeS,

   phonemeP,
   phonemeK,
   phonemeT,

   phonemeB,
   phonemeG,
   phonemeD
      :: (PhonemeType, FilePath)
phonemeU :: (PhonemeType, String)
phonemeU   = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, String
"u")
phonemeO :: (PhonemeType, String)
phonemeO   = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, String
"o")
phonemeA :: (PhonemeType, String)
phonemeA   = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, String
"a")
phonemeOe :: (PhonemeType, String)
phonemeOe  = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, String
"oe")
phonemeOn :: (PhonemeType, String)
phonemeOn  = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, String
"on")
phonemeUe :: (PhonemeType, String)
phonemeUe  = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, String
"ue")
phonemeUn :: (PhonemeType, String)
phonemeUn  = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, String
"un")
phonemeAe :: (PhonemeType, String)
phonemeAe  = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, String
"ae")
phonemeE :: (PhonemeType, String)
phonemeE   = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, String
"e")
phonemeI :: (PhonemeType, String)
phonemeI   = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, String
"i")

phonemeNg :: (PhonemeType, String)
phonemeNg  = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, String
"ng")
phonemeL :: (PhonemeType, String)
phonemeL   = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, String
"l")
phonemeM :: (PhonemeType, String)
phonemeM   = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, String
"m")
phonemeN :: (PhonemeType, String)
phonemeN   = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, String
"n")
phonemeR :: (PhonemeType, String)
phonemeR   = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, String
"r")
phonemeJ :: (PhonemeType, String)
phonemeJ   = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, String
"j")

phonemeW :: (PhonemeType, String)
phonemeW   = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Unvoiced, String
"w")
phonemeF :: (PhonemeType, String)
phonemeF   = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Unvoiced, String
"f")
phonemeSch :: (PhonemeType, String)
phonemeSch = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Unvoiced, String
"sch")
phonemeH :: (PhonemeType, String)
phonemeH   = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Unvoiced, String
"h")
phonemeTh :: (PhonemeType, String)
phonemeTh  = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Unvoiced, String
"th")
phonemeIch :: (PhonemeType, String)
phonemeIch = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Unvoiced, String
"ich")
phonemeAch :: (PhonemeType, String)
phonemeAch = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Unvoiced, String
"ach")
phonemeS :: (PhonemeType, String)
phonemeS   = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Unvoiced, String
"s")

phonemeP :: (PhonemeType, String)
phonemeP  = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Percussive CarrierType
Unvoiced, String
"p")
phonemeK :: (PhonemeType, String)
phonemeK  = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Percussive CarrierType
Unvoiced, String
"k")
phonemeT :: (PhonemeType, String)
phonemeT  = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Percussive CarrierType
Unvoiced, String
"t")

phonemeB :: (PhonemeType, String)
phonemeB  = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Percussive CarrierType
Voiced, String
"b")
phonemeG :: (PhonemeType, String)
phonemeG  = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Percussive CarrierType
Voiced, String
"g")
phonemeD :: (PhonemeType, String)
phonemeD  = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Percussive CarrierType
Voiced, String
"d")

-- phonemeRr = (Sampled, "r")) :
phonemeRr :: (PhonemeType, String)
phonemeRr = (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Rasp, String
"ng")


maskNamesKeyboard :: Map VoiceMsg.Pitch (PhonemeType, FilePath)
maskNamesKeyboard :: Map Pitch (PhonemeType, String)
maskNamesKeyboard =
   [(Pitch, (PhonemeType, String))] -> Map Pitch (PhonemeType, String)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Pitch, (PhonemeType, String))]
 -> Map Pitch (PhonemeType, String))
-> [(Pitch, (PhonemeType, String))]
-> Map Pitch (PhonemeType, String)
forall a b. (a -> b) -> a -> b
$
   [Pitch]
-> [(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> Pitch
VoiceMsg.toPitch Int
0 ..] ([(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))])
-> [(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))]
forall a b. (a -> b) -> a -> b
$

   (PhonemeType, String)
phonemeL (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:   (PhonemeType, String)
phonemeNg (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
   (PhonemeType, String)
phonemeM (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:   (PhonemeType, String)
phonemeJ (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
   (PhonemeType, String)
phonemeN (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
   (PhonemeType, String)
phonemeR (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
                (PhonemeType, String)
phonemeP (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
   (PhonemeType, String)
phonemeB (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:   (PhonemeType, String)
phonemeK (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
   (PhonemeType, String)
phonemeG (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:   (PhonemeType, String)
phonemeT (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
   (PhonemeType, String)
phonemeD (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:

   (PhonemeType, String)
phonemeU (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:   (PhonemeType, String)
phonemeUe (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
   (PhonemeType, String)
phonemeO (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:   (PhonemeType, String)
phonemeOe (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
   (PhonemeType, String)
phonemeA (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
   (PhonemeType, String)
phonemeE (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:   (PhonemeType, String)
phonemeAe (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
   (PhonemeType, String)
phonemeI (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
                (PhonemeType, String)
phonemeRr (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:

   (PhonemeType, String)
phonemeW (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:   (PhonemeType, String)
phonemeF (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
   (PhonemeType, String)
phonemeSch (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
   (PhonemeType, String)
phonemeH (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:   (PhonemeType, String)
phonemeTh (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
   (PhonemeType, String)
phonemeIch (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
: (PhonemeType, String)
phonemeAch (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
   (PhonemeType, String)
phonemeS (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
   []

loadMasksKeyboard :: IO (Map VoiceMsg.Pitch (PhonemeType, SV.Vector Real))
loadMasksKeyboard :: IO (Map Pitch (PhonemeType, Vector Real))
loadMasksKeyboard =
   (Map Pitch (PhonemeType, Vector Real)
 -> Map Pitch (PhonemeType, Vector Real))
-> IO (Map Pitch (PhonemeType, Vector Real))
-> IO (Map Pitch (PhonemeType, Vector Real))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pitch
-> (PhonemeType, Vector Real)
-> Map Pitch (PhonemeType, Vector Real)
-> Map Pitch (PhonemeType, Vector Real)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Int -> Pitch
VoiceMsg.toPitch Int
29)
           (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, Real -> Vector Real
forall a. Storable a => a -> Vector a
SV.singleton Real
1)) (IO (Map Pitch (PhonemeType, Vector Real))
 -> IO (Map Pitch (PhonemeType, Vector Real)))
-> IO (Map Pitch (PhonemeType, Vector Real))
-> IO (Map Pitch (PhonemeType, Vector Real))
forall a b. (a -> b) -> a -> b
$
   Map Pitch (PhonemeType, String)
-> IO (Map Pitch (PhonemeType, Vector Real))
forall (dict :: * -> *).
Traversable dict =>
dict (PhonemeType, String) -> IO (dict (PhonemeType, Vector Real))
loadMasks Map Pitch (PhonemeType, String)
maskNamesKeyboard


maskNamesGrouped :: Map VoiceMsg.Pitch (PhonemeType, FilePath)
maskNamesGrouped :: Map Pitch (PhonemeType, String)
maskNamesGrouped =
   [(Pitch, (PhonemeType, String))] -> Map Pitch (PhonemeType, String)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Pitch, (PhonemeType, String))]
 -> Map Pitch (PhonemeType, String))
-> [(Pitch, (PhonemeType, String))]
-> Map Pitch (PhonemeType, String)
forall a b. (a -> b) -> a -> b
$

   ([Pitch]
-> [(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> Pitch
VoiceMsg.toPitch Int
0 ..] ([(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))])
-> [(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))]
forall a b. (a -> b) -> a -> b
$
      (PhonemeType, String)
phonemeU (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeO (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeA (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeOe (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeUe (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeAe (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeE (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeI (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeOn (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeUn (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      [])
   [(Pitch, (PhonemeType, String))]
-> [(Pitch, (PhonemeType, String))]
-> [(Pitch, (PhonemeType, String))]
forall a. [a] -> [a] -> [a]
++
   ([Pitch]
-> [(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> Pitch
VoiceMsg.toPitch Int
16 ..] ([(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))])
-> [(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))]
forall a b. (a -> b) -> a -> b
$
      (PhonemeType, String)
phonemeJ (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeL (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeM (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeN (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeNg (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeR (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      [])
   [(Pitch, (PhonemeType, String))]
-> [(Pitch, (PhonemeType, String))]
-> [(Pitch, (PhonemeType, String))]
forall a. [a] -> [a] -> [a]
++
   ([Pitch]
-> [(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> Pitch
VoiceMsg.toPitch Int
32 ..] ([(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))])
-> [(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))]
forall a b. (a -> b) -> a -> b
$
      (PhonemeType, String)
phonemeW (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeF (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeSch (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeH (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeTh (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeIch (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeAch (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeS (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      [])
   [(Pitch, (PhonemeType, String))]
-> [(Pitch, (PhonemeType, String))]
-> [(Pitch, (PhonemeType, String))]
forall a. [a] -> [a] -> [a]
++
   ([Pitch]
-> [(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> Pitch
VoiceMsg.toPitch Int
48 ..] ([(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))])
-> [(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))]
forall a b. (a -> b) -> a -> b
$
      (PhonemeType, String)
phonemeRr (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      [])
   [(Pitch, (PhonemeType, String))]
-> [(Pitch, (PhonemeType, String))]
-> [(Pitch, (PhonemeType, String))]
forall a. [a] -> [a] -> [a]
++
   ([Pitch]
-> [(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> Pitch
VoiceMsg.toPitch Int
64 ..] ([(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))])
-> [(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))]
forall a b. (a -> b) -> a -> b
$
      (PhonemeType, String)
phonemeP (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeK (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeT (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      [])
   [(Pitch, (PhonemeType, String))]
-> [(Pitch, (PhonemeType, String))]
-> [(Pitch, (PhonemeType, String))]
forall a. [a] -> [a] -> [a]
++
   ([Pitch]
-> [(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> Pitch
VoiceMsg.toPitch Int
80 ..] ([(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))])
-> [(PhonemeType, String)] -> [(Pitch, (PhonemeType, String))]
forall a b. (a -> b) -> a -> b
$
      (PhonemeType, String)
phonemeB (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeG (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      (PhonemeType, String)
phonemeD (PhonemeType, String)
-> [(PhonemeType, String)] -> [(PhonemeType, String)]
forall a. a -> [a] -> [a]
:
      [])

loadMasksGrouped :: IO (Map VoiceMsg.Pitch (PhonemeType, SV.Vector Real))
loadMasksGrouped :: IO (Map Pitch (PhonemeType, Vector Real))
loadMasksGrouped =
   (Map Pitch (PhonemeType, Vector Real)
 -> Map Pitch (PhonemeType, Vector Real))
-> IO (Map Pitch (PhonemeType, Vector Real))
-> IO (Map Pitch (PhonemeType, Vector Real))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pitch
-> (PhonemeType, Vector Real)
-> Map Pitch (PhonemeType, Vector Real)
-> Map Pitch (PhonemeType, Vector Real)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Int -> Pitch
VoiceMsg.toPitch Int
127)
           (EnvelopeType -> CarrierType -> PhonemeType
Filtered EnvelopeType
Continuous CarrierType
Voiced, Real -> Vector Real
forall a. Storable a => a -> Vector a
SV.singleton Real
8)) (IO (Map Pitch (PhonemeType, Vector Real))
 -> IO (Map Pitch (PhonemeType, Vector Real)))
-> IO (Map Pitch (PhonemeType, Vector Real))
-> IO (Map Pitch (PhonemeType, Vector Real))
forall a b. (a -> b) -> a -> b
$
   Map Pitch (PhonemeType, String)
-> IO (Map Pitch (PhonemeType, Vector Real))
forall (dict :: * -> *).
Traversable dict =>
dict (PhonemeType, String) -> IO (dict (PhonemeType, Vector Real))
loadMasks Map Pitch (PhonemeType, String)
maskNamesGrouped


loadMasks ::
   (Traversable dict) =>
   dict (PhonemeType, FilePath) ->
   IO (dict (PhonemeType, SV.Vector Real))
loadMasks :: forall (dict :: * -> *).
Traversable dict =>
dict (PhonemeType, String) -> IO (dict (PhonemeType, Vector Real))
loadMasks dict (PhonemeType, String)
maskNames =
   dict (PhonemeType, String)
-> ((PhonemeType, String) -> IO (PhonemeType, Vector Real))
-> IO (dict (PhonemeType, Vector Real))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM dict (PhonemeType, String)
maskNames (((PhonemeType, String) -> IO (PhonemeType, Vector Real))
 -> IO (dict (PhonemeType, Vector Real)))
-> ((PhonemeType, String) -> IO (PhonemeType, Vector Real))
-> IO (dict (PhonemeType, Vector Real))
forall a b. (a -> b) -> a -> b
$ \(PhonemeType
typ, String
name) ->
      (,) PhonemeType
typ (Vector Real -> (PhonemeType, Vector Real))
-> (Vector Real -> Vector Real)
-> Vector Real
-> (PhonemeType, Vector Real)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Vector Real] -> Vector Real
forall a. Storable a => [Vector a] -> Vector a
SV.concat ([Vector Real] -> Vector Real)
-> (Vector Real -> [Vector Real]) -> Vector Real -> Vector Real
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Vector Real -> [Vector Real]
forall a. Vector a -> [Vector a]
SVL.chunks (Vector Real -> (PhonemeType, Vector Real))
-> IO (Vector Real) -> IO (PhonemeType, Vector Real)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      File Rel -> IO (Vector Real)
forall ar. AbsRel ar => File ar -> IO (Vector Real)
Sample.load
         (String -> RelDir
Path.relDir (if PhonemeType
typPhonemeType -> PhonemeType -> Bool
forall a. Eq a => a -> a -> Bool
==PhonemeType
Sampled then String
"phoneme" else String
"mask")
            RelDir -> File Rel -> File Rel
forall os ar fd. DirPath os ar -> RelPath os fd -> Path os ar fd
</> String -> File Rel
Path.relFile String
name File Rel -> String -> File Rel
forall os ar. FilePath os ar -> String -> FilePath os ar
<.> String
"wav")



type Input a = FP.Input (SampleRate Real) a

plugUniFilterParameter ::
   Input a (Control Real) ->
   Input a (Control Frequency) ->
   FP.T (SampleRate Real) a (UniFilter.Parameter (MultiValue.T Real))
plugUniFilterParameter :: forall a.
Input a (T ShortStrictTime Real)
-> Input a (Control Frequency)
-> T (SampleRate Real) a (Parameter (T Real))
plugUniFilterParameter Input a (T ShortStrictTime Real)
reson Input a (Control Frequency)
freq =
   (T (Parameter Real) -> Parameter (T Real))
-> T (SampleRate Real) a (T (Parameter Real))
-> T (SampleRate Real) a (Parameter (T Real))
forall a b.
(a -> b) -> T (SampleRate Real) a a -> T (SampleRate Real) a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T (Parameter Real) -> Parameter (T Real)
forall a. T (Parameter a) -> Parameter (T a)
UniFilterL.unMultiValueParameter (T (SampleRate Real) a (T (Parameter Real))
 -> T (SampleRate Real) a (Parameter (T Real)))
-> T (SampleRate Real) a (T (Parameter Real))
-> T (SampleRate Real) a (Parameter (T Real))
forall a b. (a -> b) -> a -> b
$
   Input (SampleRate Real) a (T ShortStrictTime (Parameter Real))
-> T (SampleRate Real)
     a
     (Element (T ShortStrictTime (Parameter Real)))
forall b pp a.
(Read b, Default b) =>
Input pp a b -> T pp a (Element b)
FP.plug (Input (SampleRate Real) a (T ShortStrictTime (Parameter Real))
 -> T (SampleRate Real)
      a
      (Element (T ShortStrictTime (Parameter Real))))
-> Input (SampleRate Real) a (T ShortStrictTime (Parameter Real))
-> T (SampleRate Real)
     a
     (Element (T ShortStrictTime (Parameter Real)))
forall a b. (a -> b) -> a -> b
$
   (T ShortStrictTime Real
 -> Control Frequency
 -> SampleRate Real
 -> T ShortStrictTime (Parameter Real))
-> Input a (T ShortStrictTime Real)
-> Input a (Control Frequency)
-> ReaderT (SampleRate Real, a) Identity (SampleRate Real)
-> Input (SampleRate Real) a (T ShortStrictTime (Parameter Real))
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3
      (\T ShortStrictTime Real
resonChunk Control Frequency
freqChunk SampleRate Real
sr ->
         (Real -> Real -> Parameter Real)
-> T ShortStrictTime Real
-> T ShortStrictTime Real
-> T ShortStrictTime (Parameter Real)
forall time a b c.
C time =>
(a -> b -> c) -> T time a -> T time b -> T time c
PC.zipWith
            (\ Real
r Real
f -> Pole Real -> Parameter Real
forall a. C a => Pole a -> Parameter a
UniFilter.parameter (Pole Real -> Parameter Real) -> Pole Real -> Parameter Real
forall a b. (a -> b) -> a -> b
$ Real -> Real -> Pole Real
forall a. a -> a -> Pole a
Pole Real
r Real
f)
            T ShortStrictTime Real
resonChunk (T ShortStrictTime Real -> T ShortStrictTime (Parameter Real))
-> T ShortStrictTime Real -> T ShortStrictTime (Parameter Real)
forall a b. (a -> b) -> a -> b
$ SampleRate Real -> Control Frequency -> T ShortStrictTime Real
forall (f :: * -> *).
Functor f =>
SampleRate Real -> f Frequency -> f Real
frequencyControl SampleRate Real
sr Control Frequency
freqChunk)
      Input a (T ShortStrictTime Real)
reson Input a (Control Frequency)
freq ReaderT (SampleRate Real, a) Identity (SampleRate Real)
forall pp a. Input pp a pp
FP.askParameter


type FormantControl =
        Zip.T (Control Real)
           (Zip.T (Control Real) (Control Frequency))

singleFormant ::
   (Input inp (Control Real),
      (Input inp (Control Real), Input inp (Control Frequency))) ->
   Input inp StereoChunk ->
   FP.T (SampleRate Real) inp (MultiValue.T (Stereo.T Vector))
singleFormant :: forall inp.
(Input inp (T ShortStrictTime Real),
 (Input inp (T ShortStrictTime Real),
  Input inp (Control Frequency)))
-> Input inp StereoChunk -> T (SampleRate Real) inp (T (T Vector))
singleFormant (Input inp (T ShortStrictTime Real)
amp, (Input inp (T ShortStrictTime Real)
reson, Input inp (Control Frequency)
freq)) Input inp StereoChunk
x =
   T (T Vector) -> T (T Vector)
forall a. T (T a) -> T (T a)
Stereo.multiValue (T (T Vector) -> T (T Vector))
-> T (T Vector, T (T Vector)) (T (T Vector))
-> T (T Vector, T (T Vector)) (T (T Vector))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
   T (T Vector, T (T Vector)) (T (T Vector))
forall a. PseudoRing a => T (a, T a) (T a)
Causal.envelopeStereo T (T Vector, T (T Vector)) (T (T Vector))
-> T (SampleRate Real) inp (T Vector, T (T Vector))
-> T (SampleRate Real) inp (T (T Vector))
forall a b pp inp. T a b -> T pp inp a -> T pp inp b
$&
      ((Exp Real -> Exp Vector) -> T (T Real) (T Vector)
forall ae a be b.
(Aggregate ae a, Aggregate be b) =>
(ae -> be) -> T a b
Causal.map Exp Real -> Exp Vector
forall n a. (Positive n, C a) => Exp a -> Exp (T n a)
Serial.upsample T (T Real) (T Vector)
-> T (SampleRate Real) inp (T Real)
-> T (SampleRate Real) inp (T Vector)
forall a b pp inp. T a b -> T pp inp a -> T pp inp b
$& Input inp (T ShortStrictTime Real)
-> T (SampleRate Real) inp (Element (T ShortStrictTime Real))
forall b pp a.
(Read b, Default b) =>
Input pp a b -> T pp a (Element b)
FP.plug Input inp (T ShortStrictTime Real)
amp)
      T (SampleRate Real) inp (T Vector)
-> T (SampleRate Real) inp (T (T Vector))
-> T (SampleRate Real) inp (T Vector, T (T Vector))
forall pp inp a b. T pp inp a -> T pp inp b -> T pp inp (a, b)
&|&
      (T (Parameter (T Real), T Vector) (T Vector)
-> T (Parameter (T Real), T (T Vector)) (T (T Vector))
forall a b c.
(Phi a, Phi b, Phi c, Undefined a, Undefined b, Undefined c) =>
T (c, a) b -> T (c, T a) (T b)
Causal.stereoFromMonoControlled
           (Result (T Vector) -> T Vector
forall a. Result a -> a
UniFilter.bandpass (Result (T Vector) -> T Vector)
-> T (Parameter (T Real), T Vector) (Result (T Vector))
-> T (Parameter (T Real), T Vector) (T Vector)
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< T (Parameter (T Real), T Vector) (Result (T Vector))
forall parameter a b. C parameter a b => T (parameter, a) b
CtrlPS.process) T (Parameter (T Real), T (T Vector)) (T (T Vector))
-> T (SampleRate Real) inp (Parameter (T Real), T (T Vector))
-> T (SampleRate Real) inp (T (T Vector))
forall a b pp inp. T a b -> T pp inp a -> T pp inp b
$&
         Input inp (T ShortStrictTime Real)
-> Input inp (Control Frequency)
-> T (SampleRate Real) inp (Parameter (T Real))
forall a.
Input a (T ShortStrictTime Real)
-> Input a (Control Frequency)
-> T (SampleRate Real) a (Parameter (T Real))
plugUniFilterParameter Input inp (T ShortStrictTime Real)
reson Input inp (Control Frequency)
freq
         T (SampleRate Real) inp (Parameter (T Real))
-> T (SampleRate Real) inp (T (T Vector))
-> T (SampleRate Real) inp (Parameter (T Real), T (T Vector))
forall pp inp a b. T pp inp a -> T pp inp b -> T pp inp (a, b)
&|&
         (T (T Vector) -> T (T Vector)
forall a. T (T a) -> T (T a)
Stereo.unMultiValue (T (T Vector) -> T (T Vector))
-> T (SampleRate Real) inp (T (T Vector))
-> T (SampleRate Real) inp (T (T Vector))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Input inp StereoChunk
-> T (SampleRate Real) inp (Element StereoChunk)
forall b pp a.
(Read b, Default b) =>
Input pp a b -> T pp a (Element b)
FP.plug Input inp StereoChunk
x))

filterFormant ::
   IO (SampleRate Real ->
       PIO.T
          (Zip.T FormantControl StereoChunk)
          StereoChunk)
filterFormant :: IO
  (SampleRate Real -> T (T FormantControl StereoChunk) StereoChunk)
filterFormant =
   ((SampleRate Real
  -> () -> T (T FormantControl StereoChunk) StereoChunk)
 -> SampleRate Real -> T (T FormantControl StereoChunk) StereoChunk)
-> IO
     (SampleRate Real
      -> () -> T (T FormantControl StereoChunk) StereoChunk)
-> IO
     (SampleRate Real -> T (T FormantControl StereoChunk) StereoChunk)
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA
      (\SampleRate Real
-> () -> T (T FormantControl StereoChunk) StereoChunk
filt SampleRate Real
sr -> SampleRate Real
-> () -> T (T FormantControl StereoChunk) StereoChunk
filt SampleRate Real
sr ())
      ((Arguments
   (Input (SampleRate Real) (T FormantControl StereoChunk))
   (T FormantControl StereoChunk)
 -> Exp ()
 -> T (SampleRate Real)
      (T FormantControl StereoChunk)
      (Element StereoChunk))
-> IO
     (SampleRate Real
      -> () -> T (T FormantControl StereoChunk) StereoChunk)
forall pl a b pp.
(C pl, MakeArguments a, Default b) =>
(Arguments (Input pp a) a -> Exp pl -> T pp a (Element b))
-> IO (pp -> pl -> T a b)
FP.withArgs ((Arguments
    (Input (SampleRate Real) (T FormantControl StereoChunk))
    (T FormantControl StereoChunk)
  -> Exp ()
  -> T (SampleRate Real)
       (T FormantControl StereoChunk)
       (Element StereoChunk))
 -> IO
      (SampleRate Real
       -> () -> T (T FormantControl StereoChunk) StereoChunk))
-> (Arguments
      (Input (SampleRate Real) (T FormantControl StereoChunk))
      (T FormantControl StereoChunk)
    -> Exp ()
    -> T (SampleRate Real)
         (T FormantControl StereoChunk)
         (Element StereoChunk))
-> IO
     (SampleRate Real
      -> () -> T (T FormantControl StereoChunk) StereoChunk)
forall a b. (a -> b) -> a -> b
$ \((Input (T FormantControl StereoChunk) (T ShortStrictTime Real),
 (Input (T FormantControl StereoChunk) (T ShortStrictTime Real),
  Input (T FormantControl StereoChunk) (Control Frequency)))
fmt, Input (T FormantControl StereoChunk) StereoChunk
x) Exp ()
_unit -> (Input (T FormantControl StereoChunk) (T ShortStrictTime Real),
 (Input (T FormantControl StereoChunk) (T ShortStrictTime Real),
  Input (T FormantControl StereoChunk) (Control Frequency)))
-> Input (T FormantControl StereoChunk) StereoChunk
-> T (SampleRate Real)
     (T FormantControl StereoChunk)
     (T (T Vector))
forall inp.
(Input inp (T ShortStrictTime Real),
 (Input inp (T ShortStrictTime Real),
  Input inp (Control Frequency)))
-> Input inp StereoChunk -> T (SampleRate Real) inp (T (T Vector))
singleFormant (Input (T FormantControl StereoChunk) (T ShortStrictTime Real),
 (Input (T FormantControl StereoChunk) (T ShortStrictTime Real),
  Input (T FormantControl StereoChunk) (Control Frequency)))
fmt Input (T FormantControl StereoChunk) StereoChunk
x)

filterFormants ::
   IO (SampleRate Real ->
       PIO.T (Zip.T
                 (Zip.T FormantControl
                     (Zip.T FormantControl
                         (Zip.T FormantControl
                             (Zip.T FormantControl FormantControl))))
                 StereoChunk)
             StereoChunk)
filterFormants :: IO
  (SampleRate Real
   -> T (T (T FormantControl
              (T FormantControl
                 (T FormantControl (T FormantControl FormantControl))))
           StereoChunk)
        StereoChunk)
filterFormants =
   ((SampleRate Real
  -> ()
  -> T (T (T FormantControl
             (T FormantControl
                (T FormantControl (T FormantControl FormantControl))))
          StereoChunk)
       StereoChunk)
 -> SampleRate Real
 -> T (T (T FormantControl
            (T FormantControl
               (T FormantControl (T FormantControl FormantControl))))
         StereoChunk)
      StereoChunk)
-> IO
     (SampleRate Real
      -> ()
      -> T (T (T FormantControl
                 (T FormantControl
                    (T FormantControl (T FormantControl FormantControl))))
              StereoChunk)
           StereoChunk)
-> IO
     (SampleRate Real
      -> T (T (T FormantControl
                 (T FormantControl
                    (T FormantControl (T FormantControl FormantControl))))
              StereoChunk)
           StereoChunk)
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA
      (\SampleRate Real
-> ()
-> T (T (T FormantControl
           (T FormantControl
              (T FormantControl (T FormantControl FormantControl))))
        StereoChunk)
     StereoChunk
filt SampleRate Real
sr -> SampleRate Real
-> ()
-> T (T (T FormantControl
           (T FormantControl
              (T FormantControl (T FormantControl FormantControl))))
        StereoChunk)
     StereoChunk
filt SampleRate Real
sr ())
      ((Arguments
   (Input
      (SampleRate Real)
      (T (T FormantControl
            (T FormantControl
               (T FormantControl (T FormantControl FormantControl))))
         StereoChunk))
   (T (T FormantControl
         (T FormantControl
            (T FormantControl (T FormantControl FormantControl))))
      StereoChunk)
 -> Exp ()
 -> T (SampleRate Real)
      (T (T FormantControl
            (T FormantControl
               (T FormantControl (T FormantControl FormantControl))))
         StereoChunk)
      (Element StereoChunk))
-> IO
     (SampleRate Real
      -> ()
      -> T (T (T FormantControl
                 (T FormantControl
                    (T FormantControl (T FormantControl FormantControl))))
              StereoChunk)
           StereoChunk)
forall pl a b pp.
(C pl, MakeArguments a, Default b) =>
(Arguments (Input pp a) a -> Exp pl -> T pp a (Element b))
-> IO (pp -> pl -> T a b)
FP.withArgs ((Arguments
    (Input
       (SampleRate Real)
       (T (T FormantControl
             (T FormantControl
                (T FormantControl (T FormantControl FormantControl))))
          StereoChunk))
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
  -> Exp ()
  -> T (SampleRate Real)
       (T (T FormantControl
             (T FormantControl
                (T FormantControl (T FormantControl FormantControl))))
          StereoChunk)
       (Element StereoChunk))
 -> IO
      (SampleRate Real
       -> ()
       -> T (T (T FormantControl
                  (T FormantControl
                     (T FormantControl (T FormantControl FormantControl))))
               StereoChunk)
            StereoChunk))
-> (Arguments
      (Input
         (SampleRate Real)
         (T (T FormantControl
               (T FormantControl
                  (T FormantControl (T FormantControl FormantControl))))
            StereoChunk))
      (T (T FormantControl
            (T FormantControl
               (T FormantControl (T FormantControl FormantControl))))
         StereoChunk)
    -> Exp ()
    -> T (SampleRate Real)
         (T (T FormantControl
               (T FormantControl
                  (T FormantControl (T FormantControl FormantControl))))
            StereoChunk)
         (Element StereoChunk))
-> IO
     (SampleRate Real
      -> ()
      -> T (T (T FormantControl
                 (T FormantControl
                    (T FormantControl (T FormantControl FormantControl))))
              StereoChunk)
           StereoChunk)
forall a b. (a -> b) -> a -> b
$ \(((Input
   (T (T FormantControl
         (T FormantControl
            (T FormantControl (T FormantControl FormantControl))))
      StereoChunk)
   (T ShortStrictTime Real),
 (Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (T ShortStrictTime Real),
  Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (Control Frequency)))
fmt0, ((Input
   (T (T FormantControl
         (T FormantControl
            (T FormantControl (T FormantControl FormantControl))))
      StereoChunk)
   (T ShortStrictTime Real),
 (Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (T ShortStrictTime Real),
  Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (Control Frequency)))
fmt1, ((Input
   (T (T FormantControl
         (T FormantControl
            (T FormantControl (T FormantControl FormantControl))))
      StereoChunk)
   (T ShortStrictTime Real),
 (Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (T ShortStrictTime Real),
  Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (Control Frequency)))
fmt2, ((Input
   (T (T FormantControl
         (T FormantControl
            (T FormantControl (T FormantControl FormantControl))))
      StereoChunk)
   (T ShortStrictTime Real),
 (Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (T ShortStrictTime Real),
  Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (Control Frequency)))
fmt3, (Input
   (T (T FormantControl
         (T FormantControl
            (T FormantControl (T FormantControl FormantControl))))
      StereoChunk)
   (T ShortStrictTime Real),
 (Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (T ShortStrictTime Real),
  Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (Control Frequency)))
fmt4)))), Input
  (T (T FormantControl
        (T FormantControl
           (T FormantControl (T FormantControl FormantControl))))
     StereoChunk)
  StereoChunk
x) Exp ()
_unit ->
         (T (SampleRate Real)
   (T (T FormantControl
         (T FormantControl
            (T FormantControl (T FormantControl FormantControl))))
      StereoChunk)
   (Element StereoChunk)
 -> T (SampleRate Real)
      (T (T FormantControl
            (T FormantControl
               (T FormantControl (T FormantControl FormantControl))))
         StereoChunk)
      (Element StereoChunk)
 -> T (SampleRate Real)
      (T (T FormantControl
            (T FormantControl
               (T FormantControl (T FormantControl FormantControl))))
         StereoChunk)
      (Element StereoChunk))
-> [T (SampleRate Real)
      (T (T FormantControl
            (T FormantControl
               (T FormantControl (T FormantControl FormantControl))))
         StereoChunk)
      (Element StereoChunk)]
-> T (SampleRate Real)
     (T (T FormantControl
           (T FormantControl
              (T FormantControl (T FormantControl FormantControl))))
        StereoChunk)
     (Element StereoChunk)
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 T (SampleRate Real)
  (T (T FormantControl
        (T FormantControl
           (T FormantControl (T FormantControl FormantControl))))
     StereoChunk)
  (T (T Vector))
-> T (SampleRate Real)
     (T (T FormantControl
           (T FormantControl
              (T FormantControl (T FormantControl FormantControl))))
        StereoChunk)
     (T (T Vector))
-> T (SampleRate Real)
     (T (T FormantControl
           (T FormantControl
              (T FormantControl (T FormantControl FormantControl))))
        StereoChunk)
     (T (T Vector))
T (SampleRate Real)
  (T (T FormantControl
        (T FormantControl
           (T FormantControl (T FormantControl FormantControl))))
     StereoChunk)
  (Element StereoChunk)
-> T (SampleRate Real)
     (T (T FormantControl
           (T FormantControl
              (T FormantControl (T FormantControl FormantControl))))
        StereoChunk)
     (Element StereoChunk)
-> T (SampleRate Real)
     (T (T FormantControl
           (T FormantControl
              (T FormantControl (T FormantControl FormantControl))))
        StereoChunk)
     (Element StereoChunk)
forall a. C a => a -> a -> a
(+) ([T (SampleRate Real)
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (Element StereoChunk)]
 -> T (SampleRate Real)
      (T (T FormantControl
            (T FormantControl
               (T FormantControl (T FormantControl FormantControl))))
         StereoChunk)
      (Element StereoChunk))
-> [T (SampleRate Real)
      (T (T FormantControl
            (T FormantControl
               (T FormantControl (T FormantControl FormantControl))))
         StereoChunk)
      (Element StereoChunk)]
-> T (SampleRate Real)
     (T (T FormantControl
           (T FormantControl
              (T FormantControl (T FormantControl FormantControl))))
        StereoChunk)
     (Element StereoChunk)
forall a b. (a -> b) -> a -> b
$ ((Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (T ShortStrictTime Real),
  (Input
     (T (T FormantControl
           (T FormantControl
              (T FormantControl (T FormantControl FormantControl))))
        StereoChunk)
     (T ShortStrictTime Real),
   Input
     (T (T FormantControl
           (T FormantControl
              (T FormantControl (T FormantControl FormantControl))))
        StereoChunk)
     (Control Frequency)))
 -> T (SampleRate Real)
      (T (T FormantControl
            (T FormantControl
               (T FormantControl (T FormantControl FormantControl))))
         StereoChunk)
      (T (T Vector)))
-> [(Input
       (T (T FormantControl
             (T FormantControl
                (T FormantControl (T FormantControl FormantControl))))
          StereoChunk)
       (T ShortStrictTime Real),
     (Input
        (T (T FormantControl
              (T FormantControl
                 (T FormantControl (T FormantControl FormantControl))))
           StereoChunk)
        (T ShortStrictTime Real),
      Input
        (T (T FormantControl
              (T FormantControl
                 (T FormantControl (T FormantControl FormantControl))))
           StereoChunk)
        (Control Frequency)))]
-> [T (SampleRate Real)
      (T (T FormantControl
            (T FormantControl
               (T FormantControl (T FormantControl FormantControl))))
         StereoChunk)
      (T (T Vector))]
forall a b. (a -> b) -> [a] -> [b]
map (((Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (T ShortStrictTime Real),
  (Input
     (T (T FormantControl
           (T FormantControl
              (T FormantControl (T FormantControl FormantControl))))
        StereoChunk)
     (T ShortStrictTime Real),
   Input
     (T (T FormantControl
           (T FormantControl
              (T FormantControl (T FormantControl FormantControl))))
        StereoChunk)
     (Control Frequency)))
 -> Input
      (T (T FormantControl
            (T FormantControl
               (T FormantControl (T FormantControl FormantControl))))
         StereoChunk)
      StereoChunk
 -> T (SampleRate Real)
      (T (T FormantControl
            (T FormantControl
               (T FormantControl (T FormantControl FormantControl))))
         StereoChunk)
      (T (T Vector)))
-> Input
     (T (T FormantControl
           (T FormantControl
              (T FormantControl (T FormantControl FormantControl))))
        StereoChunk)
     StereoChunk
-> (Input
      (T (T FormantControl
            (T FormantControl
               (T FormantControl (T FormantControl FormantControl))))
         StereoChunk)
      (T ShortStrictTime Real),
    (Input
       (T (T FormantControl
             (T FormantControl
                (T FormantControl (T FormantControl FormantControl))))
          StereoChunk)
       (T ShortStrictTime Real),
     Input
       (T (T FormantControl
             (T FormantControl
                (T FormantControl (T FormantControl FormantControl))))
          StereoChunk)
       (Control Frequency)))
-> T (SampleRate Real)
     (T (T FormantControl
           (T FormantControl
              (T FormantControl (T FormantControl FormantControl))))
        StereoChunk)
     (T (T Vector))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Input
   (T (T FormantControl
         (T FormantControl
            (T FormantControl (T FormantControl FormantControl))))
      StereoChunk)
   (T ShortStrictTime Real),
 (Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (T ShortStrictTime Real),
  Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (Control Frequency)))
-> Input
     (T (T FormantControl
           (T FormantControl
              (T FormantControl (T FormantControl FormantControl))))
        StereoChunk)
     StereoChunk
-> T (SampleRate Real)
     (T (T FormantControl
           (T FormantControl
              (T FormantControl (T FormantControl FormantControl))))
        StereoChunk)
     (T (T Vector))
forall inp.
(Input inp (T ShortStrictTime Real),
 (Input inp (T ShortStrictTime Real),
  Input inp (Control Frequency)))
-> Input inp StereoChunk -> T (SampleRate Real) inp (T (T Vector))
singleFormant Input
  (T (T FormantControl
        (T FormantControl
           (T FormantControl (T FormantControl FormantControl))))
     StereoChunk)
  StereoChunk
x) [(Input
   (T (T FormantControl
         (T FormantControl
            (T FormantControl (T FormantControl FormantControl))))
      StereoChunk)
   (T ShortStrictTime Real),
 (Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (T ShortStrictTime Real),
  Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (Control Frequency)))
fmt0, (Input
   (T (T FormantControl
         (T FormantControl
            (T FormantControl (T FormantControl FormantControl))))
      StereoChunk)
   (T ShortStrictTime Real),
 (Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (T ShortStrictTime Real),
  Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (Control Frequency)))
fmt1, (Input
   (T (T FormantControl
         (T FormantControl
            (T FormantControl (T FormantControl FormantControl))))
      StereoChunk)
   (T ShortStrictTime Real),
 (Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (T ShortStrictTime Real),
  Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (Control Frequency)))
fmt2, (Input
   (T (T FormantControl
         (T FormantControl
            (T FormantControl (T FormantControl FormantControl))))
      StereoChunk)
   (T ShortStrictTime Real),
 (Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (T ShortStrictTime Real),
  Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (Control Frequency)))
fmt3, (Input
   (T (T FormantControl
         (T FormantControl
            (T FormantControl (T FormantControl FormantControl))))
      StereoChunk)
   (T ShortStrictTime Real),
 (Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (T ShortStrictTime Real),
  Input
    (T (T FormantControl
          (T FormantControl
             (T FormantControl (T FormantControl FormantControl))))
       StereoChunk)
    (Control Frequency)))
fmt4])