module Synthesizer.LLVM.Server.Common (
Real, Param,
SampleRate(SampleRate),
Instrument,
frequency, time, noiseReference, number, control, signal, parameter,
frequencyConst, timeConst,
($/),
chopEvents,
piecewiseConstant,
transposeModulation,
amplitudeFromVelocity,
controllerAttack, controllerDetune, controllerTimbre0, controllerTimbre1,
controllerFilterCutoff, controllerFilterResonance,
controllerVolume,
) where
import qualified Sound.MIDI.Controller as Ctrl
import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
import qualified Synthesizer.MIDI.Storable as MidiSt
import qualified Synthesizer.PiecewiseConstant.Signal as PC
import qualified Synthesizer.LLVM.MIDI.BendModulation as BM
import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
import qualified Synthesizer.LLVM.Parameter as Param
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Class as Class
import qualified Synthesizer.Storable.Signal as SigSt
import qualified Data.EventList.Relative.TimeTime as EventListTT
import qualified Numeric.NonNegative.Class as NonNeg
import Foreign.Storable (Storable, )
import Control.Arrow (arr, (^<<), )
import Prelude hiding (Real, )
newtype SampleRate a = SampleRate a
deriving (Show)
instance Functor SampleRate where
fmap f (SampleRate sr) = SampleRate (f sr)
type Real = Float
type Param p = Param.T (SampleRate Real, p)
type Instrument a sig = SampleRate a -> MidiSt.Instrument a sig
frequency :: (p -> Real) -> Param p Real
frequency param =
arr (\(SampleRate sampleRate, p) -> param p / sampleRate)
time :: (p -> Real) -> Param p Real
time param =
arr (\(SampleRate sampleRate, p) -> param p * sampleRate)
noiseReference :: Real -> Param p Real
noiseReference freq =
arr (\(SampleRate sampleRate, _p) -> sampleRate/freq)
number :: (p -> Real) -> Param p Real
number param = arr (param . snd)
control :: (p -> PC.T Real) -> Param p (PC.T Real)
control param = arr (param . snd)
signal :: (p -> SigSt.T a) -> Param p (SigSt.T a)
signal param = arr (param . snd)
parameter :: (p -> a) -> Param p a
parameter param = arr (param . snd)
frequencyConst :: Real -> Param p Real
frequencyConst param =
arr (\(SampleRate sampleRate, _p) -> param / sampleRate)
timeConst :: Real -> Param p Real
timeConst param =
arr (\(SampleRate sampleRate, _p) -> param * sampleRate)
($/) :: (Functor f) => f (a -> b) -> a -> f b
f $/ x = fmap ($x) f
chopEvents ::
(NonNeg.C time, Num time) =>
time ->
EventListTT.T time body ->
[EventListTT.T time body]
chopEvents chunkSize =
let go evs =
let (chunk,rest) = EventListTT.splitAtTime chunkSize evs
in if EventListTT.duration chunk == 0
then []
else chunk : go rest
in go
piecewiseConstant ::
(Storable a,
Class.MakeValueTuple a, Class.ValueTuple a ~ al,
Memory.C al) =>
Param.T p (PC.T a) -> SigP.T p al
piecewiseConstant pc =
SigP.piecewiseConstant
(PC.subdivideLongStrict ^<< pc)
transposeModulation ::
(Functor stream) =>
SampleRate Real ->
Real ->
stream (BM.T Real) ->
stream (BM.T Real)
transposeModulation (SampleRate sampleRate) freq =
fmap (BM.shift (freq/sampleRate))
amplitudeFromVelocity :: Real -> Real
amplitudeFromVelocity vel = 4**vel
controllerAttack, controllerDetune, controllerTimbre0, controllerTimbre1,
controllerFilterCutoff, controllerFilterResonance,
controllerVolume :: VoiceMsg.Controller
controllerAttack = Ctrl.attackTime
controllerDetune = Ctrl.chorusDepth
controllerTimbre0 = Ctrl.soundVariation
controllerTimbre1 = Ctrl.timbre
controllerFilterCutoff = Ctrl.effect4Depth
controllerFilterResonance = Ctrl.effect5Depth
controllerVolume = Ctrl.volume