module Synthesizer.LLVM.Server.Scalar.Instrument where

import Synthesizer.LLVM.Server.Common
import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
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 qualified LLVM.Core as LLVM

import qualified Synthesizer.MIDI.EventList as Ev
import Synthesizer.MIDI.Storable (chunkSizesFromLazyTime, )

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

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

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


pingSig :: SigP.T (SampleRate Real, (Real, Real)) (LLVM.Value Real)
pingSig =
   let vel = number fst
       freq = frequency snd
   in  CausalP.envelope
          $< SigP.exponential2 (timeConst 0.2)
                (fmap amplitudeFromVelocity vel)
          $* SigP.osciSimple WaveL.saw zero freq

ping :: IO (SigSt.ChunkSize -> SampleRate Real -> Real -> Real -> SigSt.T Real)
ping =
   fmap (\f chunkSize sr vel freq -> f chunkSize (sr, (vel,freq))) $
   SigP.runChunky pingSig

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

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

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



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

pingRelease :: IO (Real -> Real -> SigSt.ChunkSize -> Instrument Real Real)
pingRelease =
   liftA2
      (\osc env dec rel chunkSize sr vel freq dur ->
         osc (sr, freq) (env dec rel chunkSize sr vel dur))
      (CausalP.runStorableChunky
         (let freq = frequency id
          in  CausalP.envelope $>
              SigP.osciSimple WaveL.saw zero freq))
      pingReleaseEnvelope

pingStereoRelease :: IO (Real -> Real -> SigSt.ChunkSize -> Instrument Real (Stereo.T Real))
pingStereoRelease =
   liftA2
      (\osc env dec rel chunkSize sr vel freq dur ->
         osc (sr, freq) (env dec rel chunkSize sr vel dur))
      (CausalP.runStorableChunky
         (let freq = frequency id
          in  CausalP.envelopeStereo $>
              liftA2 Stereo.cons
                 (SigP.osciSimple WaveL.saw zero (0.999*freq))
                 (SigP.osciSimple WaveL.saw zero (1.001*freq))))
      pingReleaseEnvelope



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

tineStereo :: IO (Real -> Real -> SigSt.ChunkSize -> Instrument Real (Stereo.T Real))
tineStereo =
   liftA2
      (\osc env dec rel chunkSize sr vel freq dur ->
         osc (sr, (vel,freq)) (env dec rel chunkSize sr 0 dur))
      (CausalP.runStorableChunky
         (let freq = frequency snd
              vel  = number fst
              chanOsci d =
                 CausalP.osciSimple WaveL.approxSine2
                    $> SigP.constant (freq*d)
          in  CausalP.envelopeStereo $>
                 (liftA2 Stereo.cons
                     (chanOsci 0.995) (chanOsci 1.005)
                  $* SigP.envelope
                        (SigP.exponential2 (timeConst 1) (vel+1))
                        (SigP.osciSimple WaveL.approxSine2 zero (2*freq)))))
      pingReleaseEnvelope



softStringReleaseEnvelope ::
   IO (Real -> SampleRate Real -> Real -> Ev.LazyTime -> SigSt.T Real)
softStringReleaseEnvelope =
   liftA
      (\env attackTime (SampleRate sampleRate) vel dur ->
         let attackTimeInt =
                round (attackTime * sampleRate)
             {-
             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 attackTimeInt $
                env (chunkSizesFromLazyTime dur)
                    (fromIntegral attackTimeInt :: Real,
                     amplitudeFromVelocity vel)
             release = SigSt.reverse attack
         in  attack `SigSt.append` sustain `SigSt.append` release)
      (let amp = arr snd
           attackTime = arr fst
       in  SigP.runChunkyPattern $
           flip SigP.append (SigP.constant amp) $
           SigP.amplify amp $
           (SigP.parabolaFadeIn attackTime))

softString :: IO (Instrument Real (Stereo.T Real))
softString =
   liftA2
      (\osc env sr vel freq dur ->
         osc (sr, freq) (env 1 sr vel dur))
      (let freq = frequency id
           osci d =
              SigP.osciSimple WaveL.saw zero (d * freq)
       in  CausalP.runStorableChunky $
           (CausalP.envelopeStereo $>
              (liftA2 Stereo.cons
                 (osci 1.005 + osci 0.998)
                 (osci 1.002 + osci 0.995))))
      softStringReleaseEnvelope