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.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 Data.Tuple.HT (mapPair, ) {- import qualified Numeric.NonNegative.Class as NonNeg -} import qualified Numeric.NonNegative.Wrapper as NonNegW import qualified Numeric.NonNegative.Chunky as NonNegChunky {- import qualified Algebra.RealRing as RealRing import qualified Algebra.Additive as Additive -} -- import NumericPrelude.Numeric (zero, round, (^?), ) import Prelude hiding (Real, round, break, ) {- | try to reproduce a space leak -} sequencePlain :: IO () sequencePlain = SVL.writeFile "test.f32" $ -- print $ last $ SVL.chunks $ 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" $ -- print $ last $ SVL.chunks $ 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 = error "undefined pitch bend" 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 (2-y)) 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.softStringReleaseEnvelope sound <- Instr.softString -- space leak -- sound <- Instr.pingReleaseEnvelope $/ 1 -- no space leak -- sound <- Instr.pingRelease $/ 1 $/ 1 -- no space leak SVL.writeFile "test.f32" $ evalState (Gen.sequence (arrange vectorChunkSize) channel 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" $ 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 (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" $ 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 (20-t) in evs 10 sequencePress :: IO () sequencePress = do arrange <- SigStL.makeArranger -- sound <- Instr.softString -- sound <- Instr.softStringReleaseEnvelope 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 (20-t) 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))) -- $* (SigPS.constant $# Stereo.cons 0.999 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 -> {- 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 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 -> {- 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)) (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 -> {- 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)) (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) {-# NOINLINE amplifySVL #-} 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 -> {- 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 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 (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 chunkSize 100000 0) (SamplePositions 0 100000 50000 50000) 100) SVL.writeFile "test.f32" $ sound {- (let evs f = EventListBT.cons (MIDIL.BendModulation 0.001 f) 10 (evs (0.02-f)) in evs 0.01) -} (let evs t = EventListBT.cons (MIDIL.BendModulation 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 (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) {- 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 chunkSize (LLVM.vector [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 (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 (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 (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 -- 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.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 -- sound <- Instr.softStringReleaseEnvelope 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 {- 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 (-0.5) 88200