module Synthesizer.LLVM.Server.Packed.Test where
import qualified Synthesizer.LLVM.Server.Packed.Instrument as Instr
import Synthesizer.LLVM.Server.Packed.Instrument
(Vector, vectorChunkSize,
sampleStart, sampleLength,
sampleLoopStart, sampleLoopLength,
samplePositions, sampleData, samplePeriod, )
import Synthesizer.LLVM.Server.Common
import qualified Sound.ALSA.Sequencer.Event as Event
import qualified Synthesizer.PiecewiseConstant.ALSA.MIDI as PC
import qualified Synthesizer.Generic.ALSA.MIDI as Gen
import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
import Synthesizer.Storable.ALSA.MIDI (Instrument, chunkSizesFromLazyTime, )
import qualified Synthesizer.LLVM.ALSA.MIDI as MIDIL
import qualified Synthesizer.LLVM.CausalParameterized.ProcessPacked as CausalPS
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 Synthesizer.LLVM.CausalParameterized.Process (($*), )
import qualified LLVM.Core as LLVM
import qualified Synthesizer.Storable.Cut as CutSt
import qualified Synthesizer.Storable.Signal as SigSt
import qualified Data.StorableVector.Lazy.Pattern as SVP
import qualified Data.StorableVector.Lazy as SVL
import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Data.EventList.Relative.BodyTime as EventListBT
import Control.Arrow ((<<<), (&&&), arr, )
import Control.Applicative (pure, liftA, liftA2, )
import Control.Monad.Trans.State (evalState, )
import Data.Tuple.HT (mapPair, )
import qualified Numeric.NonNegative.Wrapper as NonNegW
import qualified Numeric.NonNegative.Chunky as NonNegChunky
import Prelude hiding (Real, round, break, )
sequencePlain :: IO ()
sequencePlain =
SVL.writeFile "test.f32" $
evalState (Gen.sequence (CutSt.arrange chunkSize) channel (error "no sound" :: Instrument Real Real)) $
let evs = EventList.cons 10 [] evs
in evs
sequenceLLVM :: IO ()
sequenceLLVM = do
arrange <- SigStL.makeArranger
SVL.writeFile "test.f32" $
evalState (Gen.sequence (arrange vectorChunkSize) channel (error "no sound" :: Instrument Real Vector)) $
let evs = EventList.cons 10 [] evs
in evs
sequencePitchBendCycle :: IO ()
sequencePitchBendCycle = do
arrange <- SigStL.makeArranger
SVL.writeFile "test.f32" $
evalState
(let
fm = EventListBT.cons 1 10 fm
in Gen.sequenceModulated (arrange vectorChunkSize) fm channel
(error "no sound" ::
PC.T Real -> Instrument Real Vector)) $
let evs = EventList.cons 10 [] evs
in evs
sequencePitchBendSimple :: IO ()
sequencePitchBendSimple = do
arrange <- SigStL.makeArranger
SVL.writeFile "test.f32" $
evalState
(let fm y = EventListBT.cons y 10 (fm (2y))
in Gen.sequenceModulated (arrange vectorChunkSize) (fm 1) channel
(error "no sound" ::
PC.T Real -> Instrument Real Vector)) $
let evs = EventList.cons 10 [] evs
in evs
sequencePitchBend :: IO ()
sequencePitchBend = do
arrange <- SigStL.makeArranger
SVL.writeFile "test.f32" $
evalState
(do fm <- PC.pitchBend channel 2 0.01
Gen.sequenceModulated (arrange vectorChunkSize) fm channel
(error "no sound" ::
PC.T Real -> Instrument Real Vector)) $
let evs = EventList.cons 10 [] evs
in evs
sequenceModulated :: IO ()
sequenceModulated = do
arrange <- SigStL.makeArranger
SVL.writeFile "test.f32" $
evalState
(do fm <- PC.bendWheelPressure channel 2 0.04 0.03
Gen.sequenceModulated (arrange vectorChunkSize) fm channel
(error "no sound" ::
PC.T (MIDIL.BendModulation Real) ->
Instrument Real Vector)) $
let evs = EventList.cons 10 [] evs
in evs
sequenceModulatedLong :: IO ()
sequenceModulatedLong = do
arrange <- SigStL.makeArranger
sound <- Instr.softString
SVL.writeFile "test.f32" $
evalState
(Gen.sequence (arrange vectorChunkSize) channel sound) $
let evs t = EventList.cons t [] (evs (20t))
in EventList.cons 10 [makeNote Event.NoteOn 60] $
EventList.cons 10 [makeNote Event.NoteOn 64] $
evs 10
sequenceModulatedLongFM :: IO ()
sequenceModulatedLongFM = do
arrange <- SigStL.makeArranger
sound <- Instr.softStringFM
SVL.writeFile "test.f32" $
evalState
(do fm <- PC.bendWheelPressure channel 2 0.04 0.03
Gen.sequenceModulated (arrange vectorChunkSize) fm channel sound) $
let evs t = EventList.cons t [] (evs (20t))
in EventList.cons 10 [makeNote Event.NoteOn 60] $
EventList.cons 10 [makeNote Event.NoteOn 64] $
evs 10
sequenceModulatedRepeat :: IO ()
sequenceModulatedRepeat = do
arrange <- SigStL.makeArranger
sound <- Instr.softStringFM
SVL.writeFile "test.f32" $
evalState
(do fm <- PC.bendWheelPressure channel 2 0.04 0.03
Gen.sequenceModulated (arrange vectorChunkSize) fm channel sound) $
let evs t =
EventList.cons t [makeNote Event.NoteOn 60] $
EventList.cons t [makeNote Event.NoteOff 60] $
evs (20t)
in evs 10
sequencePress :: IO ()
sequencePress = do
arrange <- SigStL.makeArranger
sound <- Instr.pingReleaseEnvelope $/ 1
SVL.writeFile "test.f32" $
evalState
(do Gen.sequence (arrange vectorChunkSize) channel sound) $
let evs t =
EventList.cons t [makeNote Event.NoteOn 60] $
EventList.cons t [makeNote Event.NoteOff 60] $
evs (20t)
in evs 10
sampledSoundTest0 ::
IO (Instr.SampledSound ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
sampledSoundTest0 =
liftA
(\osc smp _fm _vel _freq _dur ->
osc chunkSize (sampleData smp))
(SigP.runChunky
(let smp = arr id
in fmap (\x -> Stereo.cons x x) $
SigPS.pack $
SigP.fromStorableVectorLazy smp))
sampledSoundTest1 ::
IO (Instr.SampledSound ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
sampledSoundTest1 =
liftA
(\osc smp _fm _vel _freq _dur ->
osc chunkSize (sampleData smp))
(SigP.runChunky
(let smp = arr id
in CausalP.stereoFromMono
(CausalPS.pack
(CausalP.frequencyModulationLinear
(SigP.fromStorableVectorLazy smp)))
$* SigP.zipWithSimple Sample.zipStereo
(SigPS.constant 0.999)
(SigPS.constant 1.001)))
sampledSoundTest2 ::
IO (Instr.SampledSound ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
sampledSoundTest2 =
liftA
(\osc smp fm _vel freq dur ->
let pos = samplePositions smp
body =
SigSt.take (sampleLength pos) $
SigSt.drop (sampleStart pos) $
sampleData smp
in SVP.take (chunkSizesFromLazyTime dur) $
osc chunkSize (body, (fm, freq * samplePeriod smp)))
(SigP.runChunky
(let smp = arr fst
fm = arr snd
in (CausalP.stereoFromMono
(CausalPS.pack
(CausalP.frequencyModulationLinear
(SigP.fromStorableVectorLazy smp)))
<<<
CausalP.zipWithSimple Sample.zipStereo
<<<
CausalPS.amplify 0.999 &&&
CausalPS.amplify 1.001)
$* Instr.frequencyFromBendModulation 3 fm))
sampledSoundTest3SpaceLeak ::
IO (Instr.SampledSound ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
sampledSoundTest3SpaceLeak =
liftA
(\osc smp _fm vel freq dur ->
let (sustainFM, releaseFM) =
SVP.splitAt (chunkSizesFromLazyTime dur) $
(SigSt.repeat chunkSize
(LLVM.vector [freq*samplePeriod smp/sampleRate])
:: 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))
sampledSoundTest4NoSpaceLeak ::
IO (Instr.SampledSound ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
sampledSoundTest4NoSpaceLeak =
liftA
(\freqMod smp fm _vel freq dur ->
let (sustainFM, releaseFM) =
SVP.splitAt (chunkSizesFromLazyTime dur) $
(freqMod
(chunkSizesFromLazyTime (PC.duration fm))
(fm, freq*samplePeriod smp) :: SigSt.T Vector)
in SigSt.map
(\x -> Stereo.cons x x)
(sustainFM `SigSt.append` releaseFM))
(SigP.runChunkyPattern
(Instr.frequencyFromBendModulation 3 (arr id)))
sampledSoundTest5LargeSpaceLeak ::
IO (Instr.SampledSound ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
sampledSoundTest5LargeSpaceLeak =
liftA2
(\osc freqMod smp fm vel freq dur ->
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
(arr (\x -> Stereo.cons x x)))
(SigP.runChunkyPattern
(Instr.frequencyFromBendModulation 3 (arr id)))
sampledSoundSmallSpaceLeak4 ::
IO (Instr.SampledSound ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
sampledSoundSmallSpaceLeak4 =
liftA
(\osc smp _fm _vel freq dur ->
let (sustainFM, releaseFM) =
SVP.splitAt (chunkSizesFromLazyTime dur) $
(SigSt.repeat chunkSize
(LLVM.vector [freq*samplePeriod smp/sampleRate])
:: SigSt.T Vector)
in osc () sustainFM
`SigSt.append`
SigSt.map (\x -> Stereo.cons x x) releaseFM)
(CausalP.runStorableChunky
(arr (\x -> Stereo.cons x x)))
sampledSoundSmallSpaceLeak4a ::
IO (Instr.SampledSound ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
sampledSoundSmallSpaceLeak4a =
liftA
(\osc smp _fm _vel freq dur ->
case SVP.splitAt (chunkSizesFromLazyTime dur) $
(SigSt.repeat chunkSize
(LLVM.vector [freq*samplePeriod smp/sampleRate])
:: SigSt.T Vector) of
(sustainFM, releaseFM) ->
osc () sustainFM
`SigSt.append`
SigSt.map (\x -> Stereo.cons x x) releaseFM)
(CausalP.runStorableChunky
(arr (\x -> Stereo.cons x x)))
sampledSoundNoSmallSpaceLeak3 ::
IO (Instr.SampledSound ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
sampledSoundNoSmallSpaceLeak3 =
pure
(\smp _fm _vel freq dur ->
let (sustainFM, releaseFM) =
SVP.splitAt (chunkSizesFromLazyTime dur) $
(SigSt.repeat chunkSize
(LLVM.vector [freq*samplePeriod smp/sampleRate])
:: SigSt.T Vector)
in SigSt.map (\x -> Stereo.cons x x) sustainFM
`SigSt.append`
SigSt.map (\x -> Stereo.cons x x) releaseFM)
amplifySVL :: SVL.Vector Vector -> SVL.Vector Vector
amplifySVL = SigSt.map (2*)
sampledSoundNoSmallSpaceLeak2 ::
IO (Instr.SampledSound ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
sampledSoundNoSmallSpaceLeak2 =
liftA
(\osc smp _fm _vel freq dur ->
let (sustainFM, releaseFM) =
SVP.splitAt (chunkSizesFromLazyTime dur) $
(SigSt.repeat chunkSize
(LLVM.vector [freq*samplePeriod smp/sampleRate])
:: SigSt.T Vector)
in osc ()
(amplifySVL sustainFM
`SigSt.append`
amplifySVL releaseFM))
(CausalP.runStorableChunky
(arr (\x -> Stereo.cons x x)))
sampledSoundSmallSpaceLeak1 ::
IO (Instr.SampledSound ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
sampledSoundSmallSpaceLeak1 =
liftA
(\osc smp _fm _vel freq dur ->
let (sustainFM, releaseFM) =
SVP.splitAt (chunkSizesFromLazyTime dur) $
(SigSt.repeat chunkSize
(LLVM.vector [freq*samplePeriod smp/sampleRate])
:: SigSt.T Vector)
in osc () sustainFM
`SigSt.append`
osc () releaseFM)
(CausalP.runStorableChunky
(arr (\x -> Stereo.cons x x)))
sampledSoundSmallSpaceLeak0 ::
IO (Instr.SampledSound ->
PC.T (PC.BendModulation Real) ->
Instrument Real (Stereo.T Vector))
sampledSoundSmallSpaceLeak0 =
liftA
(\osc smp _fm vel freq dur ->
let (sustainFM, releaseFM) =
SVP.splitAt (chunkSizesFromLazyTime dur) $
(SigSt.repeat chunkSize
(LLVM.vector [freq*samplePeriod smp/sampleRate])
:: 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
(arr (\x -> Stereo.cons x x)))
sequenceSample :: IO ()
sequenceSample = do
arrange <- SigStL.makeArranger
sampler <- sampledSoundTest2
let sound =
sampler (Instr.SampledSound (SigSt.replicate chunkSize 100000 0)
(Instr.SamplePositions 0 100000 50000 50000)
100)
SVL.writeFile "test.f32" $
evalState
(do fm <- PC.bendWheelPressure channel 2 0.04 0.03
Gen.sequenceModulated (arrange vectorChunkSize) fm channel sound) $
let evs t = EventList.cons t [] (evs (20t))
in EventList.cons 10 [makeNote Event.NoteOn 60] $
evs 10
sequenceSample1 :: IO ()
sequenceSample1 = do
sampler <- sampledSoundSmallSpaceLeak4a
let sound =
sampler (Instr.SampledSound (SigSt.replicate chunkSize 100000 0)
(Instr.SamplePositions 0 100000 50000 50000)
100)
SVL.writeFile "test.f32" $
sound
(let evs = EventListBT.cons (MIDIL.BendModulation 0.01 0.001) 1 evs
in evs)
0.01 1
(NonNegChunky.fromChunks $ repeat $ NonNegW.fromNumber 10)
sequenceSample2 :: IO ()
sequenceSample2 = do
arrange <- SigStL.makeArranger
sampler <- sampledSoundTest2
let sound =
sampler (Instr.SampledSound (SigSt.replicate chunkSize 100000 0)
(Instr.SamplePositions 0 100000 50000 50000)
100)
SVL.writeFile "test.f32" $
evalState
(do bend <- PC.pitchBend channel 2 0.01
let fm = fmap (\t -> MIDIL.BendModulation t t) bend
Gen.sequenceModulated (arrange vectorChunkSize) fm channel sound) $
let evs t = EventList.cons t [] (evs (20t))
in EventList.cons 10 [makeNote Event.NoteOn 60] $
evs 10
sequenceSample3 :: IO ()
sequenceSample3 = do
arrange <- SigStL.makeArranger
sampler <- sampledSoundTest2
let sound =
sampler (Instr.SampledSound (SigSt.replicate chunkSize 100000 0)
(Instr.SamplePositions 0 100000 50000 50000)
100)
SVL.writeFile "test.f32" $
evalState
(let evs =
EventListBT.cons (MIDIL.BendModulation 0.01 0.001) 10 evs
in Gen.sequence (arrange vectorChunkSize) channel (sound evs)) $
let evs = EventList.cons 10 [] evs
in EventList.cons 10 [makeNote Event.NoteOn 60] evs
sequenceSample4 :: IO ()
sequenceSample4 = do
arrange <- SigStL.makeArranger
sampler <- Instr.sampledSound
let sound =
sampler (Instr.SampledSound (SigSt.replicate chunkSize 100000 0)
(Instr.SamplePositions 0 100000 50000 50000)
100)
SVL.writeFile "test.f32" $
evalState
(let evs =
EventListBT.cons (MIDIL.BendModulation 0.01 0.001) 10 evs
in Gen.sequenceCore
(arrange vectorChunkSize) channel Gen.errorNoProgram
(Gen.Modulator () return
(return . Gen.renderInstrumentIgnoreProgram (sound evs)))) $
let evs = EventList.cons 10 [] evs
in EventList.cons 10 [makeNote Event.NoteOn 60] evs
sequenceFM1 :: IO ()
sequenceFM1 = do
arrange <- SigStL.makeArranger
sound <- Instr.softStringFM $/
let evs =
EventListBT.cons (MIDIL.BendModulation 0.01 0.001) 10 evs
in evs
SVL.writeFile "test.f32" $
evalState
(Gen.sequenceCore
(arrange vectorChunkSize) channel Gen.errorNoProgram
(Gen.Modulator () return
(return . Gen.renderInstrumentIgnoreProgram sound))) $
let evs = EventList.cons 10 [] evs
in EventList.cons 10 [makeNote Event.NoteOn 60] evs
adsr :: IO ()
adsr = do
env <- Instr.adsr
SVL.writeFile "adsr.f32" $
env 0.2 2 0.15 0.3 0.5 (0.5) 88200