-- | 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 asig = pvsanal asig 1024 256 1024 1

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

-- | Applies a transformation to the spectrum of the signal.
mapSpec :: (Spec -> Spec) -> Sig -> Sig
mapSpec f = fromSpec . f . 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 k = mapSpec $ \x -> pvscale x k

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

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

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

at2 :: (Sig -> Sig -> Sig) -> Sig2 -> Sig2 -> Sig2
at2 f (left1, right1) (left2, right2) = (f left1 left2, f right1 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 
	{ crossFft 		:: D
	, crossHopSize 	:: D
	, crossScale    :: Sig
	, crossPitch    :: Sig
	, crossMaxTracks :: D
	, crossWinType  :: D
	, crossSearch   :: Sig
	, crossDepth    :: Sig
	, crossThresh   :: Sig
	, crossMinPoints :: Sig
	, crossMaxGap    :: Sig
	}

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


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

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

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

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

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