packages feed

synthesizer-llvm-0.6: 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.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 qualified Number.DimensionTerm as DN

-- 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 pos))))
      (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 pos/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 pos)) :: SigSt.T Vector)
             pos = Sample.positions smp
         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 pos)) :: 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 pos/sampleRatePlain])
                      :: SigSt.T Vector)
             pos = Sample.positions smp
         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 (Sample.positions 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 pos/sampleRatePlain])
                      :: SigSt.T Vector)
             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) =
                SVP.splitAt (chunkSizesFromLazyTime dur) $
                (SigSt.repeat Option.defaultChunkSize
                   (Serial.fromList [freq*Sample.period pos/sampleRatePlain])
                      :: SigSt.T Vector)
             pos = Sample.positions smp
         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 pos/sampleRatePlain])
                      :: SigSt.T Vector)
             pos = Sample.positions smp
         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 pos/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)))

makeSample :: Int -> Sample.T
makeSample size =
   Sample.Cons
      (SigSt.replicate Option.defaultChunkSize 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 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 $ 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) =
             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 $ makeSample 100000
   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 $ makeSample 100000
   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 $ makeSample 100000
   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