packages feed

synthesizer-llvm-1.0: alsa/Synthesizer/LLVM/Server/Packed/Test.hs

module Synthesizer.LLVM.Server.Packed.Test where

import qualified Synthesizer.LLVM.Server.Packed.Instrument as Instr
import qualified Synthesizer.LLVM.Server.Default as Default
import qualified Synthesizer.LLVM.Server.SampledSound as Sample
import Synthesizer.LLVM.Server.Packed.Instrument (InputArg(Modulation))
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.Plain 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.Causal.ProcessPacked as CausalPS
import qualified Synthesizer.LLVM.Causal.Render as CausalRender
import qualified Synthesizer.LLVM.Causal.Process as Causal
import qualified Synthesizer.LLVM.Generator.SignalPacked as SigPS
import qualified Synthesizer.LLVM.Generator.Render as Render
import qualified Synthesizer.LLVM.Storable.Signal as SigStL
import Synthesizer.LLVM.Causal.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.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.Wrapper as NonNegW
import qualified Numeric.NonNegative.Chunky as NonNegChunky

import Algebra.IntegralDomain (divUp)

import qualified Number.DimensionTerm as DN

import Prelude hiding (Real, round, break)


chunkSize :: SVL.ChunkSize
chunkSize = Play.defaultChunkSize

vectorChunkSize :: SVL.ChunkSize
vectorChunkSize =
   case chunkSize of
      SVL.ChunkSize size ->
         SVL.ChunkSize (divUp size vectorSize)

sampleRatePlain :: Num a => a
sampleRatePlain = case Default.sampleRate of SampleRate r -> r

sampleRate :: SampleRate Real
sampleRate = Default.sampleRate


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 chunkSize $
      evalState (Gen.sequence Default.channel (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 Default.channel (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 Default.channel
                 (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) Default.channel
                 (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 Default.channel 2 0.01
             Gen.sequenceModulated fm Default.channel
                (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 Default.channel 2 0.04 0.03
             Gen.sequenceModulated fm Default.channel
                (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 Default.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" $
      arrange vectorChunkSize $
      evalState
         (do fm <- PC.bendWheelPressure Default.channel 2 0.04 0.03
             Gen.sequenceModulated fm Default.channel
                (\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 Default.channel 2 0.04 0.03
             Gen.sequenceModulated fm Default.channel
                (\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 Default.channel (\ _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 chunkSize (Sample.body smp))
      (Render.run $ \smp ->
         fmap (\x -> Stereo.consMultiValue x x) $ SigPS.pack smp)

sampledSoundTest1 ::
   IO (Sample.T ->
       PC.T (BM.T Real) ->
       Instrument Real (Stereo.T Vector))
sampledSoundTest1 =
   liftA
      (\osc smp _fm _vel _freq _dur ->
         osc chunkSize (Sample.body smp))
      (Render.run $ \smp ->
         Stereo.multiValue <$>
         Causal.stereoFromMono
                  (CausalPS.pack (Causal.frequencyModulationLinear 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 chunkSize sampleRate body (fm, freq * Sample.period pos))
      (Render.run $
       wrapped $ \(Signal smp) (Modulation fm) ->
       constant frequency 3 $ \speed _sr ->
         Stereo.multiValue <$>
         ((Causal.stereoFromMono
                  (CausalPS.pack (Causal.frequencyModulationLinear smp))
               <<<
               liftA2 Stereo.cons
                  (CausalPS.amplify 0.999)
                  (CausalPS.amplify 1.001))
                 $* Instr.frequencyFromBendModulation speed 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 :: SigSt.T Vector
             (sustainFM, releaseFM) =
                SVP.splitAt (chunkSizesFromLazyTime dur) $
                SigSt.repeat chunkSize
                   (Serial.replicate (freq*Sample.period pos/sampleRatePlain))
             pos = Sample.positions smp
             amp = 2 * amplitudeFromVelocity vel
             (attack, sustain, release) = Sample.parts smp
         in pioApply
              (osc amp
                (attack `SigSt.append`
                 SVL.cycle (SigSt.take (Sample.loopLength pos) sustain)))
              sustainFM
            `SigSt.append`
            pioApply (osc amp release) releaseFM)
      (CausalRender.run $ \amp smp ->
         Stereo.multiValue <$>
         (CausalPS.amplifyStereo amp
              <<<
              Causal.stereoFromMono
                 (CausalPS.pack
                    (Causal.frequencyModulationLinear 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 :: SigSt.T Vector
             (sustainFM, releaseFM) =
                SVP.splitAt (chunkSizesFromLazyTime dur) $
                pioApplyToLazyTime
                   (freqMod sampleRate (fm, freq*Sample.period pos))
                   (PC.duration fm)
             pos = Sample.positions smp
         in  SigSt.map
                (\x -> Stereo.cons x x)
                (sustainFM `SigSt.append` releaseFM))
      (CausalRender.run $
       wrapped $ \(Modulation fm) ->
       constant frequency 3 $ \speed _sr ->
       Causal.fromSignal $ Instr.frequencyFromBendModulation speed fm)

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 :: SigSt.T Vector
             (sustainFM, releaseFM) =
                SVP.splitAt (chunkSizesFromLazyTime dur) $
                pioApplyToLazyTime
                   (freqMod sampleRate (fm, freq*Sample.period pos))
                   (PC.duration fm)
             pos = Sample.positions smp
             amp = 2 * amplitudeFromVelocity vel
             (attack, sustain, release) = Sample.parts smp
         in pioApply
              (osc amp
                 (attack `SigSt.append`
                  SVL.cycle (SigSt.take (Sample.loopLength pos) sustain)))
              sustainFM
            `SigSt.append`
            pioApply (osc amp release) releaseFM)
      (CausalRender.run $ \ _amp _smp -> arr (\x -> Stereo.consMultiValue x x))
      (CausalRender.run $
       wrapped $ \(Modulation fm) ->
       constant frequency 3 $ \speed _sr ->
       Causal.fromSignal $ Instr.frequencyFromBendModulation speed fm)


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 :: SigSt.T Vector
             (sustainFM, releaseFM) =
                SVP.splitAt (chunkSizesFromLazyTime dur) $
                SigSt.repeat chunkSize
                   (Serial.replicate (freq*Sample.period pos/sampleRatePlain))
             pos = Sample.positions smp
         in  pioApply osc sustainFM
             `SigSt.append`
             SigSt.map (\x -> Stereo.cons x x) releaseFM)
      (CausalRender.run $ arr (\x -> Stereo.consMultiValue 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 chunkSize
                   (Serial.replicate (freq*Sample.period (Sample.positions smp) / sampleRatePlain)) of
            (sustainFM, releaseFM) ->
               pioApply osc (sustainFM :: SigSt.T Vector)
               `SigSt.append`
               SigSt.map (\x -> Stereo.cons x x) releaseFM)
      (CausalRender.run $ arr (\x -> Stereo.consMultiValue 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 :: SigSt.T Vector
             (sustainFM, releaseFM) =
                SVP.splitAt (chunkSizesFromLazyTime dur) $
                SigSt.repeat chunkSize
                   (Serial.replicate (freq*Sample.period pos/sampleRatePlain))
             pos = Sample.positions smp
         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 :: SigSt.T Vector
             (sustainFM, releaseFM) =
                SVP.splitAt (chunkSizesFromLazyTime dur) $
                SigSt.repeat chunkSize
                   (Serial.replicate (freq*Sample.period pos/sampleRatePlain))
             pos = Sample.positions smp
         in  pioApply osc
                (amplifySVL sustainFM
                 `SigSt.append`
                 amplifySVL releaseFM))
      (CausalRender.run $ arr (\x -> Stereo.consMultiValue 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 :: SigSt.T Vector
             (sustainFM, releaseFM) =
                SVP.splitAt (chunkSizesFromLazyTime dur) $
                SigSt.repeat chunkSize
                   (Serial.replicate (freq*Sample.period pos/sampleRatePlain))
             pos = Sample.positions smp
         in  pioApply osc sustainFM
             `SigSt.append`
             pioApply osc releaseFM)
      (CausalRender.run $ arr (\x -> Stereo.consMultiValue 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 :: SigSt.T Vector
             (sustainFM, releaseFM) =
                SVP.splitAt (chunkSizesFromLazyTime dur) $
                SigSt.repeat chunkSize
                   (Serial.replicate (freq*Sample.period pos/sampleRatePlain))
             pos = Sample.positions smp
             amp = 2 * amplitudeFromVelocity vel
             (attack, sustain, release) = Sample.parts smp
         in  pioApply
                (osc amp
                   (attack `SigSt.append`
                    SVL.cycle (SigSt.take (Sample.loopLength pos) sustain)))
                sustainFM
             `SigSt.append`
             pioApply (osc amp release) releaseFM)
      (CausalRender.run $ \ _amp _smp -> arr (\x -> Stereo.consMultiValue x x))

makeSample :: Int -> Sample.T
makeSample size =
   Sample.Cons
      (SigSt.replicate chunkSize size 0)
      (DN.frequency 44100)
      (Sample.Positions 0 100000 50000 50000 100)

sequenceSample :: IO ()
sequenceSample = do
   arrange <- SigStL.makeArranger
   sampler <- sampledSoundTest2
   let sound = sampler $ makeSample 100000
   SVL.writeFile "test.f32" $
      arrange vectorChunkSize $
      evalState
         (do fm <- PC.bendWheelPressure Default.channel 2 0.04 0.03
             Gen.sequenceModulated fm Default.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 (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 $ makeSample 100000
   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 :: SigSt.T Vector
          !(sustainFM, releaseFM) =
             SVP.splitAt dur $
             SigSt.repeat chunkSize (Serial.replicate 1)
      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 $ makeSample 100000
   SVL.writeFile "test.f32" $
      arrange vectorChunkSize $
      evalState
         (do bend <- PC.pitchBend Default.channel 2 0.01
             let fm = fmap (\t -> BM.Cons t t) bend
             Gen.sequenceModulated fm Default.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 $ makeSample 100000
   SVL.writeFile "test.f32" $
      arrange vectorChunkSize $
      evalState
         (let evs =
                 EventListBT.cons (BM.Cons 0.01 0.001) 10 evs
          in  Gen.sequence Default.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 $ makeSample 100000
   SVL.writeFile "test.f32" $
      arrange vectorChunkSize $
      evalState
         (let evs = EventListBT.cons (BM.Cons 0.01 0.001) 10 evs
          in  Gen.sequenceCore
                 Default.channel 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
             Default.channel 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