module Synthesizer.LLVM.Server.Packed.Test where import qualified Synthesizer.LLVM.Server.Packed.Instrument as Instr import qualified Synthesizer.LLVM.Server.Option as Option import qualified Synthesizer.LLVM.Server.SampledSound as Sample import Synthesizer.LLVM.Server.ALSA (makeNote, ) import Synthesizer.LLVM.Server.CommonPacked (Vector, vectorSize, ) import Synthesizer.LLVM.Server.Common hiding (Instrument, ) import qualified Sound.ALSA.Sequencer.Event as Event import qualified Synthesizer.MIDI.PiecewiseConstant as PC import qualified Synthesizer.MIDI.Generic as Gen import qualified Synthesizer.LLVM.Frame.Stereo as Stereo import qualified Synthesizer.LLVM.Frame.SerialVector as Serial import qualified Synthesizer.ALSA.Storable.Play as Play import Synthesizer.MIDI.Storable (Instrument, chunkSizesFromLazyTime, ) import qualified Synthesizer.LLVM.MIDI.BendModulation as BM 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 Synthesizer.LLVM.CausalParameterized.Process (($*), ) 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.StorableVector as SV 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 qualified Numeric.NonNegative.Class as NonNeg -} import qualified Numeric.NonNegative.Wrapper as NonNegW import qualified Numeric.NonNegative.Chunky as NonNegChunky import Algebra.IntegralDomain (divUp, ) {- import qualified Algebra.RealRing as RealRing import qualified Algebra.Additive as Additive -} -- import NumericPrelude.Numeric (zero, round, (^?), ) import Prelude hiding (Real, round, break, ) vectorChunkSize :: SVL.ChunkSize vectorChunkSize = case Play.defaultChunkSize of SVL.ChunkSize size -> SVL.ChunkSize (divUp size vectorSize) sampleRatePlain :: Num a => a sampleRatePlain = Option.defaultSampleRate sampleRate :: Option.SampleRate Real sampleRate = Option.SampleRate Option.defaultSampleRate emptyEvents :: time -> EventList.T time [Event.T] emptyEvents t = let evs = EventList.cons t [] evs in evs {- | try to reproduce a space leak -} sequencePlain :: IO () sequencePlain = SVL.writeFile "test.f32" $ -- print $ last $ SVL.chunks $ CutSt.arrange Option.defaultChunkSize $ evalState (Gen.sequence Option.defaultChannel (error "no sound" :: Instrument Real Real)) $ emptyEvents 10 sequenceLLVM :: IO () sequenceLLVM = do arrange <- SigStL.makeArranger SVL.writeFile "test.f32" $ -- print $ last $ SVL.chunks $ arrange vectorChunkSize $ evalState (Gen.sequence Option.defaultChannel (error "no sound" :: Instrument Real Vector)) $ emptyEvents 10 sequencePitchBendCycle :: IO () sequencePitchBendCycle = do arrange <- SigStL.makeArranger SVL.writeFile "test.f32" $ arrange vectorChunkSize $ evalState (let -- fm = error "undefined pitch bend" fm = EventListBT.cons 1 10 fm in Gen.sequenceModulated fm Option.defaultChannel (error "no sound" :: PC.T Real -> Instrument Real Vector)) $ emptyEvents 10 sequencePitchBendSimple :: IO () sequencePitchBendSimple = do arrange <- SigStL.makeArranger SVL.writeFile "test.f32" $ arrange vectorChunkSize $ evalState (let fm y = EventListBT.cons y 10 (fm (2-y)) in Gen.sequenceModulated (fm 1) Option.defaultChannel (error "no sound" :: PC.T Real -> Instrument Real Vector)) $ emptyEvents 10 sequencePitchBend :: IO () sequencePitchBend = do arrange <- SigStL.makeArranger SVL.writeFile "test.f32" $ arrange vectorChunkSize $ evalState (do fm <- PC.pitchBend Option.defaultChannel 2 0.01 Gen.sequenceModulated fm Option.defaultChannel (error "no sound" :: PC.T Real -> Instrument Real Vector)) $ emptyEvents 10 sequenceModulated :: IO () sequenceModulated = do arrange <- SigStL.makeArranger SVL.writeFile "test.f32" $ arrange vectorChunkSize $ evalState (do fm <- PC.bendWheelPressure Option.defaultChannel 2 0.04 0.03 Gen.sequenceModulated fm Option.defaultChannel (error "no sound" :: PC.T (BM.T Real) -> Instrument Real Vector)) $ emptyEvents 10 sequenceModulatedLong :: IO () sequenceModulatedLong = do arrange <- SigStL.makeArranger -- sound <- Instr.softStringReleaseEnvelope $/ sampleRate sound <- Instr.softString $/ sampleRate -- space leak -- sound <- Instr.pingReleaseEnvelope $/ 1 $/ sampleRate -- no space leak -- sound <- Instr.pingRelease $/ 1 $/ 1 $/ sampleRate -- no space leak SVL.writeFile "test.f32" $ arrange vectorChunkSize $ evalState (Gen.sequence Option.defaultChannel sound) $ let evs t = EventList.cons t [] (evs (20-t)) 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" $ arrange vectorChunkSize $ evalState (do fm <- PC.bendWheelPressure Option.defaultChannel 2 0.04 0.03 Gen.sequenceModulated fm Option.defaultChannel (\fmlocal -> sound fmlocal $ sampleRate)) $ let evs t = EventList.cons t [] (evs (20-t)) 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" $ arrange vectorChunkSize $ evalState (do fm <- PC.bendWheelPressure Option.defaultChannel 2 0.04 0.03 Gen.sequenceModulated fm Option.defaultChannel (\fmlocal -> sound fmlocal $ sampleRate)) $ let evs t = EventList.cons t [makeNote Event.NoteOn 60] $ EventList.cons t [makeNote Event.NoteOff 60] $ evs (20-t) in evs 10 sequencePress :: IO () sequencePress = do arrange <- SigStL.makeArranger -- sound <- Instr.softString $/ sampleRate -- sound <- Instr.softStringReleaseEnvelope $/ sampleRate sound <- Instr.pingReleaseEnvelope $/ 1 $/ 1 $/ vectorChunkSize $/ sampleRate SVL.writeFile "test.f32" $ arrange vectorChunkSize $ evalState (Gen.sequence Option.defaultChannel (\ _freq -> sound)) $ let evs t = EventList.cons t [makeNote Event.NoteOn 60] $ EventList.cons t [makeNote Event.NoteOff 60] $ evs (20-t) in evs 10 sampledSoundTest0 :: IO (Sample.T -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) sampledSoundTest0 = liftA (\osc smp _fm _vel _freq _dur -> osc Option.defaultChunkSize (Sample.body smp)) (SigP.runChunky (let smp = arr id in fmap (\x -> Stereo.cons x x) $ SigPS.pack $ SigP.fromStorableVectorLazy smp)) sampledSoundTest1 :: IO (Sample.T -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) sampledSoundTest1 = liftA (\osc smp _fm _vel _freq _dur -> osc Option.defaultChunkSize (Sample.body smp)) (SigP.runChunky (let smp = arr id in CausalP.stereoFromMono (CausalPS.pack (CausalP.frequencyModulationLinear (SigP.fromStorableVectorLazy smp))) $* liftA2 Stereo.cons (SigPS.constant 0.999) (SigPS.constant 1.001))) -- $* (SigPS.constant $# Stereo.cons 0.999 1.001))) sampledSoundTest2 :: IO (Sample.T -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) sampledSoundTest2 = liftA (\osc smp fm _vel freq dur -> let pos = Sample.positions smp body = SigSt.take (Sample.length pos) $ SigSt.drop (Sample.start pos) $ Sample.body smp in SVP.take (chunkSizesFromLazyTime dur) $ osc Option.defaultChunkSize (sampleRate, (body, (fm, freq * Sample.period smp)))) (SigP.runChunky (let smp = signal fst fm = Instr.modulation snd in (CausalP.stereoFromMono (CausalPS.pack (CausalP.frequencyModulationLinear (SigP.fromStorableVectorLazy smp))) <<< liftA2 Stereo.cons (CausalPS.amplify 0.999) (CausalPS.amplify 1.001)) $* Instr.frequencyFromBendModulation (frequencyConst 3) fm)) sampledSoundTest3SpaceLeak :: IO (Sample.T -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) sampledSoundTest3SpaceLeak = liftA (\osc 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) $ (SigSt.repeat Option.defaultChunkSize (Serial.fromList [freq*Sample.period smp/sampleRatePlain]) :: SigSt.T Vector) pos = Sample.positions smp amp = 2 * amplitudeFromVelocity vel (attack, sustain, release) = Sample.parts smp in osc (amp, attack `SigSt.append` SVL.cycle (SigSt.take (Sample.loopLength 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))) <<< liftA2 Stereo.cons (CausalPS.amplify 0.999) (CausalPS.amplify 1.001))) sampledSoundTest4NoSpaceLeak :: IO (Sample.T -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) sampledSoundTest4NoSpaceLeak = liftA (\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)) (sampleRate, (fm, freq*Sample.period smp)) :: SigSt.T Vector) in SigSt.map (\x -> Stereo.cons x x) (sustainFM `SigSt.append` releaseFM)) (SigP.runChunkyPattern (Instr.frequencyFromBendModulation (frequencyConst 3) (Instr.modulation id))) sampledSoundTest5LargeSpaceLeak :: IO (Sample.T -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) sampledSoundTest5LargeSpaceLeak = 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)) (sampleRate, (fm, freq*Sample.period smp)) :: SigSt.T Vector) pos = Sample.positions smp amp = 2 * amplitudeFromVelocity vel (attack, sustain, release) = Sample.parts smp in osc (amp, attack `SigSt.append` SVL.cycle (SigSt.take (Sample.loopLength pos) sustain)) sustainFM `SigSt.append` osc (amp,release) releaseFM) (CausalP.runStorableChunky (arr (\x -> Stereo.cons x x))) (SigP.runChunkyPattern (Instr.frequencyFromBendModulation (frequencyConst 3) (Instr.modulation id))) sampledSoundSmallSpaceLeak4 :: IO (Sample.T -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) sampledSoundSmallSpaceLeak4 = liftA (\osc smp _fm _vel freq dur -> let (sustainFM, releaseFM) = SVP.splitAt (chunkSizesFromLazyTime dur) $ (SigSt.repeat Option.defaultChunkSize (Serial.fromList [freq*Sample.period smp/sampleRatePlain]) :: 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 (Sample.T -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) sampledSoundSmallSpaceLeak4a = liftA (\osc smp _fm _vel freq dur -> case SVP.splitAt (chunkSizesFromLazyTime dur) $ (SigSt.repeat Option.defaultChunkSize (Serial.fromList [freq*Sample.period smp/sampleRatePlain]) :: 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 (Sample.T -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) sampledSoundNoSmallSpaceLeak3 = pure (\smp _fm _vel freq dur -> let (sustainFM, releaseFM) = SVP.splitAt (chunkSizesFromLazyTime dur) $ (SigSt.repeat Option.defaultChunkSize (Serial.fromList [freq*Sample.period smp/sampleRatePlain]) :: SigSt.T Vector) in SigSt.map (\x -> Stereo.cons x x) sustainFM `SigSt.append` SigSt.map (\x -> Stereo.cons x x) releaseFM) {-# NOINLINE amplifySVL #-} amplifySVL :: SVL.Vector Vector -> SVL.Vector Vector amplifySVL = SigSt.map (2*) sampledSoundNoSmallSpaceLeak2 :: IO (Sample.T -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) sampledSoundNoSmallSpaceLeak2 = liftA (\osc smp _fm _vel freq dur -> let (sustainFM, releaseFM) = SVP.splitAt (chunkSizesFromLazyTime dur) $ (SigSt.repeat Option.defaultChunkSize (Serial.fromList [freq*Sample.period smp/sampleRatePlain]) :: SigSt.T Vector) in osc () (amplifySVL sustainFM `SigSt.append` amplifySVL releaseFM)) (CausalP.runStorableChunky (arr (\x -> Stereo.cons x x))) sampledSoundSmallSpaceLeak1 :: IO (Sample.T -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) sampledSoundSmallSpaceLeak1 = liftA (\osc smp _fm _vel freq dur -> let (sustainFM, releaseFM) = SVP.splitAt (chunkSizesFromLazyTime dur) $ (SigSt.repeat Option.defaultChunkSize (Serial.fromList [freq*Sample.period smp/sampleRatePlain]) :: SigSt.T Vector) in osc () sustainFM `SigSt.append` osc () releaseFM) (CausalP.runStorableChunky (arr (\x -> Stereo.cons x x))) sampledSoundSmallSpaceLeak0 :: IO (Sample.T -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) sampledSoundSmallSpaceLeak0 = liftA (\osc 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) $ (SigSt.repeat Option.defaultChunkSize (Serial.fromList [freq*Sample.period smp/sampleRatePlain]) :: SigSt.T Vector) pos = Sample.positions smp amp = 2 * amplitudeFromVelocity vel (attack, sustain, release) = Sample.parts smp in osc (amp, attack `SigSt.append` SVL.cycle (SigSt.take (Sample.loopLength 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 (Sample.Cons (SigSt.replicate Option.defaultChunkSize 100000 0) (Sample.Positions 0 100000 50000 50000) 100) SVL.writeFile "test.f32" $ arrange vectorChunkSize $ evalState (do fm <- PC.bendWheelPressure Option.defaultChannel 2 0.04 0.03 Gen.sequenceModulated fm Option.defaultChannel sound) $ let evs t = EventList.cons t [] (evs (20-t)) in EventList.cons 10 [makeNote Event.NoteOn 60] $ evs 10 {- sequenceSample1 :: IO () sequenceSample1 = do sampler <- Instr.sampledSound let sound = sampler (SampledSound (SigSt.replicate Option.defaultChunkSize 100000 0) (SamplePositions 0 100000 50000 50000) 100) SVL.writeFile "test.f32" $ sound {- (let evs f = EventListBT.cons (BM.Cons 0.001 f) 10 (evs (0.02-f)) in evs 0.01) -} (let evs t = EventListBT.cons (BM.Cons 0.01 0.001) t (evs (20-t)) in evs 10) {- (PCS.Cons (Map.singleton (PC.Controller VoiceMsg.modulation) 1) (let evs t = EventList.cons t [] (evs (20-t)) in EventListMT.consTime 10 $ evs 10)) -} 0.01 1 -- (NonNegChunky.fromChunks $ repeat $ NonNegW.fromNumber 10) (NonNegChunky.fromChunks $ map NonNegW.fromNumber $ iterate (20-) 10) -} sequenceSample1 :: IO () sequenceSample1 = do sampler <- sampledSoundSmallSpaceLeak4a let sound = sampler (Sample.Cons (SigSt.replicate Option.defaultChunkSize 100000 0) (Sample.Positions 0 100000 50000 50000) 100) SVL.writeFile "test.f32" $ sound (let evs = EventListBT.cons (BM.Cons 0.01 0.001) 1 evs in evs) 0.01 1 (NonNegChunky.fromChunks $ repeat $ NonNegW.fromNumber 10) {- sequenceSample1a :: IO () sequenceSample1a = do {- makeStereoLLVM <- CausalP.runStorableChunky2 -- NoSpaceLeak (arr (\x -> Stereo.cons x x)) let stereoLLVM = makeStereoLLVM () -} stereoLLVM <- CausalP.runStorableChunky3 let stereoPlain = SigSt.map (\x -> Stereo.cons x x) SVL.writeFile "test.f32" $ let dur = NonNegChunky.fromChunks $ repeat $ SVL.chunkSize 10 !(sustainFM, releaseFM) = SVP.splitAt dur $ (SigSt.repeat Option.defaultChunkSize (Serial.fromList [1]) :: SigSt.T Vector) in case 3::Int of -- no leak 0 -> stereoLLVM $ sustainFM `SigSt.append` releaseFM -- no leak 1 -> stereoPlain $ sustainFM `SigSt.append` releaseFM -- no leak 2 -> stereoPlain sustainFM `SigSt.append` stereoPlain releaseFM -- leak 3 -> stereoLLVM sustainFM `SigSt.append` stereoPlain releaseFM -- no leak 4 -> stereoPlain sustainFM `SigSt.append` stereoLLVM releaseFM -- leak 5 -> stereoLLVM sustainFM `SigSt.append` stereoLLVM releaseFM -} sequenceSample2 :: IO () sequenceSample2 = do arrange <- SigStL.makeArranger sampler <- sampledSoundTest2 let sound = sampler (Sample.Cons (SigSt.replicate Option.defaultChunkSize 100000 0) (Sample.Positions 0 100000 50000 50000) 100) SVL.writeFile "test.f32" $ arrange vectorChunkSize $ evalState (do bend <- PC.pitchBend Option.defaultChannel 2 0.01 let fm = fmap (\t -> BM.Cons t t) bend Gen.sequenceModulated fm Option.defaultChannel sound) $ let evs t = EventList.cons t [] (evs (20-t)) in EventList.cons 10 [makeNote Event.NoteOn 60] $ evs 10 {- Interestingly, when the program aborts because of heap exhaustion, then the generated file has size 137MB independent of the heap size (I tried sizes from 1MB to 64MB). -} sequenceSample3 :: IO () sequenceSample3 = do arrange <- SigStL.makeArranger sampler <- sampledSoundTest2 let sound = sampler (Sample.Cons (SigSt.replicate Option.defaultChunkSize 100000 0) (Sample.Positions 0 100000 50000 50000) 100) SVL.writeFile "test.f32" $ arrange vectorChunkSize $ evalState (let evs = EventListBT.cons (BM.Cons 0.01 0.001) 10 evs in Gen.sequence Option.defaultChannel (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 -- sampler <- sampledSoundTest2 let sound = sampler (Sample.Cons (SigSt.replicate Option.defaultChunkSize 100000 0) (Sample.Positions 0 100000 50000 50000) 100) SVL.writeFile "test.f32" $ arrange vectorChunkSize $ evalState (let evs = EventListBT.cons (BM.Cons 0.01 0.001) 10 evs in Gen.sequenceCore Option.defaultChannel Gen.errorNoProgram (Gen.Modulator () return (return . Gen.renderInstrumentIgnoreProgram (sound evs sampleRate)))) $ 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 (BM.Cons 0.01 0.001) 10 evs in evs -- sound <- Instr.softStringReleaseEnvelope SVL.writeFile "test.f32" $ arrange vectorChunkSize $ evalState (Gen.sequenceCore Option.defaultChannel Gen.errorNoProgram (Gen.Modulator () return (return . Gen.renderInstrumentIgnoreProgram (sound sampleRate)))) $ let evs = EventList.cons 10 [] evs in EventList.cons 10 [makeNote Event.NoteOn 60] evs {- sound 0.01 1 (NonNegChunky.fromChunks $ map NonNegW.fromNumber $ iterate (20-) 10) -} adsr :: IO () adsr = do env <- Instr.adsr SVL.writeFile "adsr.f32" $ env 0.2 2 0.15 0.3 0.5 vectorChunkSize sampleRate (-0.5) 88200 constCtrl :: a -> PC.T a constCtrl x = let xs = EventListBT.cons x 10000 xs in xs bellNoiseStereoTest :: IO () bellNoiseStereoTest = do str <- Instr.bellNoiseStereoFM SVL.writeFile "bellnoise.f32" $ str 0.3 0.1 (constCtrl 0.3) (constCtrl 100) vectorChunkSize (constCtrl (BM.Cons 1 0.01)) sampleRate 0 440 100000