synthesizer-llvm-0.2: src/Synthesizer/LLVM/Server/Packed/Instrument.hs
{-# LANGUAGE Rank2Types #-}
module Synthesizer.LLVM.Server.Packed.Instrument where
import Synthesizer.LLVM.Server.Common
import qualified Synthesizer.EventList.ALSA.MIDI as Ev
import qualified Synthesizer.PiecewiseConstant.ALSA.MIDI as PC
import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
import qualified Sound.Sox.Read as SoxRead
import qualified Sound.Sox.Option.Format as SoxOption
import Synthesizer.Storable.ALSA.MIDI (Instrument, chunkSizesFromLazyTime, )
import qualified Synthesizer.LLVM.Filter.Universal as UniFilterL
import qualified Synthesizer.LLVM.Filter.Allpass as Allpass
import qualified Synthesizer.LLVM.Filter.Moog as MoogL
import qualified Synthesizer.LLVM.ALSA.MIDI as MIDIL
import qualified Synthesizer.LLVM.CausalParameterized.ProcessPacked as CausalPS
import qualified Synthesizer.LLVM.CausalParameterized.ControlledPacked as CtrlPS
import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS
import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
import qualified Synthesizer.LLVM.Storable.Signal as SigStL
import qualified Synthesizer.LLVM.Sample as Sample
import qualified Synthesizer.LLVM.Wave as WaveL
import qualified Synthesizer.LLVM.Parameter as Param
import Synthesizer.LLVM.CausalParameterized.Process (($<), ($>), ($*), )
import Synthesizer.LLVM.Parameterized.Signal (($#), )
import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Monad as LM
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Core as LLVM
import qualified Data.TypeLevel.Num as TypeNum
import Control.Arrow.Monad ((=<<<), listen, )
import qualified Data.HList as HL
import qualified Synthesizer.Generic.Cut as CutG
import qualified Synthesizer.Storable.Signal as SigSt
import qualified Data.StorableVector.Lazy.Pattern as SVP
import qualified Data.StorableVector.Lazy as SVL
import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter
import Control.Arrow ((<<<), (^<<), (<<^), (&&&), (***), arr, first, second, )
import Control.Applicative (liftA2, liftA3, )
import Data.Tuple.HT (mapPair, fst3, snd3, thd3, )
import Data.Int (Int32, )
{-
import qualified Numeric.NonNegative.Class as NonNeg
import qualified Numeric.NonNegative.Wrapper as NonNegW
-}
import qualified Numeric.NonNegative.Chunky as NonNegChunky
import qualified Algebra.RealRing as RealRing
import qualified Algebra.Additive as Additive
import NumericPrelude.Numeric (zero, round, (^?), )
import Prelude hiding (Real, round, break, )
type Vector = LLVM.Vector VectorSize Real
type VectorSize = TypeNum.D4
vectorSize :: Int
vectorSize = TypeNum.toInt (undefined :: VectorSize)
vectorChunkSize :: SVL.ChunkSize
vectorChunkSize =
let (SVL.ChunkSize size) = chunkSize
in SVL.ChunkSize (div size vectorSize)
vectorRate :: Fractional a => a
vectorRate = sampleRate / fromIntegral vectorSize
frequencyFromBendModulation ::
{-
(Storable a,
LLVM.MakeValueTuple a (Value a)) =>
-}
Param.T p Real ->
Param.T p (PC.T (PC.BendModulation Real), Real) ->
SigP.T p (LLVM.Value Vector)
frequencyFromBendModulation speed fmFreq =
MIDIL.frequencyFromBendModulationPacked (speed/sampleRate)
$* piecewiseConstant
(fmap (\(fm,freq) -> transposeModulation freq fm) fmFreq)
stereoFrequenciesFromDetuneBendModulation ::
Param.T p Real ->
Param.T p (PC.T Real, PC.T (PC.BendModulation Real), Real) ->
SigP.T p (Stereo.T (LLVM.Value Vector))
stereoFrequenciesFromDetuneBendModulation speed detFmFreq =
(CausalP.envelopeStereo
$< frequencyFromBendModulation speed
(fmap (\(_det,fm,freq) -> (fm,freq)) detFmFreq))
<<<
CausalP.zipWithSimple Sample.zipStereo
<<<
CausalPS.raise 1 &&&
(CausalPS.raise 1 <<< CausalP.mapSimple LLVM.neg)
$* piecewiseConstantVector
(fmap (\(det,_fm,_freq) -> det) detFmFreq)
pingReleaseEnvelope ::
IO (Real -> Real -> Real -> Ev.LazyTime -> SigSt.T Vector)
pingReleaseEnvelope =
liftA2
(\pressed release decay rel vel dur ->
SigStL.continuePacked
(pressed (chunkSizesFromLazyTime dur) (decay,vel))
(\x -> release vectorChunkSize (rel,x)))
(SigP.runChunkyPattern $
let decay = arr fst
velocity = arr snd
in SigPS.exponential2 (decay*sampleRate)
(amplitudeFromVelocity ^<< velocity))
(SigP.runChunky $
let release = arr fst
amplitude = arr snd
in (CausalP.take (round ^<< (release*5*vectorRate)) $*
SigPS.exponential2 (release*sampleRate) amplitude))
pingRelease ::
IO (Real -> Real -> Instrument Real Vector)
pingRelease =
liftA2
(\osc env dec rel vel freq dur ->
osc freq (env dec rel vel dur))
(CausalP.runStorableChunky
(let freq = arr id
in CausalP.envelope $>
SigPS.osciSimple WaveL.saw zero (freq/sampleRate)))
pingReleaseEnvelope
pingStereoRelease ::
IO (Real -> Real -> Instrument Real (Stereo.T Vector))
pingStereoRelease =
liftA2
(\osc env dec rel vel freq dur ->
osc freq (env dec rel vel dur))
(CausalP.runStorableChunky
(let freq = arr id
in CausalP.envelopeStereo $>
SigP.zipWithSimple Sample.zipStereo
(SigPS.osciSimple WaveL.saw zero
(0.999*freq/sampleRate))
(SigPS.osciSimple WaveL.saw zero
(1.001*freq/sampleRate))))
pingReleaseEnvelope
pingStereoReleaseFM ::
IO (Real -> Real ->
PC.T Real ->
PC.T Real ->
Real -> Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
pingStereoReleaseFM =
liftA2
(\osc env dec rel detune shape phase phaseDecay fm vel freq dur ->
osc
((phase, phaseDecay), shape, (detune,fm,freq))
(env dec rel vel dur))
(CausalP.runStorableChunky
(let phs = arr (fst.fst3)
dec = arr (snd.fst3)
shp = arr snd3
fm = arr thd3
in CausalP.envelopeStereo $>
((CausalP.stereoFromMonoControlled
(CausalPS.shapeModOsci WaveL.rationalApproxSine1)
$< piecewiseConstantVector shp)
<<^ Stereo.interleave
$< (CausalP.zipWithSimple Sample.zipStereo
<<<
arr id &&& CausalP.mapSimple LLVM.neg
$* SigPS.exponential2 (dec*sampleRate) phs)
$* stereoFrequenciesFromDetuneBendModulation 10 fm)))
pingReleaseEnvelope
{- |
Square like wave constructed as difference
of two phase shifted sawtooth like oscillations.
-}
squareStereoReleaseFM ::
IO (Real -> Real ->
PC.T Real ->
PC.T Real ->
PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
squareStereoReleaseFM =
liftA2
(\osc env dec rel detune shape phase fm vel freq dur ->
osc
((phase, shape), (detune,fm,freq))
(env dec rel vel dur))
(CausalP.runStorableChunky
(let phs = arr (fst.fst)
shp = arr (snd.fst)
fm = arr snd
chanOsci =
CausalP.mix
<<<
(CausalPS.shapeModOsci WaveL.rationalApproxSine1
<<<
second (first (CausalP.mapSimple LLVM.neg)))
&&&
(CausalP.mapSimple LLVM.neg
<<<
CausalPS.shapeModOsci WaveL.rationalApproxSine1)
<<^
(\((p,s),f) -> (s,(p,f)))
in CausalP.envelopeStereo $>
((CausalP.stereoFromMonoControlled chanOsci
$< SigP.zip
(piecewiseConstantVector phs)
(piecewiseConstantVector shp))
$* stereoFrequenciesFromDetuneBendModulation 10 fm)))
pingReleaseEnvelope
bellStereoFM ::
IO (Real -> Real ->
PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
bellStereoFM =
liftA2
(\osc env dec rel detune fm vel freq dur ->
osc ((detune, fm, freq), vel,
(env (dec/4) rel vel dur,
env (dec/7) rel vel dur))
(env dec rel vel dur))
(CausalP.runStorableChunky
(let fm = arr fst3
vel = arr snd3
env4 = arr (fst.thd3)
env7 = arr (snd.thd3)
mix x y = CausalP.mixStereo <<< x&&&y
osci sel v d =
CausalP.envelopeStereo
<<<
(arr sel ***
(CausalPS.amplifyStereo v
<<<
CausalP.stereoFromMono
(CausalPS.osciSimple WaveL.approxSine4
$< SigPS.constant zero)
<<<
CausalPS.amplifyStereo d))
in (osci fst3 0.6 1 `mix`
osci snd3 (0.02 * 50^?vel) 4 `mix`
osci thd3 (0.02 * 100^?vel) 7)
<<<
CausalP.feedSnd (stereoFrequenciesFromDetuneBendModulation 5 fm)
<<<
arr (\(e1,(e4,e7)) -> (e1,e4,e7))
$> {-
Be careful, those storable vectors shorten the whole sound
if they have shorter release than the main envelope.
-}
SigP.zip
(SigP.fromStorableVectorLazy env4)
(SigP.fromStorableVectorLazy env7)))
pingReleaseEnvelope
bellNoiseStereoFM ::
IO (Real -> Real ->
PC.T Real -> PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
bellNoiseStereoFM =
liftA2
(\osc env dec rel noiseAmp noiseReson fm vel freq dur ->
osc ((fm, freq),
(noiseAmp,noiseReson),
(vel,
env (dec/4) rel vel dur,
env (dec/7) rel vel dur))
(env dec rel vel dur))
(CausalP.runStorableChunky
(let fm = arr fst3
noiseAmp = arr (fst.snd3)
noiseReson = arr (snd.snd3)
vel = arr (fst3.thd3)
env4 = arr (snd3.thd3)
env7 = arr (thd3.thd3)
mix x y = CausalP.mix <<< x&&&y
osci sel v d =
CausalP.envelope
<<<
(arr sel ***
(CausalPS.amplify v
<<<
(CausalPS.osciSimple WaveL.approxSine4
$< SigPS.constant zero)
<<<
CausalPS.amplify d))
noise sel d =
(CausalP.envelope $<
piecewiseConstantVector noiseAmp)
<<<
CausalP.envelope
<<<
(arr sel ***
({- UniFilter.lowpass
^<< -}
(CtrlPS.process
$> SigPS.noise 12 (sampleRate/20000))
<<<
-- CausalP.zipWithSimple UniFilterL.parameter
CausalP.zipWithSimple (MoogL.parameter TypeNum.d8)
{-
FIXME:
This leads to a run-time crash even without LLVM optimizations.
However, I cannot reproduce this in the Test module.
(CausalP.quantizeLift $# (1 :: Real)) (arr id)
(CausalP.quantizeLift
$# (128 / fromIntegral vectorSize :: Real))
(CausalP.zipWithSimple UniFilterL.parameter)
(CausalP.quantizeLift
$# (128 / fromIntegral vectorSize :: Real))
(CausalP.zipWithSimple (MoogL.parameter TypeNum.d8))
-}
<<<
CausalP.feedFst (piecewiseConstant noiseReson)
<<<
CausalP.mapSimple Sample.subsampleVector
<<<
CausalPS.amplify d))
in CausalP.zipWithSimple Sample.zipStereo
<<<
(osci fst3 0.6 (1*0.999) `mix`
osci snd3 (0.02 * 50^?vel) (4*0.999) `mix`
osci thd3 (0.02 * 100^?vel) (7*0.999) `mix`
noise fst3 0.999) &&&
(osci fst3 0.6 (1*1.001) `mix`
osci snd3 (0.02 * 50^?vel) (4*1.001) `mix`
osci thd3 (0.02 * 100^?vel) (7*1.001) `mix`
noise fst3 1.001)
<<<
CausalP.feedSnd (frequencyFromBendModulation 5 fm)
<<<
arr (\(e1,(e4,e7)) -> (e1,e4,e7))
$> {-
Be careful, those storable vectors shorten the whole sound
if they have shorter release than the main envelope.
-}
SigP.zip
(SigP.fromStorableVectorLazy env4)
(SigP.fromStorableVectorLazy env7)))
pingReleaseEnvelope
tine :: IO (Real -> Real -> Instrument Real Vector)
tine =
liftA2
(\osc env dec rel vel freq dur ->
osc (vel,freq) (env dec rel 0 dur))
(CausalP.runStorableChunky
(let freq = arr snd
vel = arr fst
in CausalP.envelope $>
(CausalPS.osciSimple WaveL.approxSine2
$> (SigPS.constant (freq/sampleRate))
$* (CausalP.envelope
$< SigPS.exponential2 (1*sampleRate) (vel+1)
$* SigPS.osciSimple WaveL.approxSine2 zero
(2*freq/sampleRate)))))
pingReleaseEnvelope
tineStereo :: IO (Real -> Real -> Instrument Real (Stereo.T Vector))
tineStereo =
liftA2
(\osc env dec rel vel freq dur ->
osc (vel,freq) (env dec rel 0 dur))
(CausalP.runStorableChunky
(let freq = arr snd
vel = arr fst
chanOsci d =
CausalPS.osciSimple WaveL.approxSine2
$> SigPS.constant (freq*d/sampleRate)
in CausalP.envelopeStereo $>
((CausalP.zipWithSimple Sample.zipStereo <<<
(chanOsci 0.995 &&& chanOsci 1.005))
$* SigP.envelope
(SigPS.exponential2 (1*sampleRate) (vel+1))
(SigPS.osciSimple WaveL.approxSine2 zero
(2*freq/sampleRate)))))
pingReleaseEnvelope
softStringReleaseEnvelope ::
IO (Real -> Real -> Ev.LazyTime -> SigSt.T Vector)
softStringReleaseEnvelope =
liftA2
(\rev env attackTime vel dur ->
let attackTimeVector =
div (round (attackTime*sampleRate)) vectorSize
amp = amplitudeFromVelocity vel
{-
release <- take attackTime beginning
would yield a space leak, thus we first split 'beginning'
and then concatenate it again
-}
{-
We can not easily generate attack and sustain separately,
because we want to use the chunk structure implied by 'dur'.
-}
(attack, sustain) =
SigSt.splitAt attackTimeVector $
env (chunkSizesFromLazyTime dur) (amp, attackTimeVector)
release = rev attack
in attack `SigSt.append` sustain `SigSt.append` release)
SigStL.makeReversePacked
(let amp = arr fst
attackTimeVector = arr snd
in SigP.runChunkyPattern $
flip SigP.append (SigPS.constant amp) $
(CausalPS.amplify amp <<<
CausalP.take attackTimeVector
$* SigPS.parabolaFadeInInf
(fmap fromIntegral attackTimeVector *
fromIntegral vectorSize)))
softString :: IO (Instrument Real (Stereo.T Vector))
softString =
liftA2
(\osc env vel freq dur ->
osc freq (env 1 vel dur))
(let freq = arr id
osci d =
SigPS.osciSimple WaveL.saw zero (d * freq / sampleRate)
in CausalP.runStorableChunky $
(CausalP.envelopeStereo $>
(SigP.zipWithSimple Sample.zipStereo
(SigP.mix
(osci 1.005)
(osci 0.998))
(SigP.mix
(osci 1.002)
(osci 0.995)))))
softStringReleaseEnvelope
softStringFM ::
IO (PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
softStringFM =
liftA2
(\osc env fm vel freq dur ->
osc (fm,freq) (env 1 vel dur))
(let fm = arr id
osci ::
Param.T fm Real ->
CausalP.T fm (LLVM.Value Vector) (LLVM.Value Vector)
osci d =
(CausalPS.osciSimple WaveL.saw $<
(SigPS.constant $# (zero::Real))) <<<
CausalPS.amplify d
in CausalP.runStorableChunky $
(CausalP.envelopeStereo $>
(CausalP.zipWithSimple Sample.zipStereo
<<<
(CausalP.mix <<< osci 1.005 &&& osci 0.998) &&&
(CausalP.mix <<< osci 1.002 &&& osci 0.995)
$* frequencyFromBendModulation 5 fm)))
softStringReleaseEnvelope
tineStereoFM ::
IO (Real -> Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
tineStereoFM =
liftA2
(\osc env dec rel fm vel freq dur ->
osc (vel,(fm,freq)) (env dec rel 0 dur))
(CausalP.runStorableChunky
(let vel = arr fst
fm = arr snd
chanOsci d =
CausalPS.osciSimple WaveL.approxSine2
<<< second (CausalPS.amplify d)
in CausalP.envelopeStereo $>
((CausalP.zipWithSimple Sample.zipStereo <<<
chanOsci 0.995 &&& chanOsci 1.005)
<<<
(((CausalP.envelope
$< SigPS.exponential2 (1*sampleRate) (vel+1))
<<< (CausalPS.osciSimple WaveL.approxSine2
$< (SigPS.constant $# (zero::Real)))
<<< CausalPS.amplify 2)
&&& arr id)
$* frequencyFromBendModulation 5 fm)))
pingReleaseEnvelope
tineControlledProc, tineControlledFnProc ::
Param.T p (PC.T Real) ->
Param.T p (PC.T Real) ->
Param.T p Real ->
CausalP.T p
(Stereo.T (LLVM.Value Vector))
(Stereo.T (LLVM.Value Vector))
tineControlledProc index depth vel =
CausalP.stereoFromMono
(CausalPS.osciSimple WaveL.approxSine2)
<<<
Stereo.interleave
^<<
((CausalP.envelopeStereo
$< SigP.envelope
(piecewiseConstantVector depth)
(SigPS.exponential2 (1*sampleRate) (vel+1)))
<<<
CausalP.stereoFromMono
(CausalPS.osciSimple WaveL.approxSine2
$< (SigPS.constant $# (zero::Real)))
<<<
(CausalP.envelopeStereo
$< piecewiseConstantVector index))
&&& arr id
tineControlledFnProc index depth vel =
((\freq ->
CausalP.stereoFromMono
(CausalPS.osciSimple WaveL.approxSine2)
<<<
Stereo.interleave
^<<
((CausalP.envelopeStereo
$< SigP.envelope
(piecewiseConstantVector depth)
(SigPS.exponential2 (1*sampleRate) (vel+1)))
<<<
CausalP.stereoFromMono
(CausalPS.osciSimple WaveL.approxSine2
$< (SigPS.constant $# (zero::Real)))
<<<
(CausalP.envelopeStereo
$< piecewiseConstantVector index)
<<<
listen freq)
&&&
listen freq)
-- =<<< listen HL.hNil
=<<< arr HL.hHead)
<<< arr (\freq -> HL.hCons freq HL.hNil)
tineControlledFM ::
IO (Real -> Real ->
PC.T Real ->
PC.T Real -> PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
tineControlledFM =
liftA2
(\osc env dec rel detune index depth fm vel freq dur ->
osc
((index, depth), vel, (detune,fm,freq))
(env dec rel 0 dur))
(CausalP.runStorableChunky
(let index = arr (fst.fst3)
depth = arr (snd.fst3)
vel = arr snd3
fm = arr thd3
in CausalP.envelopeStereo $>
(tineControlledFnProc index depth vel $*
stereoFrequenciesFromDetuneBendModulation 5 fm)))
pingReleaseEnvelope
fenderProc ::
Param.T p (PC.T Real) ->
Param.T p (PC.T Real) ->
Param.T p (PC.T Real) ->
Param.T p Real ->
CausalP.T p
(Stereo.T (LLVM.Value Vector))
(Stereo.T (LLVM.Value Vector))
fenderProc fade index depth vel =
((\stereoFreq ->
let channel_n_1 freq =
CausalPS.osciSimple WaveL.approxSine2
<<<
((CausalP.envelope
$< SigP.envelope
(piecewiseConstantVector depth)
(SigPS.exponential2 (1*sampleRate) (vel+1)))
<<<
(CausalPS.osciSimple WaveL.approxSine2
$< (SigPS.constant $# (zero::Real)))
<<<
(CausalP.envelope
$< piecewiseConstantVector index)
<<<
freq)
&&&
freq
channel_1_2 freq =
CausalPS.osciSimple WaveL.approxSine2
<<<
((CausalP.envelope
$< SigP.envelope
(piecewiseConstantVector depth)
(SigPS.exponential2 (1*sampleRate) (vel+1)))
<<<
(CausalPS.osciSimple WaveL.approxSine2
$< (SigPS.constant $# (zero::Real)))
<<<
freq)
&&&
(CausalPS.amplify 2 <<< freq)
in (CausalP.stereoFromMonoControlled
(fadeProcess
(channel_n_1 (arr id))
(channel_1_2 (arr id)))
$< piecewiseConstantVector fade)
<<<
listen stereoFreq)
=<<< arr HL.hHead)
<<< arr (\freq -> HL.hCons freq HL.hNil)
fenderFM ::
IO (Real -> Real ->
PC.T Real ->
PC.T Real -> PC.T Real -> PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
fenderFM =
liftA2
(\osc env dec rel detune index depth fade fm vel freq dur ->
osc
(((index, depth), fade), vel, (detune,fm,freq))
(env dec rel 0 dur))
(CausalP.runStorableChunky
(let index = arr (fst.fst.fst3)
depth = arr (snd.fst.fst3)
fade = arr (snd.fst3)
vel = arr snd3
fm = arr thd3
in CausalP.envelopeStereo $>
(fenderProc fade index depth vel $*
stereoFrequenciesFromDetuneBendModulation 5 fm)))
pingReleaseEnvelope
tineModulatorBankFM ::
IO (Real -> Real ->
PC.T Real ->
PC.T Real -> PC.T Real -> PC.T Real -> PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
tineModulatorBankFM =
liftA2
(\osc env
dec rel detune
depth1 depth2 depth3 depth4
fm vel freq dur ->
osc
((depth1,(depth2,(depth3,(depth4,())))), vel, (detune,fm,freq))
(env dec rel 0 dur))
(CausalP.runStorableChunky
(let depth1 = arr (fst.fst3)
depth2 = arr (fst.snd.fst3)
depth3 = arr (fst.snd.snd.fst3)
depth4 = arr (fst.snd.snd.snd.fst3)
vel = arr snd3
fm = arr thd3
mix x y = CausalP.mixStereo <<< x&&&y
modulator n depth =
(CausalP.envelopeStereo
$< SigP.envelope
(piecewiseConstantVector depth)
(SigPS.exponential2 (1*sampleRate) (vel+1)))
<<<
CausalP.stereoFromMono
(CausalPS.osciSimple WaveL.approxSine2
$< (SigPS.constant $# (zero::Real)))
<<<
CausalP.amplifyStereo n
in CausalP.envelopeStereo $>
(CausalP.stereoFromMono
(CausalPS.osciSimple WaveL.approxSine2)
<<<
Stereo.interleave
^<<
(modulator 1 depth1 `mix`
modulator 2 depth2 `mix`
modulator 3 depth3 `mix`
modulator 4 depth4)
&&& arr id
$*
stereoFrequenciesFromDetuneBendModulation 5 fm)))
pingReleaseEnvelope
tineBankFM ::
IO (Real -> Real ->
PC.T Real ->
PC.T Real -> PC.T Real -> PC.T Real -> PC.T Real ->
PC.T Real -> PC.T Real -> PC.T Real -> PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
tineBankFM =
liftA2
(\osc env
dec rel detune
depth1 depth2 depth3 depth4
partial1 partial2 partial3 partial4
fm vel freq dur ->
osc
((depth1,(depth2,(depth3,(depth4,())))),
(partial1,(partial2,(partial3,(partial4,())))),
(vel, (detune,fm,freq)))
(env dec rel 0 dur))
(CausalP.runStorableChunky
(let depth1 = arr (fst.fst3)
depth2 = arr (fst.snd.fst3)
depth3 = arr (fst.snd.snd.fst3)
depth4 = arr (fst.snd.snd.snd.fst3)
partial1 = arr (fst.snd3)
partial2 = arr (fst.snd.snd3)
partial3 = arr (fst.snd.snd.snd3)
partial4 = arr (fst.snd.snd.snd.snd3)
vel = arr (fst.thd3)
fm = arr (snd.thd3)
mixStereo x y = CausalP.mixStereo <<< x&&&y
modulator n depth =
(CausalP.envelopeStereo
$< SigP.envelope
(piecewiseConstantVector depth)
(SigPS.exponential2 (1*sampleRate) (vel+1)))
<<<
CausalP.stereoFromMono
(CausalPS.osciSimple WaveL.approxSine2
$< (SigPS.constant $# (zero::Real)))
<<<
CausalP.amplifyStereo n
partial ::
LLVM.Value Vector -> Int32 -> LLVM.Value Vector ->
LLVM.CodeGenFunction r (LLVM.Value Vector)
partial amp n t =
A.mul amp =<<
WaveL.partial WaveL.approxSine2 (LLVM.valueOf n) t
in CausalP.envelopeStereo $>
(CausalP.stereoFromMono
(CausalPS.shapeModOsci
(\(p1,(p2,(p3,p4))) t -> do
y1 <- A.mul p1 =<< WaveL.approxSine2 t
y2 <- partial p2 2 t
y3 <- partial p3 3 t
y4 <- partial p4 4 t
A.add y1 =<< A.add y2 =<< A.add y3 y4)
$<
(SigP.zip (piecewiseConstantVector partial1) $
SigP.zip (piecewiseConstantVector partial2) $
SigP.zip (piecewiseConstantVector partial3)
(piecewiseConstantVector partial4)))
<<<
Stereo.interleave
^<<
(modulator 1 depth1 `mixStereo`
modulator 2 depth2 `mixStereo`
modulator 3 depth3 `mixStereo`
modulator 4 depth4)
&&& arr id
$*
stereoFrequenciesFromDetuneBendModulation 5 fm)))
pingReleaseEnvelope
{- |
FM synthesis where the modulator is a resonantly filtered sawtooth.
This way we get a sinus-like modulator where the sine frequency
(that is, something like the modulation index) can be controlled continously.
-}
resonantFMSynthProc ::
Param.T p (PC.T Real) ->
Param.T p (PC.T Real) ->
Param.T p (PC.T Real) ->
Param.T p Real ->
CausalP.T p
(Stereo.T (LLVM.Value Vector))
(Stereo.T (LLVM.Value Vector))
resonantFMSynthProc reson index depth vel =
((\stereoFreq ->
let chan freq =
CausalPS.osciSimple WaveL.approxSine2
<<<
((CausalP.envelope
$< SigP.envelope
(piecewiseConstantVector depth)
(SigPS.exponential2 (1*sampleRate) (vel+1)))
<<<
UniFilter.lowpass
^<<
CtrlPS.process
<<<
(CausalP.zipWithSimple UniFilterL.parameter
<<<
CausalP.feedFst (piecewiseConstant reson)
<<<
(CausalP.envelope $< piecewiseConstant index)
<<<
CausalP.mapSimple Sample.subsampleVector
<<<
freq)
&&&
((CausalPS.osciSimple WaveL.saw
$< (SigPS.constant $# (zero::Real)))
<<<
freq))
&&&
freq
in CausalP.stereoFromMono (chan (arr id))
<<<
listen stereoFreq)
=<<< arr HL.hHead)
<<< arr (\freq -> HL.hCons freq HL.hNil)
resonantFMSynth ::
IO (Real -> Real ->
PC.T Real ->
PC.T Real -> PC.T Real -> PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
resonantFMSynth =
liftA2
(\osc env dec rel detune reson index depth fm vel freq dur ->
osc
((reson, index, depth), vel, (detune,fm,freq))
(env dec rel 0 dur))
(CausalP.runStorableChunky
(let reson = arr (fst3.fst3)
index = arr (snd3.fst3)
depth = arr (thd3.fst3)
vel = arr snd3
fm = arr thd3
in CausalP.envelopeStereo $>
(resonantFMSynthProc reson index depth vel $*
stereoFrequenciesFromDetuneBendModulation 5 fm)))
pingReleaseEnvelope
piecewiseConstantVector ::
Param.T p (PC.T Real) -> SigP.T p (LLVM.Value Vector)
{-
(Storable a,
LLVM.MakeValueTuple a al,
Rep.Memory al am,
LLVM.IsSized am as) =>
Param.T p (PC.T a) -> SigP.T p (LLVM.Vector n al)
-}
piecewiseConstantVector pc =
SigP.mapSimple SoV.replicate $
piecewiseConstant pc
softStringDetuneFM ::
IO (Real ->
PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
softStringDetuneFM =
liftA2
(\osc env att det fm vel freq dur ->
osc (det, (fm,freq)) (env att vel dur))
(let det = arr fst
fm = arr snd
mix x y = CausalP.mix <<< x&&&y
osci ::
Param.T (det,fm) Real ->
CausalP.T (det,fm)
(LLVM.Value Vector, LLVM.Value Vector)
(LLVM.Value Vector)
osci d =
(CausalPS.osciSimple WaveL.saw $<
(SigPS.constant $# (zero::Real)))
<<<
CausalP.envelope
<<<
first (CausalPS.raise 1 <<< CausalPS.amplify d)
in CausalP.runStorableChunky $
(CausalP.envelopeStereo $>
(CausalPS.amplifyStereo 0.25
<<<
CausalP.zipWithSimple Sample.zipStereo
<<<
((osci 1.0 `mix` osci (-0.4)) `mix`
(osci 0.5 `mix` osci (-0.7))) &&&
((osci 0.4 `mix` osci (-1.0)) `mix`
(osci 0.7 `mix` osci (-0.5)))
<<<
CausalP.feedFst (piecewiseConstantVector det)
$* frequencyFromBendModulation 5 fm)))
softStringReleaseEnvelope
{-
We might decouple the frequency of the enveloped tone
from the frequency of the envelope,
in order to get something like formants.
-}
softStringShapeFM, cosineStringStereoFM,
arcSineStringStereoFM, arcTriangleStringStereoFM,
arcSquareStringStereoFM, arcSawStringStereoFM ::
IO (Real ->
PC.T Real ->
PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
softStringShapeFM =
softStringShapeCore WaveL.rationalApproxSine1
cosineStringStereoFM =
softStringShapeCore
(\k p -> WaveL.approxSine2 =<< WaveL.replicate k p)
arcSawStringStereoFM = arcStringStereoFM WaveL.saw
arcSineStringStereoFM = arcStringStereoFM WaveL.approxSine2
arcSquareStringStereoFM = arcStringStereoFM WaveL.square
arcTriangleStringStereoFM = arcStringStereoFM WaveL.triangle
arcStringStereoFM ::
(forall r.
LLVM.Value Vector ->
LLVM.CodeGenFunction r (LLVM.Value Vector)) ->
IO (Real ->
PC.T Real ->
PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
arcStringStereoFM wave =
softStringShapeCore
(\k p ->
LM.liftR2 Sample.amplifyMono
(WaveL.approxSine4 =<< WaveL.halfEnvelope p)
(wave =<< WaveL.replicate k p))
softStringShapeCore ::
(forall r.
LLVM.Value Vector ->
LLVM.Value Vector ->
LLVM.CodeGenFunction r (LLVM.Value Vector)) ->
IO (Real ->
PC.T Real ->
PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
softStringShapeCore wave =
liftA2
(\osc env att det dist fm vel freq dur ->
osc ((det, dist), (fm,freq)) (env att vel dur))
(let det = arr (fst.fst)
dist = arr (snd.fst)
fm = arr snd
mix x y = CausalP.mix <<< x&&&y
osci ::
Param.T (mod,fm) Real ->
CausalP.T (mod,fm)
(LLVM.Value Vector,
{- wave shape parameter -}
(LLVM.Value Vector, LLVM.Value Vector)
{- detune, frequency modulation -})
(LLVM.Value Vector)
osci d =
CausalPS.shapeModOsci wave
<<<
second
(CausalP.feedFst (SigPS.constant $# (zero::Real))
<<<
CausalP.envelope
<<<
first (CausalPS.raise 1 <<< CausalPS.amplify d))
in CausalP.runStorableChunky $
(CausalP.envelopeStereo $>
(CausalPS.amplifyStereo 0.25
<<<
CausalP.zipWithSimple Sample.zipStereo
<<<
((osci 1.0 `mix` osci (-0.4)) `mix`
(osci 0.5 `mix` osci (-0.7))) &&&
((osci 0.4 `mix` osci (-1.0)) `mix`
(osci 0.7 `mix` osci (-0.5)))
$< piecewiseConstantVector dist
$< piecewiseConstantVector det
$* frequencyFromBendModulation 5 fm)))
softStringReleaseEnvelope
fmStringStereoFM ::
IO (Real ->
PC.T Real ->
PC.T Real ->
PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
fmStringStereoFM =
liftA2
(\osc env att det depth dist fm vel freq dur ->
osc ((det, depth, dist), (fm, freq)) (env att vel dur))
(let det = arr (fst3.fst)
depth = arr (snd3.fst)
dist = arr (thd3.fst)
fm = arr snd
mix x y = CausalP.mix <<< x&&&y
osci ::
Param.T (mod,fm) Real ->
CausalP.T (mod,fm)
((LLVM.Value Vector, LLVM.Value Vector)
{- phase modulation depth, modulator distortion -},
(LLVM.Value Vector, LLVM.Value Vector)
{- detune, frequency modulation -})
(LLVM.Value Vector)
osci d =
CausalPS.osciSimple WaveL.approxSine2
<<<
(CausalP.envelope
<<<
second
(CausalPS.shapeModOsci WaveL.rationalApproxSine1
<<< second (CausalP.feedFst (SigPS.constant 0)))
<<^
(\((dp, ds), f) -> (dp, (ds, f))))
&&& arr snd
<<<
second
(CausalP.envelope <<<
first (CausalPS.raise 1 <<< CausalPS.amplify d))
in CausalP.runStorableChunky
(CausalP.envelopeStereo <<<
(arr id &&&
(CausalPS.amplifyStereo 0.25
<<<
CausalP.zipWithSimple Sample.zipStereo
<<<
((osci 1.0 `mix` osci (-0.4)) `mix`
(osci 0.5 `mix` osci (-0.7))) &&&
((osci 0.4 `mix` osci (-1.0)) `mix`
(osci 0.7 `mix` osci (-0.5)))
<<<
CausalP.feedSnd
(SigP.zip
(piecewiseConstantVector det)
(frequencyFromBendModulation 5 fm))
<<<
CausalP.feedSnd (piecewiseConstantVector dist)
<<<
(CausalP.envelope
$< piecewiseConstantVector depth)))))
softStringReleaseEnvelope
wind ::
IO (Real ->
PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
wind =
liftA2
(\osc env att reson fm vel freq dur ->
osc (reson, (fm,freq)) (env att vel dur))
(let reson = arr fst
fm = arr snd
in CausalP.runStorableChunky $
(CausalP.envelopeStereo $>
(CausalP.stereoFromMonoControlled CtrlPS.process
$< SigP.zipWithSimple
(MoogL.parameter TypeNum.d8)
(piecewiseConstant reson)
(SigP.mapSimple Sample.subsampleVector
(frequencyFromBendModulation 0.2 fm))
$* SigP.zipWithSimple Sample.zipStereo
(SigPS.noise 13 (sampleRate/20000))
(SigPS.noise 14 (sampleRate/20000)
:: SigP.T p (LLVM.Value Vector)))))
softStringReleaseEnvelope
fadeProcess ::
(Num b, LLVM.IsConst b,
LLVM.IsArithmetic v, SoV.Replicate b v) =>
CausalP.T p a (LLVM.Value v) ->
CausalP.T p a (LLVM.Value v) ->
CausalP.T p (LLVM.Value v, a) (LLVM.Value v)
fadeProcess proc0 proc1 =
CausalP.mapSimple
(\(k,(a0,a1)) -> do
b0 <- A.mul a0 =<< A.sub (SoV.replicateOf 1) k
b1 <- A.mul a1 k
A.add b0 b1)
<<<
second (proc0 &&& proc1)
windPhaser ::
IO (Real ->
PC.T Real ->
PC.T Real ->
PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
windPhaser =
liftA2
(\osc env att phaserMix phaserFreq reson fm vel freq dur ->
osc ((phaserMix,phaserFreq), reson, (fm,freq)) (env att vel dur))
(let phaserMix = arr (fst.fst3)
phaserFreq = arr (snd.fst3)
reson = arr snd3
fm = arr thd3
in CausalP.runStorableChunky $
(CausalP.envelopeStereo $>
((CausalP.stereoFromMonoControlled
(fadeProcess (arr snd) CtrlPS.process
<<<
first (CausalP.mapSimple SoV.replicate)
<<^
(\((k,p),x) -> (k,(p,x))))
$< SigP.zip
(piecewiseConstant phaserMix)
(piecewiseConstant
(fmap
(Allpass.flangerParameterPlain TypeNum.d8 .
(/sampleRate))
^<< phaserFreq)))
<<<
CausalP.stereoFromMonoControlled CtrlPS.process
$< SigP.zipWithSimple
(MoogL.parameter TypeNum.d8)
(piecewiseConstant reson)
(SigP.mapSimple Sample.subsampleVector
(frequencyFromBendModulation 0.2 fm))
$* SigP.zipWithSimple Sample.zipStereo
(SigPS.noise 13 (sampleRate/20000))
(SigPS.noise 14 (sampleRate/20000)
:: SigP.T p (LLVM.Value Vector)))))
softStringReleaseEnvelope
filterSawStereoFM ::
IO (Real -> Real ->
PC.T Real ->
Real -> Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
filterSawStereoFM =
liftA2
(\osc env dec rel detune bright brightDecay fm vel freq dur ->
osc ((bright, brightDecay), (detune,fm,freq)) (env dec rel vel dur))
(CausalP.runStorableChunky
(let bright = arr (fst.fst)
brightDec = arr (snd.fst)
fm = arr snd
in CausalP.envelopeStereo $>
(CausalP.stereoFromMono
(UniFilter.lowpass
^<<
(CtrlPS.processCtrlRate $# (100::Real))
(\k -> SigP.mapSimple
(UniFilterL.parameter (LLVM.valueOf 10))
{- bound control in order to avoid too low resonant frequency,
which makes the filter instable -}
(SigP.exponentialBounded2
(100/sampleRate)
(brightDec*sampleRate/k)
(bright/sampleRate)))
<<<
CausalPS.osciSimple WaveL.saw $< SigPS.constant zero)
$* stereoFrequenciesFromDetuneBendModulation 10 fm)))
pingReleaseEnvelope
{- |
The ADSR curve is composed from three parts:
Attack, Decay(+Sustain), Release.
Attack starts when the key is pressed
and lasts attackTime seconds
where it reaches height attackPeak*amplitudeOfVelocity.
It should be attackPeak>1 because in the following phase
we want to approach 1 from above.
Say the curve would approach the limit value L
if it would continue after the end of the attack phase,
the slope is determined by the halfLife with respect to this upper bound.
That is, attackHalfLife is the time in seconds where the attack curve
reaches or would reach L/2.
After Attack the Decay part starts at the same level
and decays to amplitudeOfVelocity.
The slope is again a halfLife,
that is, decayHalfLife is the time where the curve
drops from attackPeak*amplitudeOfVelocity to (attackPeak+1)/2*amplitudeOfVelocity.
This phase lasts as long as the key is pressed.
If the key is released the curve decays with half life releaseHalfLife.
-}
{-
1 - 2^(-attackTime/attackHalfLife) = peak
-}
adsr ::
IO (Real -> Real -> Real ->
Real -> Real ->
Real -> Ev.LazyTime -> SigSt.T Vector)
adsr =
liftA3
(\attack decay release
attackTime attackPeak attackHalfLife
decayHalfLife releaseHalfLife vel dur ->
let amp = amplitudeFromVelocity vel
(attackDur, decayDur) =
CutG.splitAt (round (attackTime*vectorRate)) dur
in SigStL.continuePacked
(attack (chunkSizesFromLazyTime attackDur)
(attackHalfLife,
attackPeak * amp / (1 - 2^?(-attackTime/attackHalfLife)))
`SigSt.append`
decay (chunkSizesFromLazyTime decayDur)
(decayHalfLife,
((attackPeak-1)*amp, amp)))
(\x -> release vectorChunkSize (releaseHalfLife,x)))
(SigP.runChunkyPattern $
let halfLife = arr fst
amplitude = arr snd
in SigP.zipWithSimple A.sub
(SigPS.constant amplitude)
(SigPS.exponential2 (halfLife*sampleRate) amplitude))
(SigP.runChunkyPattern $
let halfLife = arr fst
amplitude = arr (fst.snd)
saturation = arr (snd.snd)
in SigP.mix (SigPS.constant saturation) $
SigPS.exponential2 (halfLife*sampleRate) amplitude)
(SigP.runChunky $
let release = arr fst
amplitude = arr snd
in (CausalP.take (round ^<< (release*5*vectorRate)) $*
SigPS.exponential2 (release*sampleRate) amplitude))
brass ::
IO (Real -> Real ->
Real -> Real -> Real -> Real ->
PC.T Real ->
PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
brass =
liftA2
(\osc env attTime attPeak attHL dec rel emph det dist fm vel freq dur ->
osc
((det, dist), (fm,freq),
env attTime emph attHL dec rel vel dur)
(env attTime attPeak attHL dec rel vel dur))
(let det = arr (fst.fst3)
dist = arr (snd.fst3)
fm = arr snd3
emph = arr thd3
mix x y = CausalP.mix <<< x&&&y
osci ::
Param.T p Real ->
CausalP.T p
(LLVM.Value Vector,
{- wave shrink/replication factor -}
(LLVM.Value Vector, LLVM.Value Vector)
{- detune, frequency modulation -})
(LLVM.Value Vector)
osci d =
CausalPS.shapeModOsci WaveL.rationalApproxSine1
<<<
second
(CausalP.feedFst (SigPS.constant $# (zero::Real))
<<<
CausalP.envelope
<<<
first (CausalPS.raise 1 <<< CausalPS.amplify d))
in CausalP.runStorableChunky $
(CausalP.envelopeStereo $>
(CausalPS.amplifyStereo 0.25
<<<
CausalP.zipWithSimple Sample.zipStereo
<<<
((osci 1.0 `mix` osci (-0.4)) `mix`
(osci 0.5 `mix` osci (-0.7))) &&&
((osci 0.4 `mix` osci (-1.0)) `mix`
(osci 0.7 `mix` osci (-0.5)))
<<<
CausalP.feedFst (piecewiseConstantVector dist)
<<<
CausalP.feedSnd (frequencyFromBendModulation 5 fm)
<<<
(CausalP.envelope $< piecewiseConstantVector det)
$*
SigP.fromStorableVectorLazy emph)))
adsr
data SamplePositions =
SamplePositions {
sampleStart, sampleLength,
sampleLoopStart, sampleLoopLength :: Int
}
data SampledSound =
SampledSound {
sampleData :: SigSt.T Real,
samplePositions :: SamplePositions,
samplePeriod :: Real
}
sampledSound ::
IO (SampledSound ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
sampledSound =
liftA2
(\osc freqMod smp fm vel freq dur ->
{-
We split the frequency modulation signal
in order to get a smooth frequency modulation curve.
Without (periodic) frequency modulation
we could just split the piecewise constant control curve @fm@.
-}
let fmSig =
freqMod
(chunkSizesFromLazyTime (PC.duration fm))
(fm, freq*samplePeriod smp) :: SigSt.T Vector
pos = samplePositions smp
amp = 2 * amplitudeFromVelocity vel
(attack,sustain) =
mapPair
(SigSt.drop (sampleStart pos),
SigSt.take (sampleLoopLength pos)) $
SigSt.splitAt (sampleLoopStart pos) $
sampleData smp
release =
SigSt.drop (sampleLoopStart pos + sampleLoopLength pos) $
SigSt.take (sampleStart pos + sampleLength pos) $
sampleData smp
in (\cont -> osc cont
(amp,
attack `SigSt.append`
SVL.cycle (SigSt.take (sampleLoopLength pos) sustain),
chunkSizesFromLazyTime dur)
fmSig)
(osc (const SigSt.empty)
(amp, release, NonNegChunky.fromChunks (repeat 1000))))
(CausalP.runStorableChunkyCont
(let amp = arr fst3
smp = arr snd3
dur = arr thd3
in CausalPS.amplifyStereo amp
<<<
CausalP.stereoFromMono
(CausalPS.pack
(CausalP.frequencyModulationLinear
(SigP.fromStorableVectorLazy smp)))
<<<
CausalP.zipWithSimple Sample.zipStereo
<<<
CausalPS.amplify 0.999 &&&
CausalPS.amplify 1.001
<<<
arr fst
<<<
CausalP.feedSnd (SigP.lazySize dur)))
(SigP.runChunkyPattern
(frequencyFromBendModulation 3 (arr id)))
sampledSoundLeaky ::
IO (SampledSound ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
sampledSoundLeaky =
liftA2
(\osc freqMod smp fm vel freq dur ->
{-
We split the frequency modulation signal
in order to get a smooth frequency modulation curve.
Without (periodic) frequency modulation
we could just split the piecewise constant control curve @fm@.
-}
let (sustainFM, releaseFM) =
SVP.splitAt (chunkSizesFromLazyTime dur) $
(freqMod
(chunkSizesFromLazyTime (PC.duration fm))
(fm, freq*samplePeriod smp) :: SigSt.T Vector)
pos = samplePositions smp
amp = 2 * amplitudeFromVelocity vel
(attack,sustain) =
mapPair
(SigSt.drop (sampleStart pos),
SigSt.take (sampleLoopLength pos)) $
SigSt.splitAt (sampleLoopStart pos) $
sampleData smp
release =
SigSt.drop (sampleLoopStart pos + sampleLoopLength pos) $
SigSt.take (sampleStart pos + sampleLength pos) $
sampleData smp
in osc
(amp,
attack `SigSt.append`
SVL.cycle (SigSt.take (sampleLoopLength pos) sustain))
sustainFM
`SigSt.append`
osc (amp,release) releaseFM)
(CausalP.runStorableChunky
(let smp = arr snd
amp = arr fst
in CausalPS.amplifyStereo amp
<<<
CausalP.stereoFromMono
(CausalPS.pack
(CausalP.frequencyModulationLinear
(SigP.fromStorableVectorLazy smp)))
<<<
CausalP.zipWithSimple Sample.zipStereo
<<<
CausalPS.amplify 0.999 &&&
CausalPS.amplify 1.001))
(SigP.runChunkyPattern
(frequencyFromBendModulation 3 (arr id)))
type SampleInfo = (FilePath, [SamplePositions], Real)
makeSampledSounds ::
SampleInfo ->
IO [-- PC.T Real ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector)]
makeSampledSounds (path, positions, period) = do
{-
sound <-
(SoxRead.withHandle1 (SVL.hGetContentsSync chunkSize) =<<
SoxRead.open SoxOption.none "speech/tomatensalat2.wav")
play (44100::Real) (sound::SVL.Vector Real)
-}
liftA2
(\makeSmp smp ->
map (\pos -> makeSmp (SampledSound smp pos period))
positions)
sampledSound
(SoxRead.withHandle1 (SVL.hGetContentsSync chunkSize) =<<
SoxRead.open SoxOption.none path)
tomatensalatPositions :: [SamplePositions]
tomatensalatPositions =
SamplePositions 0 29499 12501 15073 :
SamplePositions 29499 31672 38163 17312 :
SamplePositions 67379 28610 81811 10667 :
SamplePositions 95989 31253 106058 16111 :
SamplePositions 127242 38596 136689 11514 :
[]
tomatensalat :: SampleInfo
tomatensalat =
("speech/tomatensalat2.wav", tomatensalatPositions, 324.5)
halPositions :: [SamplePositions]
halPositions =
-- SamplePositions 2371 25957 7362 6321 :
SamplePositions 2371 25957 (2371+25957) 1 :
SamplePositions 40546 34460 63540 9546 :
SamplePositions 79128 32348 94367 14016 :
SamplePositions 112027 21227 125880 5500 :
SamplePositions 146057 23235 168941 352 :
[]
hal :: SampleInfo
hal =
("speech/haskell-in-leipzig2.wav", halPositions, 316)
graphentheoriePositions :: [SamplePositions]
graphentheoriePositions =
SamplePositions 0 29524 13267 14768 :
SamplePositions 29524 35333 47624 9968 :
SamplePositions 64857 31189 73818 16408 :
SamplePositions 96046 31312 106206 18504 :
SamplePositions 127358 32127 132469 16530 :
[]
graphentheorie :: SampleInfo
graphentheorie =
("speech/graphentheorie0.wav", graphentheoriePositions, 301.15)