MIDI.hs

{- |
Convert MIDI events of a MIDI controller to a control signal.
-}
{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Dimensional.ALSA.MIDI where

import qualified Synthesizer.PiecewiseConstant.ALSA.MIDI as AlsaPC
import qualified Synthesizer.EventList.ALSA.MIDI as AlsaEL
import qualified Synthesizer.Generic.ALSA.MIDI as AlsaG
import Synthesizer.EventList.ALSA.MIDI
          (Channel, Controller, Note(Note), Program, )
import Synthesizer.Generic.ALSA.MIDI (errorNoProgram, )

import qualified Sound.ALSA.Sequencer.Event as Event

import qualified Synthesizer.Dimensional.MIDIValue as DMV
import qualified Synthesizer.MIDIValue as MV
import qualified Sound.MIDI.ALSA.Check as Check

import qualified Synthesizer.Dimensional.Causal.Process    as Causal
import qualified Synthesizer.Dimensional.Causal.Filter     as Filt

import qualified Synthesizer.Dimensional.Rate as Rate
import qualified Synthesizer.Dimensional.Rate.Oscillator as OsciR
import qualified Synthesizer.Dimensional.Signal.Private as SigA
import qualified Synthesizer.Dimensional.Process as Proc
import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Dimensional.Amplitude.Displacement as DispA
import qualified Synthesizer.Dimensional.Amplitude.Filter as FiltA
import qualified Synthesizer.Dimensional.Wave as WaveD
-- import qualified Synthesizer.Dimensional.RateAmplitude.Cut as CutA

import qualified Synthesizer.Basic.Wave          as Wave

import Synthesizer.Dimensional.Causal.Process ((<<<), )
import Synthesizer.Dimensional.Process (($:), )

import qualified Synthesizer.PiecewiseConstant.Signal as PC
import qualified Synthesizer.ChunkySize as ChunkySize

import qualified Synthesizer.Generic.Cut          as CutG
import qualified Synthesizer.Generic.Signal2      as SigG2
import qualified Synthesizer.Generic.Signal       as SigG
import qualified Synthesizer.Storable.Cut         as CutSt
import qualified Synthesizer.Storable.Signal      as SigSt
-- import qualified Data.StorableVector.Lazy.Pattern as SigStV
import qualified Data.StorableVector.Lazy         as SVL

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

import qualified Data.EventList.Relative.TimeBody  as EventList
-- import qualified Data.EventList.Relative.TimeTime  as EventListTT
-- import qualified Data.EventList.Relative.TimeMixed as EventListTM
-- import qualified Data.EventList.Relative.MixedTime as EventListMT
-- import qualified Data.EventList.Relative.BodyTime  as EventListBT

import Foreign.Storable (Storable, )

-- import qualified Algebra.NonNegative as NonNeg
import qualified Number.NonNegative as NonNegW
import qualified Number.NonNegativeChunky as Chunky

-- import qualified Numeric.NonNegative.Class as NonNeg98
-- import qualified Numeric.NonNegative.Wrapper as NonNegW98
import qualified Numeric.NonNegative.Chunky as Chunky98

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

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

import Control.Category (Category, (.), )
import Control.Applicative (Applicative, pure, (<*>), liftA2, )
import Control.Monad.Trans.State (State, evalState, state, gets, )
import Control.Monad (liftM, )

import NumericPrelude.Base hiding (id, (.), )
import NumericPrelude.Numeric
import Prelude (RealFrac, )


type Signal s v y signal =
   AmpSignal s (Amp.Dimensional v y) signal

type AmpSignal s amp signal =
   SigA.T (Rate.Phantom s) amp signal

{- |
This type ensures that all signals generated from the event list
share the same sample rate.
-}
newtype Filter s u t a =
   Filter (AlsaEL.Filter (Proc.T s u t a))

{-# INLINE runFilter #-}
runFilter ::
   EventList.T AlsaEL.StrictTime [Event.T] ->
   Filter s u t a -> Proc.T s u t a
runFilter evs (Filter f) =
   evalState f evs

instance Functor (Filter s u t) where
   fmap f (Filter flt) =
      Filter (fmap (fmap f) flt)

instance Applicative (Filter s u t) where
   pure x = Filter (pure (pure x))
   Filter f <*> Filter x =
      Filter (liftA2 (<*>) f x)


{-# INLINE piecewiseConstant #-}
piecewiseConstant ::
   (SigG.Write sig y) =>
   SigA.T rate amp (AlsaPC.T y) ->
   SigA.T rate amp (sig y)
piecewiseConstant =
   SigA.processBody AlsaG.piecewiseConstant

{-# INLINE controllerLinear #-}
controllerLinear ::
   (Field.C y, Ord y, Dim.C u, Dim.C v) =>
   Channel -> Controller ->
   (DN.T v y, DN.T v y) -> DN.T v y ->
   Filter s u t (Signal s v y (AlsaPC.T y))
controllerLinear chan ctrl bnd initial =
   Filter $
   liftM
      (let amp = max initial (uncurry max bnd)
       in  return . SigA.fromBody amp .
           AlsaPC.initWith
              (DMV.controllerLinear amp bnd) (DN.divToScalar initial amp)) $
   AlsaEL.getControllerEvents chan ctrl


{-# INLINE controllerExponential #-}
controllerExponential ::
   (Trans.C y, Ord y, Dim.C u, Dim.C v) =>
   Channel -> Controller ->
   (DN.T v y, DN.T v y) -> DN.T v y ->
   Filter s u t (Signal s v y (AlsaPC.T y))
controllerExponential chan ctrl bnd initial =
   Filter $
   liftM
      (let amp = max initial (uncurry max bnd)
       in  return . SigA.fromBody amp .
           AlsaPC.initWith
              (DMV.controllerExponential amp bnd) (DN.divToScalar initial amp)) $
   AlsaEL.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, Ord y, Dim.C u, Dim.C v) =>
   Channel ->
   y -> DN.T v y ->
   Filter s u t (Signal s v y (AlsaPC.T y))
pitchBend chan range center =
   Filter $
   liftM
      (let amp = DN.scale (max range (recip range)) center
       in  return . SigA.fromBody amp .
           AlsaPC.initWith
              (DMV.pitchBend amp range center) (DN.divToScalar center amp)) $
   AlsaEL.getSlice (Check.pitchBend chan)
--   AlsaEL.getPitchBendEvents chan


{-# INLINE channelPressure #-}
channelPressure ::
   (Trans.C y, Ord y, Dim.C u, Dim.C v) =>
   Channel ->
   DN.T v y -> DN.T v y ->
   Filter s u t (Signal s v y (AlsaPC.T y))
channelPressure chan maxVal initVal =
   Filter $
   liftM
      (return . SigA.fromBody maxVal .
       AlsaPC.initWith
          (DMV.controllerLinear maxVal (zero,maxVal))
          (DN.divToScalar initVal maxVal)) $
   AlsaEL.getSlice (Check.channelPressure chan)
--   AlsaEL.getPitchBendEvents chan


{-# INLINE bendWheelPressure #-}
bendWheelPressure ::
   (SigG.Write sig q, SigG2.Transform sig q q,
    RealField.C q, Trans.C q, Module.C q q, Dim.C u) =>
   Channel ->
   Int -> DN.T (Dim.Recip u) q -> q -> q ->
   Filter s u q (Signal s Dim.Scalar q (sig q))
bendWheelPressure chan
     pitchRange speed wheelDepth pressDepth =
   pure
      (\bend fm press  osci env ->
         let modu =
                DispA.raise 1 $
                FiltA.envelope
                   osci
                   (DispA.mix
                      (SigA.restore fm)
                      (SigA.restore press))

         in  Causal.apply
                (env <<< Causal.feedSnd modu <<< Causal.canonicalizeFlat)
                (piecewiseConstant bend))

    $: pitchBend chan (2^?(fromIntegral pitchRange/12)) (DN.scalar 1)
    $: controllerLinear chan VoiceMsg.modulation (zero, DN.scalar wheelDepth) zero
    $: channelPressure chan (DN.scalar pressDepth) 0

    $: Filter (return $ OsciR.static (WaveD.flat Wave.sine) zero speed)
    $: Filter (return $ Filt.envelope)


type LazyTime s = SigA.T (Rate.Phantom s) Amp.Abstract ChunkySize.T
-- type LazyTime s = SigA.T (Rate.Phantom s) Amp.Abstract SigStV.LazySize
-- type LazyTime s = SigA.T (Rate.Phantom s) Amp.Abstract AlsaEL.LazyTime

type Instrument s u v q signal =
   ModulatedInstrument s u q (Signal s v q signal)

type ModulatedInstrument s u q signal =
   q -> DN.T (Dim.Recip u) q ->
   Proc.T s u q (LazyTime s -> signal)

type Bank s u q signal =
   Program -> ModulatedInstrument s u q signal


{-# INLINE chunkySizeFromLazyTime #-}
chunkySizeFromLazyTime :: AlsaEL.LazyTime -> ChunkySize.T
chunkySizeFromLazyTime =
   Chunky.fromChunks .
   map (SigG.LazySize . NonNegW.toNumber) .
   concatMap PC.chopLongTime .
   Chunky98.toChunks .
   Chunky98.normalize


{-# INLINE renderInstrument #-}
renderInstrument ::
   (Trans.C q) =>
   Bank s Dim.Time q signal ->
   Note ->
   Proc.T s Dim.Time q signal
renderInstrument instrument (Note pgm pitch vel dur) =
   fmap ($ SigA.abstractFromBody $ chunkySizeFromLazyTime dur) $
   instrument pgm
      (MV.velocity vel)
      (DMV.frequencyFromPitch pitch)

{- |
Instrument parameters are:
velocity from -1 to 1
(0 is the normal pressure, no pressure aka NoteOff is not supported),
frequency is given in Hertz
-}
{-# INLINE makeInstrumentSounds #-}
makeInstrumentSounds ::
   (Trans.C q) =>
   Bank s Dim.Time q signal ->
   EventList.T time [Note] ->
   Proc.T s Dim.Time q (EventList.T time [signal])
makeInstrumentSounds bank =
   EventList.mapBodyM (mapM (renderInstrument bank))


{-# INLINE sequence #-}
sequence ::
   (RealFrac q, Storable y, Module.C q y, Trans.C q, Dim.C v) =>
   SVL.ChunkSize ->
   DN.T v q ->
   Channel ->
   Instrument s Dim.Time v q (SigSt.T y) ->
   Filter s Dim.Time q (Signal s v q (SigSt.T y))
sequence chunkSize amp chan instr =
   fmap (renderSequence chunkSize amp) $
   prepareTones chan errorNoProgram (const instr)

{-
{-# INLINE sequence #-}
sequence ::
   (RealFrac q, Storable y, Module.C q y, Trans.C q, Dim.C v) =>
   SVL.ChunkSize ->
   DN.T v q ->
   Channel ->
   Instrument s Dim.Time v q y ->
   Filter (Proc.T s Dim.Time q (Signal s v q (SigSt.T y)))
sequence chunkSize amp chan instr =
   fmap ((CutA.arrangeStorableVolume undefined  {- chunkSize -} amp undefined $:) .
         fmap
            (EventListTM.switchTimeR const .
             EventListTT.mapTime fromIntegral .
             AlsaSt.insertBreaksGen (SigA.fromBody amp SigSt.empty)) .
         makeInstrumentSounds instr .
         AlsaEL.matchNoteEvents) $
   AlsaEL.getNoteEvents chan
-}


{-# INLINE sequenceModulated #-}
sequenceModulated ::
   (CutG.Transform ctrl,  CutG.NormalForm ctrl,
    RealFrac q, Storable y,
    Module.C q y, Trans.C q, Dim.C v) =>
   SVL.ChunkSize ->
   DN.T v q ->
   Channel ->
   ModulatedInstrument s Dim.Time q
      (AmpSignal s amp ctrl -> Signal s v q (SigSt.T y)) ->
   Filter s Dim.Time q
      (AmpSignal s amp ctrl -> Signal s v q (SigSt.T y))
sequenceModulated chunkSize amp chan instr =
   fmap (flip $ \ctrl ->
      renderSequence chunkSize amp .
      applyModulator (applyModulation ctrl)) $
   prepareTones chan errorNoProgram (const instr)

{-# INLINE sequenceModulated2 #-}
sequenceModulated2 ::
   (CutG.Transform ctrl0, CutG.NormalForm ctrl0,
    CutG.Transform ctrl1, CutG.NormalForm ctrl1,
    RealFrac q, Storable y,
    Module.C q y, Trans.C q, Dim.C v) =>
   SVL.ChunkSize ->
   DN.T v q ->
   Channel ->
   ModulatedInstrument s Dim.Time q
      (AmpSignal s amp0 ctrl0 -> AmpSignal s amp1 ctrl1 -> Signal s v q (SigSt.T y)) ->
   Filter s Dim.Time q
      (AmpSignal s amp0 ctrl0 -> AmpSignal s amp1 ctrl1 -> Signal s v q (SigSt.T y))
sequenceModulated2 chunkSize amp chan instr =
   fmap (\evs ctrl0 ctrl1 ->
      renderSequence chunkSize amp .
      applyModulator
         (applyModulation ctrl1 .
          applyModulation ctrl0)
      $ evs) $
   prepareTones chan errorNoProgram (const instr)


{-# INLINE sequenceMultiModulated #-}
sequenceMultiModulated ::
   (RealFrac q, Storable y,
    Module.C q y, Trans.C q, Dim.C v) =>
   SVL.ChunkSize ->
   DN.T v q ->
   Channel ->
   ModulatedInstrument s Dim.Time q instrument ->
   Filter s Dim.Time q
      (AlsaG.Modulator instrument (Signal s v q (SigSt.T y))) ->
   Filter s Dim.Time q (Signal s v q (SigSt.T y))
sequenceMultiModulated chunkSize amp chan instr modu =
   fmap (renderSequence chunkSize amp) $
   (fmap applyModulator modu $:
    prepareTones chan errorNoProgram (const instr))

{-# INLINE prepareTones #-}
prepareTones ::
   (RealFrac q, Trans.C q) =>
   -- ToDo: use time value
   Channel ->
   Program ->
   Bank s Dim.Time q signal ->
   Filter s Dim.Time q (EventList.T AlsaEL.StrictTime [signal])
prepareTones chan initPgm instr =
   Filter $
   fmap (makeInstrumentSounds instr .
         AlsaEL.matchNoteEvents .
         AlsaEL.embedPrograms initPgm) $
   AlsaEL.getNoteEvents chan

{-# INLINE applyModulation #-}
applyModulation ::
   (CutG.Transform signal, CutG.NormalForm signal) =>
   AmpSignal s amp signal ->
   AlsaG.Modulator (AmpSignal s amp signal -> body) body
applyModulation ctrl =
   AlsaG.Modulator ctrl advanceModulationChunk gets

{-# INLINE applyModulator #-}
applyModulator ::
   AlsaG.Modulator a b ->
   EventList.T AlsaEL.StrictTime [a] ->
   EventList.T AlsaEL.StrictTime [b]
applyModulator =
   AlsaG.applyModulator

{-# INLINE renderSequence #-}
renderSequence ::
   (Storable y, Module.C q y, Dim.C u, Field.C q) =>
   SVL.ChunkSize ->
   DN.T u q ->
   EventList.T AlsaEL.StrictTime [Signal s u q (SigSt.T y)] ->
   Signal s u q (SigSt.T y)
renderSequence chunkSize amp =
   SigA.fromBody amp .
   CutSt.arrangeEquidist chunkSize .
   {- This concatenates times across empty events,
      and thus is too strict.
   EventList.flatten .
   -}
   AlsaG.flatten .
   EventList.mapTime fromIntegral .
   EventList.mapBody (map (SigA.vectorSamples (flip DN.divToScalar amp)))


{-# INLINE advanceModulationChunky #-}
advanceModulationChunky ::
   (CutG.Transform signal, CutG.NormalForm signal) =>
   AlsaEL.LazyTime -> State (AmpSignal s amp signal) AlsaEL.LazyTime
advanceModulationChunky =
   liftM Chunky98.fromChunks .
   mapM advanceModulationChunk .
   Chunky98.toChunks

{-# INLINE advanceModulationChunk #-}
advanceModulationChunk ::
   (CutG.Transform signal, CutG.NormalForm signal) =>
   AlsaEL.StrictTime -> State (AmpSignal s amp signal) AlsaEL.StrictTime
advanceModulationChunk t = state $ \xs ->
   let ys = SigA.processBody (CutG.drop (fromIntegral t)) xs
   in  (AlsaG.evaluateVectorHead (SigA.body ys) t, ys)


{-# INLINE sequenceMultiProgram #-}
sequenceMultiProgram ::
   (RealFrac q, Storable y, Module.C q y, Trans.C q, Dim.C v) =>
   SVL.ChunkSize ->
   DN.T v q ->
   Channel ->
   Program ->
--   Bank s Dim.Time q (Signal s v q (SigSt.T y)) ->
   [Instrument s Dim.Time v q (SigSt.T y)] ->
   Filter s Dim.Time q (Signal s v q (SigSt.T y))
sequenceMultiProgram chunkSize amp chan initPgm instrs =
   let bank = AlsaEL.makeInstrumentArray instrs
   in  fmap (renderSequence chunkSize amp) $
       prepareTones chan initPgm $
       AlsaEL.getInstrumentFromArray bank initPgm