-- | Wonderful echoes from morpheus.
-- Granular synthesis for morphing between waveforms.
-- It's a simplification of partikkel opcode for the case of morphing.
module Csound.Air.Granular.Morpheus(
  WaveAmp, WaveKey, MorphWave,
  MorphSpec(..), GrainDensity(..), GrainEnv(..),

  morpheus,

  -- *  Sound files
  morphSnd1, morphSnd,

  -- * Amplitude modes
  pairToSquare,

  -- * Oscillators
  morpheusOsc, morpheusOsc2
) where

import Data.Default

import Csound.Typed
import Csound.Typed.Opcode
import Csound.Tab

import Csound.Air.Granular(Pointer, csdPartikkel)
import Csound.Air.Wav
import Csound.Air.Wave

type WaveAmp = Sig
type WaveKey = Sig

type MorphWave = (Tab, WaveAmp, WaveKey, Pointer)

-- | Density of the grain stream.
--
-- * @rate@ is how many grains per second is generated
--
-- * @size@ is the size of each grain in milliseconds (it's good to set it relative to grain rate)
--
-- * @skip@ skip is a skip ratio (0 to 1). It's the probability of grain skip. Zero means no skip and 1 means every grain is left out.
--
-- see docs for Csound partikkel opcode for more detailed information <http://www.csounds.com/manual/html/partikkel.html>
data GrainDensity = GrainDensity
  { GrainDensity -> Sig
grainRate :: Sig
  , GrainDensity -> Sig
grainSize :: Sig
  , GrainDensity -> Sig
grainSkip :: Sig }

instance Default GrainDensity where
  def :: GrainDensity
def = GrainDensity :: Sig -> Sig -> Sig -> GrainDensity
GrainDensity
      { grainRate :: Sig
grainRate = Sig
kGrainRate
      , grainSize :: Sig
grainSize = Sig
kduration
      , grainSkip :: Sig
grainSkip = Sig
0 }
    where
      kGrainDur :: Sig
kGrainDur = Sig
2.5             -- length of each grain relative to grain rate
      kduration :: Sig
kduration = (Sig
kGrainDurSig -> Sig -> Sig
forall a. Num a => a -> a -> a
*Sig
1000)Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/Sig
kGrainRate -- grain dur in milliseconds, relative to grain rate
      kGrainRate :: Sig
kGrainRate  = Sig
12

-- | Parameters for grain envelope.
--
-- * attShape -- table that contains shape of the attack.
--
-- * decShape -- table that contains shape of the decay
--
-- * sustRatio -- how big is sustain phase relative to attack and decay
--
-- * attack to decay ration -- relative amount of attack decay ration. 0.5 means attack equals decay.
--
-- see docs for Csound partikkel opcode for more detailed information <http://www.csounds.com/manual/html/partikkel.html>
data GrainEnv = GrainEnv
  { GrainEnv -> Tab
grainAttShape :: Tab
  , GrainEnv -> Tab
grainDecShape :: Tab
  , GrainEnv -> Sig
grainSustRatio :: Sig
  , GrainEnv -> Sig
grainAttDecRatio :: Sig }

instance Default GrainEnv where
  def :: GrainEnv
def = GrainEnv :: Tab -> Tab -> Sig -> Sig -> GrainEnv
GrainEnv
      { grainAttShape :: Tab
grainAttShape = Tab
sigmoidRise
      , grainDecShape :: Tab
grainDecShape = Tab
sigmoidFall
      , grainSustRatio :: Sig
grainSustRatio = Sig
0.25
      , grainAttDecRatio :: Sig
grainAttDecRatio = Sig
0.5 }

-- sigmoidRise = guardPoint $ sines4 [(0.5, 1, 270, 1)]
-- sigmoidFall = guardPoint $ sines4 [(0.5, 1, 90, 1)]

-- | Specification of morphing synth. It has the default instance
-- and the values in its records has default instances too
data MorphSpec = MorphSpec
  { MorphSpec -> GrainDensity
morphGrainDensity :: GrainDensity
  , MorphSpec -> GrainEnv
morphGrainEnv     :: GrainEnv
  }

instance Default MorphSpec where
  def :: MorphSpec
def = MorphSpec :: GrainDensity -> GrainEnv -> MorphSpec
MorphSpec
    { morphGrainDensity :: GrainDensity
morphGrainDensity = GrainDensity
forall a. Default a => a
def
    , morphGrainEnv :: GrainEnv
morphGrainEnv     = GrainEnv
forall a. Default a => a
def
    }

-- | Synth that is based on partikkel. It allows easy morphing between unlimited number of waves.
-- While partikkel allows only 4 waves to be used. We can use as many as we like. Internally
-- the list is split on groups 4 elements or less in each and one partikkel is applied to each group.
-- Many parameters of partikel were simplified to get the good defaults for sound morphing behavior.
--
-- > morpheus spec waves frequencyScale
--
-- * spec -- contains many misc parameters
--
-- * waves list can contain up to four wave tables to read grains from.
--
-- * frequencyScale -- scaling factor for frequency. 1 means playing at the original frequency, 2 rises the pitch by octave.
--     We can use negative values to play the grains in reverse.
morpheus :: MorphSpec -> [MorphWave] -> Sig -> SE Sig2
morpheus :: MorphSpec -> [MorphWave] -> Sig -> SE Sig2
morpheus MorphSpec
spec [MorphWave]
pwaves Sig
cps = [SE Sig2] -> SE Sig2
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([SE Sig2] -> SE Sig2) -> [SE Sig2] -> SE Sig2
forall a b. (a -> b) -> a -> b
$ ([MorphWave] -> SE Sig2) -> [[MorphWave]] -> [SE Sig2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[MorphWave]
waves -> MorphSpec -> [MorphWave] -> Sig -> SE Sig2
morpheus4 MorphSpec
spec [MorphWave]
waves Sig
cps) ([MorphWave] -> [[MorphWave]]
forall a. [a] -> [[a]]
splitBy4 [MorphWave]
pwaves)

splitBy4 :: [a] -> [[a]]
splitBy4 :: [a] -> [[a]]
splitBy4 [a]
xs = case [a]
xs of
    a
a:a
b:a
c:a
d:[a]
rest -> [a
a,a
b,a
c,a
d] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
forall a. [a] -> [[a]]
splitBy4 [a]
rest
    [a]
rest         -> [[a]
rest]

morpheus4 :: MorphSpec -> [MorphWave] -> Sig -> SE Sig2
morpheus4 :: MorphSpec -> [MorphWave] -> Sig -> SE Sig2
morpheus4 MorphSpec
spec [MorphWave]
pwaves Sig
cps = do
  Tab
iwaveamptab <- Sig -> Sig -> Sig -> Sig -> SE Tab
makeMorphTable Sig
amp1 Sig
amp2 Sig
amp3 Sig
amp4
  Sig2 -> SE Sig2
forall (m :: * -> *) a. Monad m => a -> m a
return (Sig2 -> SE Sig2) -> Sig2 -> SE Sig2
forall a b. (a -> b) -> a -> b
$ Sig
-> Sig
-> Tab
-> Sig
-> Sig
-> Tab
-> Tab
-> Tab
-> Sig
-> Sig
-> Sig
-> Sig
-> Tab
-> Sig
-> Sig
-> Tab
-> Tab
-> Sig
-> Tab
-> Tab
-> Tab
-> Sig
-> Sig
-> Sig
-> Tab
-> Sig
-> Tab
-> Tab
-> Tab
-> Tab
-> Tab
-> Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> D
-> Sig2
forall a.
Tuple a =>
Sig
-> Sig
-> Tab
-> Sig
-> Sig
-> Tab
-> Tab
-> Tab
-> Sig
-> Sig
-> Sig
-> Sig
-> Tab
-> Sig
-> Sig
-> Tab
-> Tab
-> Sig
-> Tab
-> Tab
-> Tab
-> Sig
-> Sig
-> Sig
-> Tab
-> Sig
-> Tab
-> Tab
-> Tab
-> Tab
-> Tab
-> Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> D
-> a
csdPartikkel Sig
agrainrate Sig
kdistribution Tab
idisttab Sig
async Sig
kenv2amt Tab
ienv2tab
          Tab
ienv_attack Tab
ienv_decay Sig
ksustain_amount Sig
ka_d_ratio Sig
kduration Sig
kamp Tab
igainmasks
                    Sig
kwavfreq Sig
ksweepshape Tab
iwavfreqstarttab Tab
iwavfreqendtab Sig
awavfm
                    Tab
ifmamptab Tab
ifmenv Tab
icosine Sig
kTrainCps Sig
knumpartials
                    Sig
kchroma Tab
ichannelmasks Sig
krandommask Tab
kwaveform1 Tab
kwaveform2 Tab
kwaveform3 Tab
kwaveform4
                    Tab
iwaveamptab Sig
asamplepos1 Sig
asamplepos2 Sig
asamplepos3 Sig
asamplepos4
                    Sig
kwavekey1 Sig
kwavekey2 Sig
kwavekey3 Sig
kwavekey4 D
imax_grains
    where
      MorphWave
wave1 : MorphWave
wave2 : MorphWave
wave3 : MorphWave
wave4 : [MorphWave]
_ = [MorphWave] -> [MorphWave]
forall a. [a] -> [a]
cycle [MorphWave]
pwaves

      async :: Sig
async = Sig
0
      kamp :: Sig
kamp = Sig
1

      ichannelmasks :: Tab
ichannelmasks = Tab -> Tab
skipNorm (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ [Double] -> Tab
doubles [Double
0, Double
0,  Double
0.5]

      kdistribution :: Sig
kdistribution = Sig
1
      idisttab :: Tab
idisttab = Int -> Tab -> Tab
setSize Int
16 (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ [Double] -> Tab
startEnds [Double
1, Double
16, -Double
10, Double
0]

      -- grain shape settings
      grainEnv :: GrainEnv
grainEnv = MorphSpec -> GrainEnv
morphGrainEnv MorphSpec
spec
      ienv_attack :: Tab
ienv_attack = GrainEnv -> Tab
grainAttShape GrainEnv
grainEnv
      ienv_decay :: Tab
ienv_decay  = GrainEnv -> Tab
grainDecShape GrainEnv
grainEnv
      ksustain_amount :: Sig
ksustain_amount = GrainEnv -> Sig
grainSustRatio GrainEnv
grainEnv
      ka_d_ratio :: Sig
ka_d_ratio = GrainEnv -> Sig
grainAttDecRatio GrainEnv
grainEnv
      kenv2amt :: Sig
kenv2amt = Sig
0
      ienv2tab :: Tab
ienv2tab = [Double] -> Tab
eexps [Double
1, Double
0.0001]

      -- grain density
      grainDensity :: GrainDensity
grainDensity = MorphSpec -> GrainDensity
morphGrainDensity MorphSpec
spec
      kGrainRate :: Sig
kGrainRate = GrainDensity -> Sig
grainRate GrainDensity
grainDensity
      kduration :: Sig
kduration = GrainDensity -> Sig
grainSize GrainDensity
grainDensity

      kwavfreq :: Sig
kwavfreq = Sig
cps

      krandommask :: Sig
krandommask = GrainDensity -> Sig
grainSkip GrainDensity
grainDensity

      -- waves

      kwavekey1 :: Sig
kwavekey1 = MorphWave -> Sig
forall b d. (Tab, b, Sig, d) -> Sig
getWaveKey MorphWave
wave1
      kwavekey2 :: Sig
kwavekey2 = MorphWave -> Sig
forall b d. (Tab, b, Sig, d) -> Sig
getWaveKey MorphWave
wave2
      kwavekey3 :: Sig
kwavekey3 = MorphWave -> Sig
forall b d. (Tab, b, Sig, d) -> Sig
getWaveKey MorphWave
wave3
      kwavekey4 :: Sig
kwavekey4 = MorphWave -> Sig
forall b d. (Tab, b, Sig, d) -> Sig
getWaveKey MorphWave
wave4

      asamplepos1 :: Sig
asamplepos1 = MorphWave -> Sig
forall a b c d. (a, b, c, d) -> d
getSamplePos MorphWave
wave1
      asamplepos2 :: Sig
asamplepos2 = MorphWave -> Sig
forall a b c d. (a, b, c, d) -> d
getSamplePos MorphWave
wave2
      asamplepos3 :: Sig
asamplepos3 = MorphWave -> Sig
forall a b c d. (a, b, c, d) -> d
getSamplePos MorphWave
wave3
      asamplepos4 :: Sig
asamplepos4 = MorphWave -> Sig
forall a b c d. (a, b, c, d) -> d
getSamplePos MorphWave
wave4

      kwaveform1 :: Tab
kwaveform1 = MorphWave -> Tab
forall a b c d. (a, b, c, d) -> a
getWaveForm MorphWave
wave1
      kwaveform2 :: Tab
kwaveform2 = MorphWave -> Tab
forall a b c d. (a, b, c, d) -> a
getWaveForm MorphWave
wave2
      kwaveform3 :: Tab
kwaveform3 = MorphWave -> Tab
forall a b c d. (a, b, c, d) -> a
getWaveForm MorphWave
wave3
      kwaveform4 :: Tab
kwaveform4 = MorphWave -> Tab
forall a b c d. (a, b, c, d) -> a
getWaveForm MorphWave
wave4

      amp1 :: Sig
amp1 = MorphWave -> Sig
forall a c d. (a, Sig, c, d) -> Sig
getAmp MorphWave
wave1
      amp2 :: Sig
amp2 = MorphWave -> Sig
forall a c d. (a, Sig, c, d) -> Sig
getAmp MorphWave
wave2
      amp3 :: Sig
amp3 = MorphWave -> Sig
forall a c d. (a, Sig, c, d) -> Sig
getAmp MorphWave
wave3
      amp4 :: Sig
amp4 = MorphWave -> Sig
forall a c d. (a, Sig, c, d) -> Sig
getAmp MorphWave
wave4

      imax_grains :: D
imax_grains = D
100

      getWaveKey :: (Tab, b, Sig, d) -> Sig
getWaveKey (Tab
tab1, b
_, Sig
key1, d
_) = Sig
key1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ D -> Sig
sig (Tab -> D
getTabLen Tab
tab1)

      getSamplePos :: (a, b, c, d) -> d
getSamplePos (a
_, b
_, c
_, d
ptr) = d
ptr
      getWaveForm :: (a, b, c, d) -> a
getWaveForm (a
form, b
_, c
_, d
_) = a
form
      getAmp :: (a, Sig, c, d) -> Sig
getAmp (a
_, Sig
amp, c
_, d
_) = Sig -> Sig
kr Sig
amp

      -- no trainlets
      icosine :: Tab
icosine = Tab
cosine
      kTrainCps :: Sig
kTrainCps = Sig
kGrainRate
      knumpartials :: Sig
knumpartials = Sig
7
      kchroma :: Sig
kchroma = Sig
3

      -- no FM
      kGrFmFreq :: Sig
kGrFmFreq = Sig
kGrainRate Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
4
      kGrFmIndex :: Sig
kGrFmIndex = Sig
0
      aGrFmSig :: Sig
aGrFmSig = Sig
kGrFmIndex Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig -> Sig
osc Sig
kGrFmFreq
      agrainrate :: Sig
agrainrate = Sig
kGrainRate Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ Sig
aGrFmSig Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
kGrainRate
      ifmenv :: Tab
ifmenv = [Double] -> Tab
elins [Double
0, Double
1, Double
0]
      ifmamptab :: Tab
ifmamptab = Tab -> Tab
skipNorm (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ [Double] -> Tab
doubles [Double
0, Double
0, Double
1]
      awavfm :: Sig
awavfm = Sig
0

      -- other params
      igainmasks :: Tab
igainmasks = Tab -> Tab
skipNorm (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ [Double] -> Tab
doubles [Double
0, Double
0,   Double
1]
      ksweepshape :: Sig
ksweepshape = Sig
0.5
      iwavfreqstarttab :: Tab
iwavfreqstarttab = Tab -> Tab
skipNorm (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ [Double] -> Tab
doubles [Double
0, Double
0, Double
1]
      iwavfreqendtab :: Tab
iwavfreqendtab = Tab -> Tab
skipNorm (Tab -> Tab) -> Tab -> Tab
forall a b. (a -> b) -> a -> b
$ [Double] -> Tab
doubles [Double
0, Double
0, Double
1]

      makeMorphTable :: Sig -> Sig -> Sig -> Sig -> SE Tab
makeMorphTable Sig
a1 Sig
a2 Sig
a3 Sig
a4 = do
        Tab
t <- D -> SE Tab
newTab D
64
        ((Int, Sig) -> SE ()) -> [(Int, Sig)] -> SE ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_  (\(Int
i, Sig
amp) -> Sig -> Sig -> Tab -> SE ()
tablew Sig
amp  (Sig
2 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
+ D -> Sig
sig (Int -> D
int Int
i)) Tab
t ) ([Int] -> [Sig] -> [(Int, Sig)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 .. ] [Sig
a1, Sig
a2, Sig
a3, Sig
a4])
        Tab -> SE Tab
forall (m :: * -> *) a. Monad m => a -> m a
return Tab
t

getTabLen :: Tab -> D
getTabLen :: Tab -> D
getTabLen Tab
t = Tab -> D
ftlen Tab
t D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
getSampleRate

-- | Creates four control signals out two signals. The control signals are encoded by the position
-- of the point on XY-plane. The four resulting signals are derived from the proximity of the point
-- to four squares of the ((0, 1), (0, 1)) square. It can be useful to control the morpheus with XY-pad controller.
pairToSquare :: (Sig, Sig) -> (Sig, Sig, Sig, Sig)
pairToSquare :: Sig2 -> (Sig, Sig, Sig, Sig)
pairToSquare (Sig
x, Sig
y) = ((Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
x) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
y), Sig
x Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
y) , Sig
x Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
y, (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
x) Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
y)

-- | Morpheus synth for mono-audio files. The first cell in each tripple is occupied by file name.
-- The rest arguments are the same as for @morpheus@.
morphSnd1 :: MorphSpec -> [(String, WaveAmp, WaveKey)] -> Sig -> SE Sig2
morphSnd1 :: MorphSpec -> [(String, Sig, Sig)] -> Sig -> SE Sig2
morphSnd1 MorphSpec
spec [(String, Sig, Sig)]
waves Sig
cps = MorphSpec -> [MorphWave] -> Sig -> SE Sig2
morpheus MorphSpec
spec (((String, Sig, Sig) -> MorphWave)
-> [(String, Sig, Sig)] -> [MorphWave]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Sig, Sig) -> MorphWave
forall b c. (String, b, c) -> (Tab, b, c, Sig)
fromSnd [(String, Sig, Sig)]
waves) Sig
cps
  where
    fromSnd :: (String, b, c) -> (Tab, b, c, Sig)
fromSnd (String
file, b
amp, c
key) = (String -> Tab
wavLeft String
file, b
amp, c
key, Sig -> Sig
phasor (Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ D -> Sig
sig (String -> D
lengthSnd String
file)))

-- | Morpheus synth for stereo-audio files. The first cell in each tripple is occupied by file name.
-- The rest arguments are the same as for @morpheus@.
morphSnd :: MorphSpec -> [(String, WaveAmp, WaveKey)] -> Sig -> SE Sig2
morphSnd :: MorphSpec -> [(String, Sig, Sig)] -> Sig -> SE Sig2
morphSnd MorphSpec
spec [(String, Sig, Sig)]
waves Sig
cps = (String -> Tab)
-> MorphSpec -> [(String, Sig, Sig)] -> Sig -> SE Sig2
morphSndByTab String -> Tab
wavLeft MorphSpec
spec [(String, Sig, Sig)]
waves Sig
cps SE Sig2 -> SE Sig2 -> SE Sig2
forall a. Num a => a -> a -> a
+ (String -> Tab)
-> MorphSpec -> [(String, Sig, Sig)] -> Sig -> SE Sig2
morphSndByTab String -> Tab
wavRight MorphSpec
spec [(String, Sig, Sig)]
waves Sig
cps

morphSndByTab :: (String -> Tab) -> MorphSpec -> [(String, WaveAmp, WaveKey)] -> Sig -> SE Sig2
morphSndByTab :: (String -> Tab)
-> MorphSpec -> [(String, Sig, Sig)] -> Sig -> SE Sig2
morphSndByTab String -> Tab
getTab MorphSpec
spec [(String, Sig, Sig)]
waves Sig
cps = MorphSpec -> [MorphWave] -> Sig -> SE Sig2
morpheus MorphSpec
spec (((String, Sig, Sig) -> MorphWave)
-> [(String, Sig, Sig)] -> [MorphWave]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Sig, Sig) -> MorphWave
forall b c. (String, b, c) -> (Tab, b, c, Sig)
fromSnd [(String, Sig, Sig)]
waves) Sig
cps
  where
    fromSnd :: (String, b, c) -> (Tab, b, c, Sig)
fromSnd (String
file, b
amp, c
key) = (String -> Tab
getTab String
file, b
amp, c
key, Sig -> Sig
phasor (Sig
1 Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ D -> Sig
sig (String -> D
lengthSnd String
file)))

-- | Morpheus oscillator.
--
-- > morpheusOsc spec (baseFrequency, table) cps
--
-- @baseFrequency@ is the frequency of the sample contained in the table. With oscillator
-- we can read the table on different frequencies.
morpheusOsc :: MorphSpec -> (D, Tab) -> Sig -> SE Sig2
morpheusOsc :: MorphSpec -> (D, Tab) -> Sig -> SE Sig2
morpheusOsc MorphSpec
spec (D
baseFreq, Tab
t) Sig
cps = MorphSpec -> [MorphWave] -> Sig -> SE Sig2
morpheus MorphSpec
spec [MorphWave]
waves Sig
ratio
  where
    ratio :: Sig
ratio = Sig
cps Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ D -> Sig
sig D
baseFreq
    aptr :: Sig
aptr = Tab -> Sig
cycleTab Tab
t
    waves :: [MorphWave]
waves = [(Tab
t, Sig
1, Sig
1, Sig
aptr)]

cycleTab :: Tab -> Sig
cycleTab :: Tab -> Sig
cycleTab Tab
t = Sig -> Sig
phasor (Sig -> Sig) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ D -> D
forall a. Fractional a => a -> a
recip (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ Tab -> D
getTabLen Tab
t

-- | Morpheus oscillator. We control the four tables with pair of control signals (see the function @pairToSquare@).
--
-- > morpheusOsc2 spec baseFrequency waves (x, y) cps = ...
morpheusOsc2 :: MorphSpec -> D -> [(Sig, Tab)] -> (Sig, Sig) -> Sig -> SE Sig2
morpheusOsc2 :: MorphSpec -> D -> [(Sig, Tab)] -> Sig2 -> Sig -> SE Sig2
morpheusOsc2 MorphSpec
spec D
baseFreq [(Sig, Tab)]
ts (Sig
x, Sig
y) Sig
cps = MorphSpec -> [MorphWave] -> Sig -> SE Sig2
morpheus MorphSpec
spec [MorphWave]
waves Sig
ratio
  where
    (Sig
a1, Sig
a2, Sig
a3, Sig
a4) = Sig2 -> (Sig, Sig, Sig, Sig)
pairToSquare (Sig
x, Sig
y)
    ratio :: Sig
ratio = Sig
cps Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ D -> Sig
sig D
baseFreq
    waves :: [MorphWave]
waves = (Sig -> (Sig, Tab) -> MorphWave)
-> [Sig] -> [(Sig, Tab)] -> [MorphWave]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Sig
amp (Sig
key, Tab
t) -> (Tab
t, Sig
amp, Sig
key, Tab -> Sig
cycleTab Tab
t)) ([Sig] -> [Sig]
forall a. [a] -> [a]
cycle [Sig
a1, Sig
a2, Sig
a3, Sig
a4]) [(Sig, Tab)]
ts


{- examples

main' = dac $ mul 0.2 $ morphSnd1 def [("floss/ClassGuit.wav", linseg [1, 3, 1, 3, 0], linseg [1, 3, 1, 3, 0]), ("floss/ClassGuit.wav", linseg [0, 3, 0, 3, 1], (-1))] 1

main = dac $ lift1 (\p -> mixAt 0.25 largeHall2 $ mixAt 0.6 (pingPong 0.124 0.5 0.7) $
  at (filt 2 (\cfq res x -> moogladder x cfq res) (env * 12000) 0.1) $ mul (0.2 * env) $
  morpheus (def { morphGrainDensity = def { grainRate = linseg [36, 18, 4], grainSize = linseg [ 1200, 6, 5700, 12, 750 ], grainSkip = 0.45 * uosc 0.17 }})
    (tabs p) (negate $ semitone (5))) (ujoy (0.5, 0.5))
    where
      tabs (x, y) = [file a1 1, file a2 0.5, file2 a3 1, file3 a4 1]
        where (a1, a2, a3, a4) = pairToSquare (x, y)

      file a x = (wavl "floss/ClassGuit.wav", a, x, linseg [2.5, 18, 3.5])
      file2 a x = (wavl "floss/hd.wav", a, x, linseg [0.2, 18, 0.6])
      file3 a x = (wavl "floss/hd.wav", a, x, linseg [0.02, 18, 0.5])

      env = linseg [0, 1, 1, 3, 1] -- 10, 0]

      amp1 = linseg [1, 8, 1, 4, 0]
      amp2 = linseg [0, 6, 0, 6, 1]

-}


{-
-- todo
-- playing samples in chain

pyramidWeights

partWaveChain :: [Double] -> Sig -> (Sig, Sig, Sig, Sig)
partWaveChain xs pointer = case xs of
  [a, da] ->
    let (amp1, amp2) = go1 a da pointer
    in  (amp1, amp2, 0, 0)
  [a, da, b, db] ->
    let (amp1, amp2, amp3) = go2 a da b db pointer
    in  (amp1, amp2, amp3, 0)
  [a, da, b, db, c, dc] ->
    let (amp1, amp2, amp3, amp4) = go3 a da b db c dc pointer
    in  (amp1, amp2, amp3, amp4)
  _ -> error "partWaveChain: wrong number of elements in the list. Should be [a, da], [a, da, b, db] or [a, da, b, db, c, dc]."
  where
    go1 a da ptr = (readTab t1 ptr, readTab t2 ptr)
      where
        d = da / 2
        t1 = leftTab (a - d) (a + d)
        t2 = rightTab (a - d) (a + d)

    go2 a da b db = (readTab t1 ptr, readTab t2 ptr, readTab t3 ptr)
      where
        da2 = da / 2
        db2 = db / 2
        t1 = leftTab (a - da2) (a + da2)
        t2 = centerTab (a - da2) (a + da2) (b - db2) (b + db2)
        t3 = rightTab (b - db2) (b + db2)

    go3 = undefined

    readTab t ptr = table ptr t1 `withD` 1
    leftTab a b c  = lins [1, a, 1, b, 0, c, 0]
    rightTab a b c = lins [0, a, 0, b, 1, c, 1]
    centerTab a b c d e = lins [0, a, 0, b, 1, c, 1, d, 0, e, 0]

partWaveChain2 :: Sig -> (Sig, Sig, Sig, Sig)
partWaveChain2 = partWaveChain [0.5, 0.25]

partWaveChain3 :: Sig -> (Sig, Sig, Sig, Sig)
partWaveChain3 = partWaveChain [1/3, 0.25, 1/3, 0.25]

partWaveChain4 :: Sig -> (Sig, Sig, Sig, Sig)
partWaveChain4 = partWaveChain [0.25, 0.2, 0.25, 0.2, 0.25, 0.2]

cfdChainWeights :: [Double] -> Sig -> [Sig]
cfdChainWeights xs ptr = getWeights ptr (getPairs xs)
  where
    getPairs xs = case xs of
      a:b:rest -> (a, b) : getPairs rest
      _        -> []

    getPairs ptr xs = case xs of
      [] -> [1]
      [(a, rada)] -> go1 a rada ptr
      a : as -> goN a (init as) (zip lengs $ makeAdjacentPairs xs) (last as)
    where
      go1 a da ptr = [readTab t1 ptr, readTab t2 ptr]
        where
          d = da / 2
          t1 = leftTab (a - d) (a + d)
          t2 = rightTab (a - d) (a + d)

      goN (start, startRad) center (end, endRad) =
        startTab ++ centerTabs ++ [endTab]
        where
          startTab = leftTab (start - startRad) (2 * startRad) (1 - (start + startRad))
          endTab   = rightTab (1 - (end - endRad)) (2 * endRad) (end + endRad)
          centerTabs = fmap toCenterTab center

          toCenterTab (leng, (a, rada), (b, radb)) = centerTab (leng - rada) (2 * rada)

      readTab t ptr = table ptr t1 `withD` 1
      leftTab a b c  = lins [1, a, 1, b, 0, c, 0]
      rightTab a b c = lins [0, a, 0, b, 1, c, 1]
      centerTab a b c d e = lins [0, a, 0, b, 1, c, 1, d, 0, e, 0]

      makeAdjacentPairs xs = case xs of
        [] -> []
        x:xs -> tail $ scanl (\(a, b) c -> (b, c)) (x, x) xs

      lengs xs = tail $ scanl (\res (a, _) -> res + a) 0 xs
-}