module Synthesizer.LLVM.Server.Packed.Run where
import qualified Synthesizer.LLVM.Server.Packed.Instrument as Instr
import Synthesizer.LLVM.Server.Packed.Instrument
(Vector, vectorSize, vectorChunkSize, )
import Synthesizer.LLVM.Server.Common
import qualified Sound.ALSA.Sequencer.Event as Event
import qualified Synthesizer.EventList.ALSA.MIDI as Ev
import qualified Synthesizer.PiecewiseConstant.ALSA.MIDI as PC
import qualified Synthesizer.PiecewiseConstant.ALSA.MIDIControllerSet as PCS
import qualified Synthesizer.Generic.ALSA.MIDI as Gen
import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
import qualified Synthesizer.LLVM.Filter.Universal as UniFilterL
import qualified Synthesizer.LLVM.CausalParameterized.ProcessPacked as CausalPS
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 Synthesizer.LLVM.Parameterized.Signal (($#), )
import qualified LLVM.Core as LLVM
import qualified Synthesizer.Storable.Signal as SigSt
import qualified Synthesizer.Plain.Filter.Recursive as FiltR
import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter
import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
import qualified Sound.MIDI.Message.Channel as ChannelMsg
import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Data.EventList.Relative.MixedTime as EventListMT
import Synthesizer.ApplicativeUtility (liftA4, liftA5, liftA6, )
import Control.Arrow ((<<<), (^<<), (&&&), arr, first, )
import Control.Applicative (pure, liftA2, liftA3, (<*>), )
import Control.Monad.Trans.State (evalState, )
import qualified Algebra.Additive as Additive
import NumericPrelude.Numeric (zero, round, )
import Prelude hiding (Real, round, break, )
withMIDIEventsMono ::
(Double -> Double -> SigSt.T Real -> IO b) ->
(EventList.T Ev.StrictTime [Event.T] -> SigSt.T Vector) -> IO b
withMIDIEventsMono action proc =
let rate = sampleRate
per = periodTime
in Ev.withMIDIEvents per (rate / fromIntegral vectorSize) $
action per rate . SigStL.unpack . proc
withMIDIEventsStereo ::
(Double -> Double -> SigSt.T (Stereo.T Real) -> IO b) ->
(EventList.T Ev.StrictTime [Event.T] -> SigSt.T (Stereo.T Vector)) ->
IO b
withMIDIEventsStereo action proc =
let rate = sampleRate
per = periodTime
in do unpack <- SigStL.makeUnpackGeneric
Ev.withMIDIEvents per (rate / fromIntegral vectorSize) $
action per rate . unpack . proc
stair :: Real -> Real
stair i =
let n = fromIntegral (round i :: Int)
r = i n
in n + 0.01*r
frequencyModulation :: IO ()
frequencyModulation = do
osc <-
SigP.runChunky
((CausalPS.osciSimple WaveL.triangle $<# (LLVM.vector [zero] :: Vector))
$* Instr.frequencyFromBendModulation 10 (arr id &&& pure 880))
withMIDIEventsMono play $
osc vectorChunkSize .
evalState (PC.bendWheelPressure channel 2 0.04 (0.03::Real))
keyboard :: IO ()
keyboard = do
sound <- Instr.pingRelease $/ 0.4 $/ 0.1
amp <- CausalP.runStorableChunky (CausalPS.amplify $# 0.2)
arrange <- SigStL.makeArranger
withMIDIEventsMono play $
(amp () :: SigSt.T Vector -> SigSt.T Vector) .
evalState (Gen.sequence (arrange vectorChunkSize) channel sound)
keyboardStereo :: IO ()
keyboardStereo = do
sound <- Instr.pingStereoRelease $/ 0.4 $/ 0.1
amp <- CausalP.runStorableChunky (CausalP.amplifyStereo $# 0.2)
arrange <- SigStL.makeArranger
withMIDIEventsStereo play $
(amp () :: SigSt.T (Stereo.T Vector) -> SigSt.T (Stereo.T Vector)) .
evalState (Gen.sequence (arrange vectorChunkSize) channel sound)
keyboardFM :: IO ()
keyboardFM = do
str <- Instr.softStringFM
amp <- CausalP.runStorableChunky (CausalP.amplifyStereo $# 0.2)
arrange <- SigStL.makeArranger
withMIDIEventsStereo play $
(amp () :: SigSt.T (Stereo.T Vector) -> SigSt.T (Stereo.T Vector)) .
evalState
(do fm <- PC.bendWheelPressure channel 2 0.04 0.03
Gen.sequenceModulated (arrange vectorChunkSize) fm channel str)
keyboardFMMulti :: IO ()
keyboardFMMulti = do
str <- Instr.softStringFM
tin <- Instr.tineStereoFM $/ 0.4 $/ 0.1
amp <- CausalP.runStorableChunky (CausalP.amplifyStereo $# 0.2)
arrange <- SigStL.makeArranger
withMIDIEventsStereo play $
(amp () :: SigSt.T (Stereo.T Vector) -> SigSt.T (Stereo.T Vector)) .
evalState
(do fm <- PC.bendWheelPressure channel 2 0.04 0.03
Gen.sequenceModulatedMultiProgram
(arrange vectorChunkSize) fm channel
(VoiceMsg.toProgram 1)
[str, tin])
controllerAttack, controllerDetune, controllerTimbre0, controllerTimbre1,
controllerFilterCutoff, controllerFilterResonance,
controllerGlobal, controllerVolume :: VoiceMsg.Controller
[controllerAttack, controllerDetune, controllerTimbre0, controllerTimbre1,
controllerFilterCutoff, controllerFilterResonance,
controllerGlobal, controllerVolume] =
map VoiceMsg.toController [21, 22, 23, 24, 91, 93, 82, 83]
controllerFMDepth1, controllerFMDepth2, controllerFMDepth3, controllerFMDepth4,
controllerFMPartial1, controllerFMPartial2, controllerFMPartial3, controllerFMPartial4
:: VoiceMsg.Controller
[controllerFMDepth1, controllerFMDepth2, controllerFMDepth3, controllerFMDepth4,
controllerFMPartial1, controllerFMPartial2, controllerFMPartial3, controllerFMPartial4] =
map VoiceMsg.toController [25, 26, 27, 28, 70, 71, 72, 73]
keyboardDetuneFMCore ::
IO (ChannelMsg.Channel -> VoiceMsg.Program ->
Ev.Filter (SigSt.T (Stereo.T Vector)))
keyboardDetuneFMCore = do
str0 <- Instr.softStringDetuneFM
ssh0 <- Instr.softStringShapeFM
css0 <- Instr.cosineStringStereoFM
asw0 <- Instr.arcSawStringStereoFM
asn0 <- Instr.arcSineStringStereoFM
asq0 <- Instr.arcSquareStringStereoFM
atr0 <- Instr.arcTriangleStringStereoFM
wnd0 <- Instr.wind
wnp0 <- Instr.windPhaser
fms0 <- Instr.fmStringStereoFM
tin0 <- Instr.tineStereoFM
tnc0 <- Instr.tineControlledFM
fnd0 <- Instr.fenderFM
tnb0 <- Instr.tineBankFM
rfm0 <- Instr.resonantFMSynth
png0 <- Instr.pingStereoRelease
pngFM0 <- Instr.pingStereoReleaseFM
sqr0 <- Instr.squareStereoReleaseFM
bel0 <- Instr.bellStereoFM
ben0 <- Instr.bellNoiseStereoFM
flt0 <- Instr.filterSawStereoFM
brs0 <- Instr.brass
tmt0 <- Instr.makeSampledSounds Instr.tomatensalat
hal0 <- Instr.makeSampledSounds Instr.hal
grp0 <- Instr.makeSampledSounds Instr.graphentheorie
let evHead =
fmap (EventListMT.switchBodyL
(error "empty controller stream") const)
flt = evalState $
liftA5 (\rel -> flt0 (4*rel) rel)
(evHead $
PCS.controllerExponential controllerAttack (0.03,0.3) 0.1)
(PCS.controllerLinear controllerDetune (0,0.005) 0.001)
(evHead $
PCS.controllerExponential controllerTimbre0 (100,10000) 1000)
(evHead $
PCS.controllerExponential controllerTimbre1 (0.1,1) 0.1)
(PCS.bendWheelPressure 2 0.04 0.03)
png =
(\rel -> png0 (4*rel) rel) .
evalState
(evHead $
PCS.controllerExponential controllerAttack (0.03,0.3) 0.1)
pngFM = evalState $
liftA5 (\rel det phs shp -> pngFM0 (4*rel) rel det shp 2 phs)
(evHead $
PCS.controllerExponential controllerAttack (0.03,0.3) 0.1)
(PCS.controllerLinear controllerDetune (0,0.005) 0.001)
(evHead $
PCS.controllerLinear controllerTimbre0 (0,1) 1)
(PCS.controllerExponential controllerTimbre1 (0.3,0.001) 0.05)
(PCS.bendWheelPressure 2 0.04 0.03)
sqr = evalState $
liftA5 (\rel -> sqr0 (4*rel) rel)
(evHead $
PCS.controllerExponential controllerAttack (0.03,0.3) 0.1)
(PCS.controllerLinear controllerDetune (0,0.005) 0.001)
(PCS.controllerExponential controllerTimbre0 (0.3,0.001) 0.05)
(PCS.controllerLinear controllerTimbre1 (0,0.25) 0.25)
(PCS.bendWheelPressure 2 0.04 0.03)
tin = evalState $
liftA2 (\rel -> tin0 (4*rel) rel)
(evHead $
PCS.controllerExponential controllerAttack (0.03,0.3) 0.1)
(PCS.bendWheelPressure 2 0.04 0.03)
tnc = evalState $
liftA5 (\rel -> tnc0 (4*rel) rel)
(evHead $
PCS.controllerExponential controllerAttack (0.03,0.3) 0.1)
(PCS.controllerLinear controllerDetune (0,0.005) 0.001)
(fmap (fmap stair) $
PCS.controllerLinear controllerTimbre0 (0.5,6.5) 2)
(PCS.controllerLinear controllerTimbre1 (0,1.5) 1)
(PCS.bendWheelPressure 2 0.04 0.03)
fnd = evalState $
liftA6 (\rel -> fnd0 (4*rel) rel)
(evHead $
PCS.controllerExponential controllerAttack (0.03,0.3) 0.1)
(PCS.controllerLinear controllerDetune (0,0.005) 0.001)
(fmap (fmap stair) $
PCS.controllerLinear controllerTimbre0 (0.5,20.5) 14)
(PCS.controllerLinear controllerTimbre1 (0,1.5) 0.3)
(PCS.controllerLinear controllerFMDepth1 (0,1) 0.25)
(PCS.bendWheelPressure 2 0.04 0.03)
tnb = evalState $
pure (\rel -> tnb0 (4*rel) rel)
<*> (evHead $
PCS.controllerExponential controllerAttack (0.03,0.3) 0.1)
<*> (PCS.controllerLinear controllerDetune (0,0.005) 0.001)
<*> (PCS.controllerLinear controllerFMDepth1 (0,2) 0)
<*> (PCS.controllerLinear controllerFMDepth2 (0,2) 0)
<*> (PCS.controllerLinear controllerFMDepth3 (0,2) 0)
<*> (PCS.controllerLinear controllerFMDepth4 (0,2) 0)
<*> (PCS.controllerLinear controllerFMPartial1 (0,1) 1)
<*> (PCS.controllerLinear controllerFMPartial2 (0,1) 0)
<*> (PCS.controllerLinear controllerFMPartial3 (0,1) 0)
<*> (PCS.controllerLinear controllerFMPartial4 (0,1) 0)
<*> (PCS.bendWheelPressure 2 0.04 0.03)
rfm = evalState $
liftA6 (\rel -> rfm0 (4*rel) rel)
(evHead $
PCS.controllerExponential controllerAttack (0.03,0.3) 0.1)
(PCS.controllerLinear controllerDetune (0,0.005) 0.001)
(PCS.controllerExponential controllerTimbre1 (1,100) 30)
(PCS.controllerLinear controllerTimbre0 (1,15) 3)
(PCS.controllerExponential controllerFMDepth1 (0.005,0.5) 0.1)
(PCS.bendWheelPressure 2 0.04 0.03)
bel = evalState $
liftA3 (\rel -> bel0 (2*rel) rel)
(evHead $
PCS.controllerExponential controllerAttack (0.03,1.0) 0.3)
(PCS.controllerLinear controllerDetune (0,0.005) 0.001)
(PCS.bendWheelPressure 2 0.05 0.02)
ben = evalState $
liftA4 (\rel -> ben0 (2*rel) rel)
(evHead $
PCS.controllerExponential controllerAttack (0.03,1.0) 0.3)
(PCS.controllerLinear controllerTimbre0 (0,1) 0.3)
(PCS.controllerExponential controllerTimbre1 (1,1000) 100)
(PCS.bendWheelPressure 2 0.05 0.02)
str = evalState $
liftA3 str0
(evHead $
PCS.controllerExponential controllerAttack (0.02,2) 0.5)
(PCS.controllerLinear controllerDetune (0,0.01) 0.005)
(PCS.bendWheelPressure 2 0.04 0.03)
ssh = evalState $
liftA4 ssh0
(evHead $
PCS.controllerExponential controllerAttack (0.02,2) 0.5)
(PCS.controllerLinear controllerDetune (0,0.01) 0.005)
(PCS.controllerExponential controllerTimbre0 (0.3,0.001) 0.05)
(PCS.bendWheelPressure 2 0.04 0.03)
makeArc gen = evalState $
liftA4 gen
(evHead $
PCS.controllerExponential controllerAttack (0.02,2) 0.5)
(PCS.controllerLinear controllerDetune (0,0.01) 0.005)
(PCS.controllerLinear controllerTimbre0 (0.5,9.5) 1.5)
(PCS.bendWheelPressure 2 0.04 0.03)
css = makeArc css0
asw = makeArc asw0
asn = makeArc asn0
asq = makeArc asq0
atr = makeArc atr0
fms = evalState $
liftA5 fms0
(evHead $
PCS.controllerExponential controllerAttack (0.02,2) 0.5)
(PCS.controllerLinear controllerDetune (0,0.01) 0.005)
(PCS.controllerLinear controllerTimbre0 (0,0.5) 0.2)
(PCS.controllerExponential controllerTimbre1 (0.001,10) 0.1)
(PCS.bendWheelPressure 2 0.04 0.03)
wnd = evalState $
liftA3 wnd0
(evHead $
PCS.controllerExponential controllerAttack (0.02,2) 0.5)
(PCS.controllerExponential controllerTimbre1 (1,1000) 100)
(PCS.bendWheelPressure 12 0.8 0)
wnp = evalState $
liftA5 wnp0
(evHead $
PCS.controllerExponential controllerAttack (0.02,2) 0.5)
(PCS.controllerLinear controllerTimbre0 (0,1) 0.5)
(PCS.controllerExponential controllerDetune (50,5000) 500)
(PCS.controllerExponential controllerTimbre1 (1,1000) 100)
(PCS.bendWheelPressure 12 0.8 0)
brs = evalState $
liftA5
(\rel det t0 peak -> brs0 (rel/2) 1.5 (rel/2) rel rel peak det t0)
(evHead $
PCS.controllerExponential controllerAttack (0.01,0.1) 0.01)
(PCS.controllerLinear controllerDetune (0,0.01) 0.005)
(PCS.controllerExponential controllerTimbre0 (0.3,0.001) 0.05)
(evHead $
PCS.controllerLinear controllerTimbre1 (1,5) 3)
(PCS.bendWheelPressure 2 0.04 0.03)
freqMod =
evalState
(PCS.bendWheelPressure 2 0.04 0.03)
arrange <- SigStL.makeArranger
amp <-
CausalP.runStorableChunky
(CausalP.envelopeStereo $<
Instr.piecewiseConstantVector (arr id))
return
(\chan pgm -> do
volume <-
PC.controllerExponential chan
controllerVolume
(0.001, 1) 0.2
ctrls <- PCS.fromChannel chan
fmap (amp volume) $
Gen.sequenceModulatedMultiProgram
(arrange vectorChunkSize) ctrls chan pgm
([tnc, fnd, pngFM, flt, bel, ben, sqr, brs,
ssh, fms, css, asn, atr, asq, asw, wnp] ++
map (.freqMod) tmt0 ++
map (.freqMod) hal0 ++
map (.freqMod) grp0 ++
[str, wnd, png, rfm, tin, tnb]))
keyboardDetuneFM :: IO ()
keyboardDetuneFM = do
proc <- keyboardDetuneFMCore
withMIDIEventsStereo play $
evalState (proc channel (VoiceMsg.toProgram 0))
keyboardFilter :: IO ()
keyboardFilter = do
proc <- keyboardDetuneFMCore
mix <- CausalP.runStorableChunky
(CausalP.mixStereo <<< first (CausalPS.amplifyStereo 0.5)
$< SigP.fromStorableVectorLazy (arr id))
lowpass0 <-
CausalP.runStorableChunky $
CausalPS.pack
(CausalP.stereoFromMonoControlled
(UniFilter.lowpass ^<< UniFilterL.causalP) $<
(SigP.interpolateConstant $# (fromIntegral vectorSize :: Real))
(piecewiseConstant (arr id)))
let lowpass ::
PC.T Real -> PC.T Real ->
SigSt.T (Stereo.T Vector) -> SigSt.T (Stereo.T Vector)
lowpass resons freqs =
lowpass0 (fmap UniFilter.parameter
(PC.zipWith FiltR.Pole resons (fmap (/sampleRate) freqs)))
withMIDIEventsStereo (playAndRecord "/gentoo/server-llvm.f32") $
evalState
(do
let altChannel = (ChannelMsg.toChannel 1)
freq <-
PC.controllerExponential altChannel
controllerFilterCutoff
(100, 5000) 5000
resonance <-
PC.controllerExponential altChannel
controllerFilterResonance
(1, 100) 1
filterMusic <- proc altChannel (VoiceMsg.toProgram 8)
pureMusic <- proc channel (VoiceMsg.toProgram 0)
return
(pureMusic `mix`
lowpass resonance freq filterMusic))