-- | Spectral functions
 module Csound.Air.Spec(
    toSpec, fromSpec, mapSpec, scaleSpec, addSpec, scalePitch,
    CrossSpec(..),
    crossSpecFilter, crossSpecVocoder, crossSpecFilter1, crossSpecVocoder1
) where

import Data.Default

import Csound.Typed
import Csound.Typed.Opcode
import Csound.Tab(sine)

--------------------------------------------------------------------------
-- spectral functions

-- | Converts signal to spectrum.
toSpec :: Sig -> Spec
toSpec :: Sig -> Spec
toSpec Sig
asig = Sig -> D -> D -> D -> D -> Spec
pvsanal Sig
asig D
1024 D
256 D
1024 D
1

-- | Converts spectrum to signal.
fromSpec :: Spec -> Sig
fromSpec :: Spec -> Sig
fromSpec = Spec -> Sig
pvsynth

-- | Applies a transformation to the spectrum of the signal.
mapSpec :: (Spec -> Spec) -> Sig -> Sig
mapSpec :: (Spec -> Spec) -> Sig -> Sig
mapSpec Spec -> Spec
f = Spec -> Sig
fromSpec (Spec -> Sig) -> (Sig -> Spec) -> Sig -> Sig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spec -> Spec
f (Spec -> Spec) -> (Sig -> Spec) -> Sig -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> Spec
toSpec

-- | Scales all frequencies. Usefull for transposition.
-- For example, we can transpose a signal by the given amount of semitones:
--
-- > scaleSpec (semitone 1) asig
scaleSpec :: Sig -> Sig -> Sig
scaleSpec :: Sig -> Sig -> Sig
scaleSpec Sig
k = (Spec -> Spec) -> Sig -> Sig
mapSpec ((Spec -> Spec) -> Sig -> Sig) -> (Spec -> Spec) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ \Spec
x -> Spec -> Sig -> Spec
pvscale Spec
x Sig
k

-- | Adds given amount of Hz to all frequencies.
--
-- > addSpec hz asig
addSpec :: Sig -> Sig -> Sig
addSpec :: Sig -> Sig -> Sig
addSpec Sig
hz = (Spec -> Spec) -> Sig -> Sig
mapSpec ((Spec -> Spec) -> Sig -> Sig) -> (Spec -> Spec) -> Sig -> Sig
forall a b. (a -> b) -> a -> b
$ \Spec
x -> Spec -> Sig -> Sig -> Spec
pvshift Spec
x Sig
hz Sig
0

-- | Scales frequency in semitones.
scalePitch :: Sig -> Sig -> Sig
scalePitch :: Sig -> Sig -> Sig
scalePitch Sig
n = Sig -> Sig -> Sig
scaleSpec (Sig -> Sig
forall a. SigOrD a => a -> a
semitone Sig
n)

--------------------------------------------------------------------------

at2 :: (Sig -> Sig -> Sig) -> Sig2 -> Sig2 -> Sig2
at2 :: (Sig -> Sig -> Sig) -> Sig2 -> Sig2 -> Sig2
at2 Sig -> Sig -> Sig
f (Sig
left1, Sig
right1) (Sig
left2, Sig
right2) = (Sig -> Sig -> Sig
f Sig
left1 Sig
left2, Sig -> Sig -> Sig
f Sig
right1 Sig
right2)

-- | Settings for cross filtering algorithm.
--
-- They are the defaults for opvodes: @pvsifd@, @tradsyn@, @trcross@ and @partials@.
--
-- * Fft size degree --  it's the power of 2. The default is 12.
--
-- * Hop size degree -- it's the power of 2. The default is 9
--
-- * scale --amplitude scaling factor. default is 1
--
-- * pitch -- the pitch scaling factor. default is 1
--
-- * @maxTracks@ -- max number of tracks in resynthesis (tradsyn) and analysis (partials).
--
-- * @winType@ -- O: Hamming, 1: Hanning (default)
--
-- * @Search@ -- search interval length. The default is 1.05
--
-- * @Depth@ -- depth of the effect
--
-- * @Thresh@ -- analysis threshold. Tracks below ktresh*max_magnitude will be discarded (1 > ktresh >= 0).The default is 0.01
--
-- * @MinPoints@ -- minimum number of time points for a detected peak to make a track (1 is the minimum).
--
-- * @MaxGap@ -- maximum gap between time-points for track continuation (> 0). Tracks that have no continuation after kmaxgap will be discarded.
data CrossSpec = CrossSpec
  { CrossSpec -> D
crossFft    :: D
  , CrossSpec -> D
crossHopSize  :: D
  , CrossSpec -> Sig
crossScale    :: Sig
  , CrossSpec -> Sig
crossPitch    :: Sig
  , CrossSpec -> D
crossMaxTracks :: D
  , CrossSpec -> D
crossWinType  :: D
  , CrossSpec -> Sig
crossSearch   :: Sig
  , CrossSpec -> Sig
crossDepth    :: Sig
  , CrossSpec -> Sig
crossThresh   :: Sig
  , CrossSpec -> Sig
crossMinPoints :: Sig
  , CrossSpec -> Sig
crossMaxGap    :: Sig
  }

instance Default CrossSpec where
  def :: CrossSpec
def = CrossSpec :: D
-> D
-> Sig
-> Sig
-> D
-> D
-> Sig
-> Sig
-> Sig
-> Sig
-> Sig
-> CrossSpec
CrossSpec
    { crossFft :: D
crossFft    = D
12
    , crossHopSize :: D
crossHopSize  = D
9
    , crossScale :: Sig
crossScale    = Sig
1
    , crossPitch :: Sig
crossPitch    = Sig
1
    , crossMaxTracks :: D
crossMaxTracks = D
500
    , crossWinType :: D
crossWinType  = D
1
    , crossSearch :: Sig
crossSearch   = Sig
1.05
    , crossDepth :: Sig
crossDepth    = Sig
1
    , crossThresh :: Sig
crossThresh   = Sig
0.01
    , crossMinPoints :: Sig
crossMinPoints = Sig
1
    , crossMaxGap :: Sig
crossMaxGap    = Sig
3
    }


-- | Filters the partials of the second signal with partials of the first signal.
crossSpecFilter :: CrossSpec -> Sig2 -> Sig2 -> Sig2
crossSpecFilter :: CrossSpec -> Sig2 -> Sig2 -> Sig2
crossSpecFilter CrossSpec
spec = (Sig -> Sig -> Sig) -> Sig2 -> Sig2 -> Sig2
at2 (CrossSpec -> Sig -> Sig -> Sig
crossSpecFilter1 CrossSpec
spec)

-- | Substitutes the partials of the second signal with partials of the first signal.
crossSpecVocoder :: CrossSpec -> Sig2 -> Sig2 -> Sig2
crossSpecVocoder :: CrossSpec -> Sig2 -> Sig2 -> Sig2
crossSpecVocoder CrossSpec
spec = (Sig -> Sig -> Sig) -> Sig2 -> Sig2 -> Sig2
at2 (CrossSpec -> Sig -> Sig -> Sig
crossSpecVocoder1 CrossSpec
spec)

-- | @crossSpecFilter@ for mono signals.
crossSpecFilter1 :: CrossSpec -> Sig -> Sig -> Sig
crossSpecFilter1 :: CrossSpec -> Sig -> Sig -> Sig
crossSpecFilter1 = D -> CrossSpec -> Sig -> Sig -> Sig
crossSpecBy D
0

-- | @crossSpecVocoder@ for mono signals.
crossSpecVocoder1 :: CrossSpec -> Sig -> Sig -> Sig
crossSpecVocoder1 :: CrossSpec -> Sig -> Sig -> Sig
crossSpecVocoder1 = D -> CrossSpec -> Sig -> Sig -> Sig
crossSpecBy D
1

crossSpecBy :: D -> CrossSpec -> Sig -> Sig -> Sig
crossSpecBy :: D -> CrossSpec -> Sig -> Sig -> Sig
crossSpecBy D
imode CrossSpec
spec Sig
ain1 Sig
ain2 =
  Spec -> Sig -> Sig -> Sig -> Tab -> Sig
tradsyn (Spec -> Spec -> Sig -> Sig -> Spec
trcross (Sig -> Spec
getPartials Sig
ain2) (Sig -> Spec
getPartials Sig
ain1) (CrossSpec -> Sig
crossSearch CrossSpec
spec) (CrossSpec -> Sig
crossDepth CrossSpec
spec) Spec -> D -> Spec
forall a. Tuple a => a -> D -> a
`withD` D
imode) (CrossSpec -> Sig
crossScale CrossSpec
spec) (CrossSpec -> Sig
crossPitch CrossSpec
spec) (D -> Sig
sig (D -> Sig) -> D -> Sig
forall a b. (a -> b) -> a -> b
$ CrossSpec -> D
crossMaxTracks CrossSpec
spec) Tab
sine
  where
    getPartials :: Sig -> Spec
getPartials Sig
asig = Spec -> Spec -> Sig -> Sig -> Sig -> D -> Spec
partials Spec
fs1 Spec
fsi2 (CrossSpec -> Sig
crossThresh CrossSpec
spec) (CrossSpec -> Sig
crossMinPoints CrossSpec
spec) (CrossSpec -> Sig
crossMaxGap CrossSpec
spec) (CrossSpec -> D
crossMaxTracks CrossSpec
spec)
      where (Spec
fs1, Spec
fsi2) = Sig -> D -> D -> D -> (Spec, Spec)
pvsifd Sig
asig (D
2 D -> D -> D
forall a. Floating a => a -> a -> a
** (CrossSpec -> D
crossFft CrossSpec
spec)) (D
2 D -> D -> D
forall a. Floating a => a -> a -> a
** (CrossSpec -> D
crossHopSize CrossSpec
spec)) (CrossSpec -> D
crossWinType CrossSpec
spec)