module Synthesizer.LLVM.Server.Scalar.Test where

import qualified Synthesizer.LLVM.Server.Scalar.Instrument as Instr
import Synthesizer.LLVM.Server.Scalar.Run (withMIDIEvents, )
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.CausalParameterized.Process as CausalP
import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
import qualified Synthesizer.LLVM.Wave as WaveL
import Synthesizer.LLVM.CausalParameterized.Process (($<#), ($*), )

import qualified Synthesizer.Storable.Cut         as CutSt
import qualified Synthesizer.Storable.Signal      as SigSt
import qualified Data.StorableVector.Lazy         as SVL

import qualified Data.EventList.Relative.TimeBody  as EventList

import Control.Arrow (arr, )
import Control.Monad.Trans.State (evalState, )

import qualified Algebra.Additive  as Additive

import NumericPrelude.Numeric (zero, )
import Prelude hiding (Real, )


pitchBend0 :: IO ()
pitchBend0 = do
   osc <-
      SigP.runChunky
         ((CausalP.osciSimple WaveL.triangle $<# (zero::Real))
             $* piecewiseConstant (arr id))
   SVL.writeFile "test.f32" $
      (id :: SigSt.T Real -> SigSt.T Real) .
      osc chunkSize .
      evalState (PC.pitchBend channel 2 (880/sampleRate::Real)) $
      let evs = EventList.cons 100 [] evs
      in  EventList.cons 0 [] evs

pitchBend1 :: IO ()
pitchBend1 = do
   osc <-
      SigP.runChunky
         ((CausalP.osciSimple WaveL.triangle $<# (zero::Real))
             $* piecewiseConstant (arr id))
   withMIDIEvents (\ _period _rate -> SVL.writeFile "test.f32") $
      (id :: SigSt.T Real -> SigSt.T Real) .
      osc chunkSize .
      evalState (PC.pitchBend channel 2 (880/sampleRate::Real))

pitchBend2 :: IO ()
pitchBend2 =
   withMIDIEvents (\ _period _rate -> print) id



sequencePress :: IO ()
sequencePress = do
--   arrange <- SigStL.makeArranger
--   sound <- Instr.softString
--   sound <- Instr.softStringReleaseEnvelope
--   sound <- Instr.pingReleaseEnvelope $/ 1
--   sound <- Instr.pingDur
--   sound <- Instr.pingDurTake
   let sound = Instr.dummy
   SVL.writeFile "test.f32" $
      evalState
         (do Gen.sequence (CutSt.arrange chunkSize) 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