{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{- |
Convert MIDI events of a MIDI controller to a control signal.
-}
module Synthesizer.LLVM.ALSA.MIDI (
   module Synthesizer.LLVM.ALSA.MIDI,
   Gen.applyModulation,
   PC.BendModulation(PC.BendModulation),
   ) where

import Synthesizer.EventList.ALSA.MIDI
          (Program, Channel, Filter, Note,
           {-
           LazyTime, Controller,
           getControllerEvents, getSlice,
           maybePitchBend, maybeChannelPressure,
           -} )
import qualified Synthesizer.Generic.ALSA.MIDI as Gen
import qualified Synthesizer.PiecewiseConstant.ALSA.MIDI as PC
-- import qualified Synthesizer.MIDIValue as MV
import Synthesizer.LLVM.ALSA.BendModulation ()

import Synthesizer.LLVM.CausalParameterized.Process (($>), )
-- import Synthesizer.LLVM.Parameterized.Signal (($#), )
import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS
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.Parameter as Param
import qualified Synthesizer.LLVM.Wave as Wave
import qualified Synthesizer.LLVM.Sample as Sample

import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Vector as Vector
import qualified LLVM.Extra.Representation as Rep
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Core as LLVM

import qualified Data.TypeLevel.Num as TypeNum

import qualified Synthesizer.Generic.Cut        as CutG

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

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

import qualified Data.EventList.Relative.TimeTime  as EventListTT
import qualified Data.EventList.Relative.MixedTime as EventListMT
import qualified Data.EventList.Relative.BodyTime  as EventListBT
-}

import Foreign.Storable (Storable, )

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

import qualified Algebra.Transcendental as Trans
import qualified Algebra.RealField      as RealField
-- import qualified Algebra.Field          as Field
import qualified Algebra.Ring           as Ring
import qualified Algebra.Additive       as Additive

import Control.Arrow (second, (<<<), (<<^), )
import Control.Monad ({- liftM, -} liftM2, )

-- import NumericPrelude.Base
import NumericPrelude.Numeric
import Prelude ()


{-
{-# INLINE piecewiseConstantInit #-}
piecewiseConstantInit ::
   (Storable y, LLVM.MakeValueTuple y yl,
    Rep.Memory yl ym, LLVM.IsSized ym ys) =>
   y -> EventListTT.T LazyTime y -> SigP.T p yl
piecewiseConstantInit initial evs =
   SigP.piecewiseConstant $#
   (PC.subdivideInt $
    EventListMT.consBody initial evs)


{-# INLINE controllerLinear #-}
controllerLinear ::
   (Field.C y, Storable y, LLVM.MakeValueTuple y yl,
    Rep.Memory yl ym, LLVM.IsSized ym ys) =>
   Channel -> Controller ->
   (y,y) -> y ->
   Filter (SigP.T p yl)
controllerLinear chan ctrl bnd initial =
   liftM (piecewiseConstantInit initial .
          EventListTT.mapBody (MV.controllerLinear bnd)) $
   getControllerEvents chan ctrl


{-# INLINE controllerExponential #-}
controllerExponential ::
   (Trans.C y, Storable y, LLVM.MakeValueTuple y yl,
    Rep.Memory yl ym, LLVM.IsSized ym ys) =>
   Channel -> Controller ->
   (y,y) -> y ->
   Filter (SigP.T p yl)
controllerExponential chan ctrl bnd initial =
   liftM (piecewiseConstantInit initial .
          EventListTT.mapBody (MV.controllerExponential bnd)) $
   getControllerEvents chan ctrl


{- |
@pitchBend channel range center@:
emits frequencies on an exponential scale from
@center/range@ to @center*range@.
-}
{-# INLINE pitchBend #-}
pitchBend ::
   (Trans.C y, Storable y, LLVM.MakeValueTuple y yl,
    Rep.Memory yl ym, LLVM.IsSized ym ys) =>
   Channel ->
   y -> y ->
   Filter (SigP.T p yl)
pitchBend chan range center =
   liftM (piecewiseConstantInit center .
          EventListTT.mapBody (MV.pitchBend range center)) $
   getSlice (maybePitchBend chan)
--   getPitchBendEvents chan

{-# INLINE channelPressure #-}
channelPressure ::
   (Trans.C y, Storable y, LLVM.MakeValueTuple y yl,
    Rep.Memory yl ym, LLVM.IsSized ym ys) =>
   Channel ->
   y -> y ->
   Filter (SigP.T p yl)
channelPressure chan maxVal initVal =
   liftM (piecewiseConstantInit initVal .
          EventListTT.mapBody (MV.controllerLinear (0,maxVal))) $
   getSlice (maybeChannelPressure chan)


{-# INLINE bendWheelPressure #-}
bendWheelPressure ::
   (Ring.C a, LLVM.IsConst a,
    RealField.C y, Trans.C y,
    LLVM.IsConst y, SoV.Fraction y, SoV.Replicate a y,
    Storable y, LLVM.MakeValueTuple y (LLVM.Value y), LLVM.IsSized y ys) =>
   Channel ->
   Int -> y -> y -> y ->
   Filter (SigP.T p (LLVM.Value y))
bendWheelPressure chan
     pitchRange speed wheelDepth pressDepth =
   do bend  <- pitchBend chan
                  (2^?(fromIntegral pitchRange/12) `asTypeOf` speed) 1
      fm    <- controllerLinear chan VoiceMsg.modulation (0,wheelDepth) 0
      press <- channelPressure chan pressDepth 0
      return $
         SigP.envelope bend $
         SigP.mapSimple (A.add (LLVM.valueOf 1)) $
         SigP.envelope
            (SigP.mix fm press)
            (SigP.osciSimple Wave.approxSine2 zero $# speed)
-}


frequencyFromBendModulation ::
   (Ring.C a, LLVM.IsConst a,
    Ring.C y, Additive.C y, LLVM.IsConst y, LLVM.IsSized y size,
    Storable y, LLVM.MakeValueTuple y (LLVM.Value y),
    SoV.Fraction y, SoV.Replicate a y) =>
   Param.T p y ->
   CausalP.T p (PC.BendModulation (LLVM.Value y)) (LLVM.Value y)
frequencyFromBendModulation speed =
   CausalP.envelope
   <<<
   second
      (CausalP.mapSimple (A.add (SoV.replicateOf 1)) <<< CausalP.envelope
         $> SigP.osciSimple Wave.approxSine2 zero speed)
   <<^
   (\(PC.BendModulation b m) -> (b,m))


frequencyFromBendModulationPacked ::
   (RealField.C a, LLVM.IsConst a, LLVM.IsFloating a,
    Storable a, LLVM.MakeValueTuple a (LLVM.Value a), LLVM.IsSized a size,
    Vector.Real a, SoV.Replicate a (LLVM.Vector n a), LLVM.IsPowerOf2 n,
    TypeNum.Mul n size vsize, TypeNum.Pos vsize) =>
   Param.T p a ->
   CausalP.T p
      (PC.BendModulation (LLVM.Value a))
      (LLVM.Value (LLVM.Vector n a))
frequencyFromBendModulationPacked speed =
   CausalP.envelope
   <<<
   second
      (CausalP.mapSimple (A.add (SoV.replicateOf 1)) <<< CausalP.envelope
         $> SigPS.osciSimple Wave.approxSine2 zero speed)
   <<<
   CausalP.mapSimple
      (\(PC.BendModulation b m) ->
         liftM2 (,) (SoV.replicate b) (SoV.replicate m))



type Instrument y yv = Gen.Instrument y (SigSt.T yv)
type Bank y yv = Gen.Bank y (SigSt.T yv)


{-# INLINE sequenceCore #-}
sequenceCore ::
   (Storable yv, Sample.Additive value,
    LLVM.MakeValueTuple yv value, Rep.Memory value struct) =>
   SigSt.ChunkSize ->
   Channel ->
   Program ->
   Gen.Modulator Note (SigSt.T yv) ->
   Filter (SigSt.T yv)
sequenceCore chunkSize =
   Gen.sequenceCore (SigStL.arrange chunkSize)


{-# INLINE sequence #-}
sequence ::
   (Storable yv, Trans.C y, Sample.Additive value,
    LLVM.MakeValueTuple yv value, Rep.Memory value struct) =>
   SigSt.ChunkSize ->
   Channel ->
   Instrument y yv ->
   Filter (SigSt.T yv)
sequence chunkSize =
   Gen.sequence (SigStL.arrange chunkSize)


{-# INLINE sequenceModulated #-}
sequenceModulated ::
   (CutG.Transform ctrl, CutG.NormalForm ctrl,
    Storable yv, Trans.C y, Sample.Additive value,
    LLVM.MakeValueTuple yv value, Rep.Memory value struct) =>
   SigSt.ChunkSize ->
   ctrl ->
   Channel ->
   (ctrl -> Instrument y yv) ->
   Filter (SigSt.T yv)
sequenceModulated chunkSize =
   Gen.sequenceModulated (SigStL.arrange chunkSize)


{-# INLINE sequenceMultiModulated #-}
sequenceMultiModulated ::
   (Storable yv, Trans.C y, Sample.Additive value,
    LLVM.MakeValueTuple yv value, Rep.Memory value struct) =>
   SigSt.ChunkSize ->
   Channel ->
   instrument ->
   Gen.Modulator (instrument, Note) (Instrument y yv, Note) ->
   Filter (SigSt.T yv)
sequenceMultiModulated chunkSize =
   Gen.sequenceMultiModulated (SigStL.arrange chunkSize)


{-# INLINE sequenceMultiProgram #-}
sequenceMultiProgram ::
   (Storable yv, Trans.C y, Sample.Additive value,
    LLVM.MakeValueTuple yv value, Rep.Memory value struct) =>
   SigSt.ChunkSize ->
   Channel ->
   Program ->
   [Instrument y yv] ->
   Filter (SigSt.T yv)
sequenceMultiProgram chunkSize =
   Gen.sequenceMultiProgram (SigStL.arrange chunkSize)


{-# INLINE sequenceModulatedMultiProgram #-}
sequenceModulatedMultiProgram ::
   (CutG.Transform ctrl, CutG.NormalForm ctrl,
    Storable yv, Trans.C y, Sample.Additive value,
    LLVM.MakeValueTuple yv value, Rep.Memory value struct) =>
   SigSt.ChunkSize ->
   ctrl ->
   Channel ->
   Program ->
   [ctrl -> Instrument y yv] ->
   Filter (SigSt.T yv)
sequenceModulatedMultiProgram chunkSize =
   Gen.sequenceModulatedMultiProgram (SigStL.arrange chunkSize)