module Synthesizer.LLVM.Server.CausalPacked.Run where

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

import qualified Synthesizer.LLVM.Server.CausalPacked.Instrument as Instr
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.Storable.Process as CausalSt

import qualified Synthesizer.LLVM.CausalParameterized.ProcessPacked as CausalPS
import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
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 Sound.MIDI.Message.Channel.Voice as VoiceMsg

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 Numeric.NonNegative.Class   as NonNeg
import qualified Numeric.NonNegative.Chunky  as NonNegChunky
-}
import qualified Numeric.NonNegative.Wrapper as NonNegW

import qualified Algebra.Additive as Additive

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

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 0.5 1.0 (Option.sampleRate opt))
      <<<
      id &+&
         ((PAlsa.controllerExponential (Option.channel opt)
             Ctrl.attackTime (0.25,2.5) 0.8
           &+&
           PAlsa.controllerExponential (Option.channel opt)
             Ctrl.releaseTime (0.03,0.3) 0.1)
          &+&
          ((PAlsa.controllerLinear (Option.channel opt)
               controllerDetune (0,0.005) 0.001
            &+&
            PAlsa.bendWheelPressure (Option.channel opt) 2 0.04 0.03)
           &+&
           PAlsa.controllerExponential
              (Option.channel opt) controllerTimbre0 (0.3,0.001) 0.05))

keyboardFMMulti :: IO ()
keyboardFMMulti = do
   opt <- Option.get
   arrange <- CausalSt.makeArranger
   amp <-
      CausalP.processIO
         (CausalP.mapSimple StereoInt.interleave <<<
          CausalP.envelopeStereo <<<
          first (CausalP.mapSimple SoV.replicate))

   ping <- Instr.pingStereoReleaseFM

   let pingProc phase phaseDecay vel freq =
          ping phase phaseDecay (Option.sampleRate opt) vel freq
          <<<
          Zip.arrowSecond
             ((MCS.controllerExponential Ctrl.attackTime (0.25,2.5) 0.8
               &+&
               MCS.controllerExponential Ctrl.releaseTime (0.03,0.3) 0.1)
              &+&
              ((MCS.controllerLinear controllerDetune (0,0.005) 0.001
                &+&
                MCS.bendWheelPressure 2 0.04 0.03)
               &+&
               MCS.controllerExponential controllerTimbre0 (0.3,0.003) 0.05))
       bank =
          Map.fromAscList $ zip [VoiceMsg.toProgram 0 ..] $
          [pingProc 0.5 1.0, pingProc 2.0 0.1]

   playFromEvents opt $
      arr SigStL.unpackStereoStrict
      <<<
      amp ()
      <<<
      (MCS.controllerExponential controllerVolume (0.001, 1) (0.2::Float)
       <<^ Zip.second)
      &+&
      (arrange
       <<<
       arr (EventListTT.mapTime
          (NonNegW.fromNumberUnsafe . fromInteger . NonNegW.toNumber))
       <<<
       PAlsa.sequenceModulated
          (Option.channel opt)
          (\pgm -> Map.findWithDefault (pingProc 0.5 1.0) pgm bank))
      <<<
      id &+& MCS.fromChannel (Option.channel opt)