module Synthesizer.LLVM.Server.Scalar.Instrument (
ping,
pingDur,
pingDurTake,
pingRelease,
pingStereoRelease,
tine,
tineStereo,
softString,
dummy,
) where
import Synthesizer.LLVM.Server.Common
import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
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.Wave as WaveL
import Synthesizer.LLVM.CausalParameterized.Process (($<), ($>), ($*), )
import qualified LLVM.Core as LLVM
import qualified Synthesizer.MIDI.EventList as Ev
import Synthesizer.MIDI.Storable (chunkSizesFromLazyTime, )
import qualified Synthesizer.Storable.Signal as SigSt
import qualified Data.StorableVector.Lazy.Pattern as SigStV
import Control.Arrow ((^<<), arr, )
import Control.Applicative (liftA, liftA2, )
import NumericPrelude.Numeric (zero, round, (+), )
import Prelude hiding (Real, round, break, (+), )
pingSig :: SigP.T (SampleRate Real, (Real, Real)) (LLVM.Value Real)
pingSig =
let vel = number fst
freq = frequency snd
in CausalP.envelope
$< SigP.exponential2 (timeConst 0.2)
(fmap amplitudeFromVelocity vel)
$* SigP.osciSimple WaveL.saw zero freq
ping :: IO (SigSt.ChunkSize -> SampleRate Real -> Real -> Real -> SigSt.T Real)
ping =
fmap (\f chunkSize sr vel freq -> f chunkSize (sr, (vel,freq))) $
SigP.runChunky pingSig
pingDur :: IO (Instrument Real Real)
pingDur =
fmap
(\sound sr vel freq dur ->
sound (chunkSizesFromLazyTime dur) (sr, (vel, freq))) $
SigP.runChunkyPattern pingSig
pingDurTake :: IO (SigSt.ChunkSize -> Instrument Real Real)
pingDurTake =
fmap (\sound chunkSize sr vel freq dur ->
SigStV.take (chunkSizesFromLazyTime dur) $
sound chunkSize sr vel freq) ping
dummy :: SigSt.ChunkSize -> Instrument Real Real
dummy chunkSize =
\ _sr vel freq dur ->
SigStV.take (chunkSizesFromLazyTime dur) $
SigSt.repeat chunkSize (vel + 1e-3*freq)
pingReleaseEnvelope ::
IO (Real -> Real -> SigSt.ChunkSize ->
SampleRate Real -> Real -> Ev.LazyTime -> SigSt.T Real)
pingReleaseEnvelope =
liftA2
(\pressed release decay rel chunkSize sr vel dur ->
SigStL.continue
(pressed (chunkSizesFromLazyTime dur) (sr, (decay,vel)))
(\x -> release chunkSize (sr, (rel,x))))
(SigP.runChunkyPattern $
let decay = time fst
velocity = number snd
in SigP.exponential2 decay
(amplitudeFromVelocity ^<< velocity))
(SigP.runChunky $
let release = time fst
amplitude = number snd
in (CausalP.take (round ^<< (release*3)) $*
SigP.exponential2 release amplitude))
pingRelease :: IO (Real -> Real -> SigSt.ChunkSize -> Instrument Real Real)
pingRelease =
liftA2
(\osc env dec rel chunkSize sr vel freq dur ->
osc (sr, freq) (env dec rel chunkSize sr vel dur))
(CausalP.runStorableChunky
(let freq = frequency id
in CausalP.envelope $>
SigP.osciSimple WaveL.saw zero freq))
pingReleaseEnvelope
pingStereoRelease :: IO (Real -> Real -> SigSt.ChunkSize -> Instrument Real (Stereo.T Real))
pingStereoRelease =
liftA2
(\osc env dec rel chunkSize sr vel freq dur ->
osc (sr, freq) (env dec rel chunkSize sr vel dur))
(CausalP.runStorableChunky
(let freq = frequency id
in CausalP.envelopeStereo $>
liftA2 Stereo.cons
(SigP.osciSimple WaveL.saw zero (0.999*freq))
(SigP.osciSimple WaveL.saw zero (1.001*freq))))
pingReleaseEnvelope
tine :: IO (Real -> Real -> SigSt.ChunkSize -> Instrument Real Real)
tine =
liftA2
(\osc env dec rel chunkSize sr vel freq dur ->
osc (sr, (vel,freq)) (env dec rel chunkSize sr 0 dur))
(CausalP.runStorableChunky
(let freq = frequency snd
vel = number fst
in CausalP.envelope $>
(CausalP.osciSimple WaveL.approxSine2
$> (SigP.constant freq)
$* (CausalP.envelope
$< SigP.exponential2 (timeConst 1) (vel+1)
$* SigP.osciSimple WaveL.approxSine2 zero (2*freq)))))
pingReleaseEnvelope
tineStereo :: IO (Real -> Real -> SigSt.ChunkSize -> Instrument Real (Stereo.T Real))
tineStereo =
liftA2
(\osc env dec rel chunkSize sr vel freq dur ->
osc (sr, (vel,freq)) (env dec rel chunkSize sr 0 dur))
(CausalP.runStorableChunky
(let freq = frequency snd
vel = number fst
chanOsci d =
CausalP.osciSimple WaveL.approxSine2
$> SigP.constant (freq*d)
in CausalP.envelopeStereo $>
(liftA2 Stereo.cons
(chanOsci 0.995) (chanOsci 1.005)
$* SigP.envelope
(SigP.exponential2 (timeConst 1) (vel+1))
(SigP.osciSimple WaveL.approxSine2 zero (2*freq)))))
pingReleaseEnvelope
softStringReleaseEnvelope ::
IO (Real -> SampleRate Real -> Real -> Ev.LazyTime -> SigSt.T Real)
softStringReleaseEnvelope =
liftA
(\env attackTime (SampleRate sampleRate) vel dur ->
let attackTimeInt =
round (attackTime * sampleRate)
(attack, sustain) =
SigSt.splitAt attackTimeInt $
env (chunkSizesFromLazyTime dur)
(fromIntegral attackTimeInt :: Real,
amplitudeFromVelocity vel)
release = SigSt.reverse attack
in attack `SigSt.append` sustain `SigSt.append` release)
(let amp = arr snd
attackTime = arr fst
in SigP.runChunkyPattern $
flip SigP.append (SigP.constant amp) $
SigP.amplify amp $
(SigP.parabolaFadeIn attackTime))
softString :: IO (Instrument Real (Stereo.T Real))
softString =
liftA2
(\osc env sr vel freq dur ->
osc (sr, freq) (env 1 sr vel dur))
(let freq = frequency id
osci d =
SigP.osciSimple WaveL.saw zero (d * freq)
in CausalP.runStorableChunky $
(CausalP.envelopeStereo $>
(liftA2 Stereo.cons
(osci 1.005 + osci 0.998)
(osci 1.002 + osci 0.995))))
softStringReleaseEnvelope