module Csound.Air.Padsynth (
padsynthOsc, padsynthOsc2,
bwOscBy, bwOddOscBy, bwOscBy2, bwOddOscBy2,
bwOsc, bwTri, bwSqr, bwSaw, bwOsc2, bwTri2, bwSqr2, bwSaw2,
padsynthOscMultiCps, padsynthOscMultiCps2,
padsynthOscMultiVol, padsynthOscMultiVol2,
padsynthOscMultiVolCps, padsynthOscMultiVolCps2,
morphsynthOscMultiCps, quadMorphsynthOscMultiCps
) where
import Data.List
import Control.Arrow
import Csound.Typed
import Csound.Tab
import Csound.Air.Wave
import Csound.Typed.Opcode(poscil)
import Csound.Types(compareWhenD)
import Csound.Air.Granular.Morpheus
padsynthOsc :: PadsynthSpec -> Sig -> SE Sig
padsynthOsc spec freq = padsynthOscByTab (double $ padsynthFundamental spec) (padsynth spec) freq
padsynthOscByTab :: D -> Tab -> Sig -> SE Sig
padsynthOscByTab baseFreq tab freq = ares
where
len = ftlen tab
wave = rndPhs (\phs freq -> poscil 1 freq tab `withD` phs)
ares = wave (freq * (sig $ (getSampleRate / len) / baseFreq))
toStereoOsc :: (a -> SE Sig) -> (a -> SE Sig2)
toStereoOsc f x = do
left <- f x
right <- f x
return (left, right)
padsynthOsc2 :: PadsynthSpec -> Sig -> SE Sig2
padsynthOsc2 spec freq = toStereoOsc (padsynthOsc spec) freq
layeredPadsynthSpec :: D -> [(D, PadsynthSpec)] -> SE (D, Tab)
layeredPadsynthSpec val specs = do
refTab <- newCtrlRef lastTab
refBaseFreq <- newCtrlRef lastBaseFreq
compareWhenD val (fmap (second $ toCase refTab refBaseFreq) specs)
tab <- readRef refTab
baseFreq <- readRef refBaseFreq
return (baseFreq, tab)
where
toCase refTab refBaseFreq spec = do
writeRef refTab (padsynth spec)
writeRef refBaseFreq (double $ padsynthFundamental spec)
lastTab = padsynth $ snd $ last specs
lastBaseFreq = double $ padsynthFundamental $ snd $ last specs
toThreshholdCond :: D -> (Double, PadsynthSpec) -> (BoolD, PadsynthSpec)
toThreshholdCond val (thresh, spec) = (val `lessThanEquals` double thresh, spec)
padsynthOscMultiCps :: [(Double, PadsynthSpec)] -> D -> SE Sig
padsynthOscMultiCps specs freq = do
(baseFreq, tab) <- layeredPadsynthSpec freq (fmap (first double) specs)
padsynthOscByTab baseFreq tab (sig freq)
padsynthOscMultiCps2 :: [(Double, PadsynthSpec)] -> D -> SE Sig2
padsynthOscMultiCps2 specs freq = do
(baseFreq, tab) <- layeredPadsynthSpec freq (fmap (first double) specs)
toStereoOsc (padsynthOscByTab baseFreq tab) (sig freq)
padsynthOscMultiVol :: [(Double, PadsynthSpec)] -> (D, Sig) -> SE Sig
padsynthOscMultiVol specs (amp, freq) = do
(baseFreq, tab) <- layeredPadsynthSpec amp (fmap (first double) specs)
fmap (sig amp * ) $ padsynthOscByTab baseFreq tab freq
padsynthOscMultiVol2 :: [(Double, PadsynthSpec)] -> (D, Sig) -> SE Sig2
padsynthOscMultiVol2 specs (amp, freq) = do
(baseFreq, tab) <- layeredPadsynthSpec amp (fmap (first double) specs)
toStereoOsc (fmap (sig amp * ) . padsynthOscByTab baseFreq tab) freq
padsynthOscMultiVolCps :: [((Double, Double), PadsynthSpec)] -> (D, D) -> SE Sig
padsynthOscMultiVolCps specs (amp, freq) = undefined
padsynthOscMultiVolCps2 :: [((Double, Double), PadsynthSpec)] -> (D, D) -> SE Sig2
padsynthOscMultiVolCps2 specs x = toStereoOsc (padsynthOscMultiVolCps specs) x
bwOscBy :: [Double] -> Double -> Sig -> SE Sig
bwOscBy harmonics bandwidth = padsynthOsc (defPadsynthSpec bandwidth harmonics)
bwOscBy2 :: [Double] -> Double -> Sig -> SE Sig2
bwOscBy2 harmonics bandwidth = toStereoOsc (bwOscBy harmonics bandwidth)
bwOddOscBy :: [Double] -> Double -> Sig -> SE Sig
bwOddOscBy harmonics bandwidth = padsynthOsc ((defPadsynthSpec bandwidth harmonics) { padsynthHarmonicStretch = 2 })
bwOddOscBy2 :: [Double] -> Double -> Sig -> SE Sig2
bwOddOscBy2 harmonics bandwidth = toStereoOsc (bwOddOscBy harmonics bandwidth)
limit = 15
triCoeff = intersperse 0 $ zipWith (*) (iterate (* (-1)) (1)) $ fmap (\x -> 1 / (x * x)) $ [1, 3 ..]
sqrCoeff = intersperse 0 $ zipWith (*) (iterate (* (-1)) (1)) $ fmap (\x -> 1 / (x)) $ [1, 3 ..]
sawCoeff = zipWith (*) (iterate (* (-1)) (1)) $ fmap (\x -> 1 / (x)) $ [1, 2 ..]
bwOsc :: Double -> Sig -> SE Sig
bwOsc = bwOscBy [1]
bwTri :: Double -> Sig -> SE Sig
bwTri = bwOscBy (take limit triCoeff)
bwSqr :: Double -> Sig -> SE Sig
bwSqr = bwOscBy (take limit sqrCoeff)
bwSaw :: Double -> Sig -> SE Sig
bwSaw = bwOscBy (take limit sawCoeff)
bwOsc2 :: Double -> Sig -> SE Sig2
bwOsc2 bandwidth = toStereoOsc (bwOsc bandwidth)
bwTri2 :: Double -> Sig -> SE Sig2
bwTri2 bandwidth = toStereoOsc (bwTri bandwidth)
bwSqr2 :: Double -> Sig -> SE Sig2
bwSqr2 bandwidth = toStereoOsc (bwSqr bandwidth)
bwSaw2 :: Double -> Sig -> SE Sig2
bwSaw2 bandwidth = toStereoOsc (bwSaw bandwidth)
morphsynthOscMultiCps :: MorphSpec -> [(Double, PadsynthSpec)] -> D -> SE Sig2
morphsynthOscMultiCps morphSpec specs freq = do
(baseFreq, tab) <- layeredPadsynthSpec freq (fmap (first double) specs)
morpheusOsc morphSpec (baseFreq, tab) (sig freq)
quadMorphsynthOscMultiCps :: MorphSpec -> [[(Double, PadsynthSpec)]] -> (Sig, Sig) -> D -> SE Sig2
quadMorphsynthOscMultiCps morphSpec specs (x, y) freq = do
freqTabs <- mapM getFreqTab specs
let mainFreq = fst $ head freqTabs
morpheusOsc2 morphSpec mainFreq (fmap (toTab mainFreq) freqTabs) (x, y) (sig freq)
where
getFreqTab specs = layeredPadsynthSpec freq (fmap (first double) specs)
toTab mainFreq (freq, t) = (sig $ freq / mainFreq, t)