module Synthesizer.LLVM.Server.CausalPacked.Run where

import Synthesizer.LLVM.Server.Packed.Run
          (StereoVector,
           controllerVolume, controllerDetune,
           controllerTimbre0, controllerTimbre1, )
import qualified Sound.MIDI.Controller as Ctrl

import qualified Synthesizer.LLVM.Server.CausalPacked.Instrument as Instr
import qualified Synthesizer.LLVM.Server.Packed.Instrument as InstrP
import qualified Synthesizer.LLVM.Server.Packed.Run as RunP
import qualified Synthesizer.LLVM.Server.Option as Option
import Synthesizer.LLVM.Server.Common

import qualified Sound.ALSA.Sequencer.Event as Event
import qualified Synthesizer.EventList.ALSA.MIDI as Ev

import qualified Synthesizer.CausalIO.ALSA.MIDIControllerSet as MCS
import qualified Synthesizer.CausalIO.ALSA.Process as PAlsa
import qualified Synthesizer.CausalIO.Process as PIO

import qualified Synthesizer.LLVM.CausalParameterized.ProcessPacked as CausalPS
import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
import qualified Synthesizer.LLVM.Storable.Process as CausalSt
import qualified Synthesizer.LLVM.Storable.Signal as SigStL
import Synthesizer.LLVM.Parameterized.Signal (($#), )

import qualified Synthesizer.LLVM.Frame.StereoInterleaved as StereoInt

import qualified LLVM.Extra.ScalarOrVector as SoV

import qualified Data.StorableVector as SV

import qualified Data.EventList.Relative.TimeTime  as EventListTT

-- import qualified Synthesizer.LLVM.ALSA.BendModulation as BM
import qualified Synthesizer.Zip as Zip

import qualified Sound.ALSA.PCM as PCM

import qualified Synthesizer.Dimensional.MIDIValuePlain as MV
import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
import qualified Sound.MIDI.Message.Channel as ChannelMsg
import qualified Sound.MIDI.ALSA.Check as Check

import Control.Arrow (Arrow, (<<<), (<<^), (^<<), (***), arr, first, )
import Control.Category (id, )

import qualified Data.Map as Map
{-
import Data.Tuple.HT (mapPair, fst3, snd3, thd3, )
-}

import qualified Number.DimensionTerm as DN
import qualified Algebra.DimensionTerm as Dim

import qualified Algebra.Transcendental as Trans
import qualified Algebra.Additive as Additive

{-
import qualified Numeric.NonNegative.Class   as NonNeg
import qualified Numeric.NonNegative.Chunky  as NonNegChunky
-}
import qualified Numeric.NonNegative.Wrapper as NonNegW

import Prelude hiding (Real, id, )




playFromEvents ::
   (PCM.SampleFmt a, Additive.C a) =>
   Option.T ->
   PIO.T (EventListTT.T Ev.StrictTime [Event.T]) (SV.Vector a) ->
   IO ()
playFromEvents opt =
   PAlsa.playFromEvents
      (Option.device opt)
      (Option.clientName opt)
      0.01
      (Option.periodTime opt::Double)
      (case Option.sampleRate opt of
          SampleRate sr -> fromInteger sr)

keyboard :: IO ()
keyboard = do
   opt <- Option.get
   arrange <- CausalSt.makeArranger
   amp <- CausalP.processIO (CausalPS.amplify $# 0.2)

   ping <- Instr.pingRelease

   playFromEvents opt $
      arr SigStL.unpackStrict
      <<<
      amp ()
      <<<
      arrange
      <<<
      arr (EventListTT.mapTime
         (NonNegW.fromNumberUnsafe . fromInteger . NonNegW.toNumber))
      <<<
      PAlsa.sequenceCore
         (Option.channel opt)
         (\ _pgm -> ping 0.8 0.1 (Option.sampleRate opt))


infixr 3 &+&

(&+&) ::
   (Arrow arrow) =>
   arrow a b -> arrow a c -> arrow a (Zip.T b c)
(&+&) = Zip.arrowFanout

controllerExponentialDirect ::
   (Trans.C y, Dim.C v) =>
   Option.T ->
   VoiceMsg.Controller ->
   (DN.T v y, DN.T v y) ->
   DN.T v y ->
   PIO.T PAlsa.Events (Instr.Control (DN.T v y))
controllerExponentialDirect opt ctrl bnds initial =
   PAlsa.slice
      (Check.controller (Option.channel opt) ctrl)
      (MV.controllerExponential bnds)
      initial

keyboardFM :: IO ()
keyboardFM = do
   opt <- Option.get
   arrange <- CausalSt.makeArranger
   amp <-
      CausalP.processIO
         (CausalP.mapSimple StereoInt.interleave <<<
          (CausalPS.amplifyStereo $# 0.2))

   ping <- Instr.pingStereoReleaseFM

   playFromEvents opt $
      arr SigStL.unpackStereoStrict
      <<<
      amp ()
      <<<
      arrange
      <<<
      arr (EventListTT.mapTime
         (NonNegW.fromNumberUnsafe . fromInteger . NonNegW.toNumber))
      <<<
      -- ToDo: fetch parameters from controllers
      PAlsa.sequenceModulated
         (Option.channel opt)
         (\ _pgm -> ping (Option.sampleRate opt))
      <<<
      id &+&
         ((controllerExponentialDirect opt
             Ctrl.attackTime (DN.time 0.25, DN.time 2.5) (DN.time 0.8)
           &+&
           controllerExponentialDirect opt
             Ctrl.releaseTime (DN.time 0.03, DN.time 0.3) (DN.time 0.1))
          &+&
          ((PAlsa.controllerExponential (Option.channel opt) controllerTimbre0 (1/pi,0.01) 0.05
            &+&
            controllerExponentialDirect opt controllerTimbre1
               (DN.time 0.01, DN.time 10)
               (DN.time 5))
           &+&
           ((PAlsa.controllerLinear (Option.channel opt) Ctrl.soundController5 (0,2) 1
             &+&
             controllerExponentialDirect opt Ctrl.soundController7
                (DN.time 0.25, DN.time 2.5)
                (DN.time 0.8))
            &+&
            (PAlsa.controllerLinear (Option.channel opt) controllerDetune (0,0.005) 0.001
             &+&
             PAlsa.bendWheelPressure (Option.channel opt) 2 0.04 0.03))))


controllerExponentialDim ::
   (Arrow arrow,
    Trans.C y, Dim.C v) =>
   VoiceMsg.Controller ->
   (DN.T v y, DN.T v y) ->
   DN.T v y ->
   MCS.T arrow (DN.T v y)
controllerExponentialDim ctrl bnds initial =
   MCS.slice
      (MCS.Controller ctrl)
      (MV.controllerExponential bnds)
      initial

keyboardDetuneFMCore ::
   FilePath ->
   IO (ChannelMsg.Channel -> VoiceMsg.Program ->
       SampleRate Real ->
       PIO.T
          (EventListTT.T Ev.StrictTime [Event.T])
          (SV.Vector StereoVector))
keyboardDetuneFMCore smpDir = do
   arrange <- CausalSt.makeArranger
   amp <-
      CausalP.processIO
         (CausalP.mapSimple StereoInt.interleave <<<
          CausalP.envelopeStereo <<<
          first (CausalP.mapSimple SoV.replicate))

   tine <- Instr.tineStereoFM
   ping <- Instr.pingStereoReleaseFM
   filterSaw <- Instr.filterSawStereoFM
   bellNoise <- Instr.bellNoiseStereoFM

   wind <- Instr.wind
   windPhaser <- Instr.windPhaser
   string <- Instr.softStringShapeFM
   fmString <- Instr.fmStringStereoFM
   arcs <- sequence $
      Instr.cosineStringStereoFM :
      Instr.arcSawStringStereoFM :
      Instr.arcSineStringStereoFM :
      Instr.arcSquareStringStereoFM :
      Instr.arcTriangleStringStereoFM :
      []

   tmt0 <- Instr.makeSampledSounds smpDir InstrP.tomatensalat
   hal0 <- Instr.makeSampledSounds smpDir InstrP.hal
   grp0 <- Instr.makeSampledSounds smpDir InstrP.graphentheorie

   let timeControlPercussive =
          controllerExponentialDim Ctrl.attackTime
             (DN.time 0.1, DN.time 2.5) (DN.time 0.8)
          &+&
          controllerExponentialDim Ctrl.releaseTime
             (DN.time 0.03, DN.time 0.3) (DN.time 0.1)

       timeControlString =
          controllerExponentialDim Ctrl.attackTime
             (DN.time 0.005, DN.time 0.1) (DN.time 0.1)
          &+&
          controllerExponentialDim Ctrl.releaseTime
             (DN.time 0.03, DN.time 0.3) (DN.time 0.2)

       frequencyControlPercussive =
          MCS.controllerLinear controllerDetune (0,0.005) 0.001
          &+&
          MCS.bendWheelPressure 2 0.04 0.03

       frequencyControlString =
          MCS.controllerLinear controllerDetune (0,0.01) 0.005
          &+&
          MCS.bendWheelPressure 2 0.04 0.03

   let tineProc rate vel freq =
          tine rate vel freq
          <<<
          Zip.arrowSecond
             (timeControlPercussive
              &+&
              (((fmap RunP.stair ^<<
                 MCS.controllerLinear controllerTimbre0 (0.5,6.5) 2)
                &+&
                MCS.controllerLinear controllerTimbre1 (0,1.5) 1)
               &+&
               frequencyControlPercussive))

       pingProc rate vel freq =
          ping rate vel freq
          <<<
          Zip.arrowSecond
             (timeControlPercussive
              &+&
              ((MCS.controllerExponential controllerTimbre0 (1/pi,10) 0.05
                &+&
                controllerExponentialDim controllerTimbre1
                    (DN.time 0.01, DN.time 10) (DN.time 5))
               &+&
               ((MCS.controllerLinear Ctrl.soundController5 (0,10) 2
                 &+&
                 controllerExponentialDim Ctrl.soundController7
                    (DN.time 0.03, DN.time 1) (DN.time 0.5))
                &+&
                frequencyControlPercussive)))

       filterSawProc rate vel freq =
          filterSaw rate vel freq
          <<<
          Zip.arrowSecond
             (timeControlPercussive
              &+&
              ((controllerExponentialDim controllerTimbre0
                   (DN.frequency 100, DN.frequency 10000)
                   (DN.frequency 1000)
                &+&
                controllerExponentialDim controllerTimbre1
                   (DN.time 0.1, DN.time 1)
                   (DN.time 0.6))
               &+&
               frequencyControlPercussive))

       bellNoiseProc rate vel freq =
          bellNoise rate vel freq
          <<<
          Zip.arrowSecond
             (timeControlPercussive
              &+&
              ((MCS.controllerLinear controllerTimbre0 (0,1) 0.3
                &+&
                MCS.controllerExponential controllerTimbre1 (1,1000) 100)
               &+&
               frequencyControlPercussive))

       windProc rate vel freq =
          wind rate vel freq
          <<<
          Zip.arrowSecond
             (timeControlString
              &+&
              (MCS.controllerExponential controllerTimbre1 (1,1000) 100
               &+&
               MCS.bendWheelPressure 12 0.8 0))

       windPhaserProc rate vel freq =
          windPhaser rate vel freq
          <<<
          Zip.arrowSecond
             (timeControlString
              &+&
              (MCS.controllerLinear controllerTimbre0 (0,1) 0.5
               &+&
               (controllerExponentialDim controllerDetune
                   (DN.frequency 50, DN.frequency 5000) (DN.frequency 500)
                &+&
                (MCS.controllerExponential controllerTimbre1 (1,1000) 100
                 &+&
                 MCS.bendWheelPressure 12 0.8 0))))

       stringProc rate vel freq =
          string rate vel freq
          <<<
          Zip.arrowSecond
             (timeControlString
              &+&
              (MCS.controllerExponential controllerTimbre0 (1/pi,10) 0.05
               &+&
               frequencyControlString))

       fmStringProc rate vel freq =
          fmString rate vel freq
          <<<
          Zip.arrowSecond
             (timeControlString
              &+&
              ((MCS.controllerLinear controllerTimbre0 (0,0.5) 0.2
                &+&
                MCS.controllerExponential controllerTimbre1 (1/pi,10) 0.05)
               &+&
               frequencyControlString))

       makeArc proc rate vel freq =
          proc rate vel freq
          <<<
          Zip.arrowSecond
             (timeControlString
              &+&
              (MCS.controllerLinear controllerTimbre0 (0.5,9.5) 1.5
               &+&
               frequencyControlString))

       sampled smp rate vel freq =
          smp rate vel freq
          <<<
          Zip.arrowSecond frequencyControlPercussive

       bank =
          Map.fromAscList $ zip [VoiceMsg.toProgram 0 ..] $
          [tineProc, pingProc, filterSawProc, bellNoiseProc,
           stringProc, fmStringProc] ++
          map makeArc arcs ++ windProc : windPhaserProc :
          map sampled (tmt0 ++ hal0 ++ grp0)

   return $ \chan initPgm rate ->
      amp ()
      <<<
      (MCS.controllerExponential controllerVolume (0.001, 1) (0.2::Float)
       <<^ Zip.second)
      &+&
      (arrange
       <<<
       arr (EventListTT.mapTime
          (NonNegW.fromNumberUnsafe . fromInteger . NonNegW.toNumber))
       <<<
       PAlsa.sequenceModulatedMultiProgram chan initPgm
          (\pgm -> Map.findWithDefault pingProc pgm bank rate))
      <<<
      id &+& MCS.fromChannel chan

keyboardDetuneFM :: IO ()
keyboardDetuneFM = do
   opt <- Option.get
   proc <- keyboardDetuneFMCore (Option.sampleDirectory opt)
   playFromEvents opt $
      arr SigStL.unpackStereoStrict
      <<<
      proc (Option.channel opt) (VoiceMsg.toProgram 0) (Option.sampleRate opt)

keyboardMultiChannel :: IO ()
keyboardMultiChannel = do
   opt <- Option.get
   proc <- keyboardDetuneFMCore (Option.sampleDirectory opt)
   mix <-
      CausalP.processIO $
         CausalP.mapSimple StereoInt.interleave <<<
         CausalP.mix <<<
            CausalP.mapSimple StereoInt.deinterleave ***
            CausalP.mapSimple StereoInt.deinterleave

   playFromEvents opt $
      arr SigStL.unpackStereoStrict
      <<<
      foldl1
         (\x y -> mix () <<< Zip.arrowFanout x y)
         (map
             (\chan ->
                proc (ChannelMsg.toChannel chan) (VoiceMsg.toProgram 0)
                     (Option.sampleRate opt))
             [0 .. 3])