module Synthesizer.LLVM.Server.Scalar.Instrument where

import Synthesizer.LLVM.Server.Common

import qualified Synthesizer.EventList.ALSA.MIDI as Ev

import qualified Synthesizer.LLVM.Frame.Stereo as Stereo

import Synthesizer.Storable.ALSA.MIDI (Instrument, chunkSizesFromLazyTime, )

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

import qualified LLVM.Core as LLVM

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

import Control.Arrow ((<<<), (^<<), (&&&), arr, )
import Control.Applicative (pure, liftA, liftA2, )

import qualified Algebra.RealRing as RealRing
import qualified Algebra.Additive  as Additive

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


pingSig :: SigP.T (Real, Real) (LLVM.Value Real)
pingSig =
   let vel = arr fst
       freq = arr snd
   in  CausalP.envelope
          $< SigP.exponential2 (pure (0.2*sampleRate))
                (fmap amplitudeFromVelocity vel)
          $* SigP.osciSimple WaveL.saw zero (freq/sampleRate)

ping :: IO (Real -> Real -> SigSt.T Real)
ping =
   fmap curry $ fmap ($chunkSize) $ SigP.runChunky pingSig

pingDur :: IO (Instrument Real Real)
pingDur =
   fmap
      (\sound vel freq dur ->
         sound (chunkSizesFromLazyTime dur) (vel, freq)) $
   SigP.runChunkyPattern pingSig

pingDurTake :: IO (Instrument Real Real)
pingDurTake =
   fmap (\sound vel freq dur ->
      SigStV.take (chunkSizesFromLazyTime dur) $
      sound vel freq) ping

dummy :: Instrument Real Real
dummy =
   \vel freq dur ->
      SigStV.take (chunkSizesFromLazyTime dur) $
      SigSt.repeat chunkSize (vel + 1e-3*freq)



pingReleaseEnvelope ::
   IO (Real -> Real -> Real -> Ev.LazyTime -> SigSt.T Real)
pingReleaseEnvelope =
   liftA2
      (\pressed release decay rel vel dur ->
         SigStL.continue
            (pressed (chunkSizesFromLazyTime dur) (decay,vel))
            (\x -> release chunkSize (rel,x)))
      (SigP.runChunkyPattern $
       let decay = arr fst
           velocity = arr snd
       in  SigP.exponential2 (decay*sampleRate)
              (amplitudeFromVelocity ^<< velocity))
      (SigP.runChunky $
       let release = arr fst
           amplitude = arr snd
       in  (CausalP.take (round ^<< (release*3*sampleRate)) $*
            SigP.exponential2 (release*sampleRate) amplitude))

pingRelease :: IO (Real -> Real -> Instrument Real Real)
pingRelease =
   liftA2
      (\osc env dec rel vel freq dur ->
         osc freq (env dec rel vel dur))
      (CausalP.runStorableChunky
         (let freq = arr id
          in  CausalP.envelope $>
              SigP.osciSimple WaveL.saw zero (freq/sampleRate)))
      pingReleaseEnvelope

pingStereoRelease :: IO (Real -> Real -> Instrument Real (Stereo.T Real))
pingStereoRelease =
   liftA2
      (\osc env dec rel vel freq dur ->
         osc freq (env dec rel vel dur))
      (CausalP.runStorableChunky
         (let freq = arr id
          in  CausalP.envelopeStereo $>
              SigP.zipWithSimple Sample.zipStereo
                 (SigP.osciSimple WaveL.saw zero
                     (0.999*freq/sampleRate))
                 (SigP.osciSimple WaveL.saw zero
                     (1.001*freq/sampleRate))))
      pingReleaseEnvelope



tine :: IO (Real -> Real -> Instrument Real Real)
tine =
   liftA2
      (\osc env dec rel vel freq dur ->
         osc (vel,freq) (env dec rel 0 dur))
      (CausalP.runStorableChunky
         (let freq = arr snd
              vel  = arr fst
          in  CausalP.envelope $>
                 (CausalP.osciSimple WaveL.approxSine2
                    $> (SigP.constant (freq/sampleRate))
                    $* (CausalP.envelope
                          $< SigP.exponential2 (1*sampleRate) (vel+1)
                          $* SigP.osciSimple WaveL.approxSine2 zero
                                (2*freq/sampleRate)))))
      pingReleaseEnvelope

tineStereo :: IO (Real -> Real -> Instrument Real (Stereo.T Real))
tineStereo =
   liftA2
      (\osc env dec rel vel freq dur ->
         osc (vel,freq) (env dec rel 0 dur))
      (CausalP.runStorableChunky
         (let freq = arr snd
              vel  = arr fst
              chanOsci d =
                 CausalP.osciSimple WaveL.approxSine2
                    $> SigP.constant (freq*d/sampleRate)
          in  CausalP.envelopeStereo $>
                 ((CausalP.zipWithSimple Sample.zipStereo <<<
                     chanOsci 0.995 &&& chanOsci 1.005)
                  $* SigP.envelope
                        (SigP.exponential2 (1*sampleRate) (vel+1))
                        (SigP.osciSimple WaveL.approxSine2 zero
                           (2*freq/sampleRate)))))
      pingReleaseEnvelope



softStringReleaseEnvelope ::
   IO (Real -> Ev.LazyTime -> SigSt.T Real)
softStringReleaseEnvelope =
   let attackTime = sampleRate
   in  liftA
          (\env vel dur ->
             let amp = amplitudeFromVelocity vel
                 {-
                 release <- take attackTime beginning
                 would yield a space leak, thus we first split 'beginning'
                 and then concatenate it again
                 -}
                 {-
                 We can not easily generate attack and sustain separately,
                 because we want to use the chunk structure implied by 'dur'.
                 -}
                 (attack, sustain) =
                    SigSt.splitAt attackTime $
                    env (chunkSizesFromLazyTime dur) amp
                 release = SigSt.reverse attack
             in  attack `SigSt.append` sustain `SigSt.append` release)
          (let amp = arr id
           in  SigP.runChunkyPattern $
               flip SigP.append (SigP.constant amp) $
               SigP.amplify amp $
               (SigP.parabolaFadeIn $# fromIntegral attackTime))

softString :: IO (Instrument Real (Stereo.T Real))
softString =
   liftA2
      (\osc env vel freq dur ->
         osc freq (env vel dur))
      (let freq = arr id
           osci d =
              SigP.osciSimple WaveL.saw zero (d * freq / sampleRate)
       in  CausalP.runStorableChunky $
           (CausalP.envelopeStereo $>
              (SigP.zipWithSimple Sample.zipStereo
                 (SigP.mix
                    (osci 1.005)
                    (osci 0.998))
                 (SigP.mix
                    (osci 1.002)
                    (osci 0.995)))))
      softStringReleaseEnvelope