module Synthesizer.LLVM.Server.Scalar.Run where

import qualified Synthesizer.LLVM.Server.Scalar.Instrument as Instr
import Synthesizer.LLVM.Server.Common

import qualified Sound.ALSA.Sequencer.Event as Event
import qualified Data.EventList.Relative.TimeBody  as EventList

import qualified Synthesizer.EventList.ALSA.MIDI as Ev
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 qualified Synthesizer.LLVM.ALSA.MIDI as MIDIL
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.Wave as WaveL
import Synthesizer.LLVM.CausalParameterized.Process (($<#), ($*), )
import Synthesizer.LLVM.Parameterized.Signal (($#), )

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

import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg

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

import qualified Algebra.Additive  as Additive

import NumericPrelude.Numeric (zero, (*>), )
import Prelude hiding (Real, break, )


{-# INLINE withMIDIEvents #-}
withMIDIEvents ::
   (Double -> Double -> a -> IO b) ->
   (EventList.T Ev.StrictTime [Event.T] -> a) -> IO b
withMIDIEvents action proc =
   let rate = sampleRate
       per  = periodTime
   in  Ev.withMIDIEvents per rate $
       action per rate . proc



pitchBend :: IO ()
pitchBend = do
   osc <-
      SigP.runChunky
         ((CausalP.osciSimple WaveL.triangle $<# (zero::Real))
             $* piecewiseConstant (arr id))
   withMIDIEvents play $
      (id :: SigSt.T Real -> SigSt.T Real) .
      osc chunkSize .
      evalState (PC.pitchBend channel 2 (880/sampleRate::Real))


frequencyModulation :: IO ()
frequencyModulation = do
   osc <-
      SigP.runChunky
         (((CausalP.osciSimple WaveL.triangle $<# (zero::Real))
              <<< (MIDIL.frequencyFromBendModulation $# (10/sampleRate::Real)))
           $* piecewiseConstant (arr (transposeModulation 880)))
   withMIDIEvents play $
      (id :: SigSt.T Real -> SigSt.T Real) .
      osc chunkSize .
      evalState (PC.bendWheelPressure channel 2 0.04 (0.03::Real))



keyboard :: IO ()
keyboard = do
--   sound <- Instr.pingDur
{-
   sound <-
      fmap (\s vel _freq dur -> s vel dur) $
      (Instr.pingReleaseEnvelope $/ 0.4 $/ 0.1)
-}
   sound <- Instr.pingRelease $/ 0.4 $/ 0.1
   amp <- CausalP.runStorableChunky (CausalP.amplify $# 0.2)
   arrange <- SigStL.makeArranger
   withMIDIEvents play $
      (amp () :: SigSt.T Real -> SigSt.T Real) .
      evalState (Gen.sequence (arrange chunkSize) channel sound)

keyboardStereo :: IO ()
keyboardStereo = do
   sound <- Instr.pingStereoRelease $/ 0.4 $/ 0.1
   amp <- CausalP.runStorableChunky (CausalP.amplifyStereo $# 0.2)
   arrange <- SigStL.makeArranger
   withMIDIEvents play $
      (amp () :: SigSt.T (Stereo.T Real) -> SigSt.T (Stereo.T Real)) .
      evalState (Gen.sequence (arrange chunkSize) channel sound)

keyboardMulti :: IO ()
keyboardMulti = do
   png <- Instr.pingDur
   pngRel <- Instr.pingRelease $/ 0.4 $/ 0.1
   tin <- Instr.tine $/ 0.4 $/ 0.1
   arrange <- SigStL.makeArranger
   withMIDIEvents play $
--      playALSA (Bld.put :: Int16 -> Bld.Builder Int16) (sampleRate::Real) .
      SigSt.map (0.2*) .
      evalState (Gen.sequenceMultiProgram (arrange chunkSize) channel
         (VoiceMsg.toProgram 2)
         [png, pngRel, tin])

keyboardStereoMulti :: IO ()
keyboardStereoMulti = do
   png <- Instr.pingStereoRelease $/ 0.4 $/ 0.1
   tin <- Instr.tineStereo $/ 0.4 $/ 0.1
   str <- Instr.softString
   arrange <- SigStL.makeArranger
   withMIDIEvents play $
--      playALSA (Bld.put :: Int16 -> Bld.Builder Int16) (sampleRate::Real) .
      SigSt.map ((0.2::Real)*>) .
      evalState (Gen.sequenceMultiProgram (arrange chunkSize) channel
         (VoiceMsg.toProgram 1)
         [png, tin, str])