Signal.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{- |

Copyright   :  (c) Henning Thielemann 2006
License     :  GPL

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes



This module provides processors like that in "UniqueLogicNP.Explicit.Process"
but is specialized to signals.

Signal processors which modify a signal have a signature
   @SigI.T a q v -> SigI.Process a q v@ .

This let you easily share the result of a computation.
@
do
   x <- generator
   proc x x
@
However you have to write everything with @do@ notation,
and you have to invent variable names,
or you use monadic composition '=<<' instead of '.'
and the 'Inference.MonadUtility.liftP' functions.

For a more functional style of processor composition see "Synthesizer.Inference.Monad.SignalSeq".
-}
module Synthesizer.Inference.Monad.Signal where

import qualified UniqueLogicNP.Explicit.Process    as ProcI
import qualified UniqueLogicNP.Explicit.Expression as Expr
import qualified UniqueLogicNP.Explicit.System     as IS

import UniqueLogicNP.Explicit.Process (Expr, Atom, )

import qualified Synthesizer.Physical.Signal as SigP

import qualified Algebra.OccasionallyScalar as OccScalar
import qualified Algebra.Module         as Module
import qualified Algebra.Field          as Field
import qualified Algebra.Ring           as Ring

import Algebra.OccasionallyScalar (toScalar)

import Control.Monad.Fix (mfix)
import Control.Monad.Trans.RWS (evalRWS)

import NumericPrelude
import PreludeBase as P


type T       a q v = SigP.T a (Atom q) a (Atom q) v
type Process a q v = ProcI.T q (T a q v)

run :: (Eq q) =>
   Process a q v -> SigP.T a q a q v
run proc =
   let (sig, rules) =
              evalRWS proc dict 0
       dict = IS.resolve rules
       rate = IS.getValue dict (SigP.sampleRate sig)
       amp  = IS.getValue dict (SigP.amplitude  sig)
       ss   = SigP.samples    sig
   in  SigP.cons rate amp ss

returnCons :: Monad m =>
   t' -> y' -> [yv] -> m (SigP.T t t' y y' yv)
returnCons sr amp sig = return $ SigP.cons sr amp sig

sampleRateExpr :: SigP.T t (Atom t') y (Atom y') yv -> Expr t'
sampleRateExpr x = Expr.fromAtom (SigP.sampleRate x)

amplitudeExpr :: SigP.T t (Atom t') y (Atom y') yv -> Expr y'
amplitudeExpr x = Expr.fromAtom (SigP.amplitude x)


{- |
This and the following function are quite the same as in "Synthesizer.Physical.Signal".
-}
toTimeScalar :: (Field.C t', OccScalar.C t t') =>
   SigP.T t (Atom t') y (Atom y') yv -> Expr t' -> ProcI.T t' t
toTimeScalar x t =
   do s <- ProcI.fromExpr (t * sampleRateExpr x)
      v <- ProcI.getValue s
      return (toScalar v `SigP.asTypeOfTime` x)

toFrequencyScalar :: (Field.C t', OccScalar.C t t') =>
   SigP.T t (Atom t') y (Atom y') yv -> Expr t' -> ProcI.T t' t
toFrequencyScalar x f =
   do s <- ProcI.fromExpr (f / sampleRateExpr x)
      v <- ProcI.getValue s
      return (toScalar v `SigP.asTypeOfTime` x)

toAmplitudeScalar :: (Field.C y', OccScalar.C y y') =>
   SigP.T t (Atom t') y (Atom y') yv -> Expr y' -> ProcI.T y' y
toAmplitudeScalar x y =
   do s <- ProcI.fromExpr (y / amplitudeExpr x)
      v <- ProcI.getValue s
      return (toScalar v `SigP.asTypeOfAmplitude` x)

toGradientScalar :: (Field.C q, OccScalar.C a q) =>
   T a q v -> Expr q -> ProcI.T q a
toGradientScalar x steepness =
   toFrequencyScalar x (steepness / amplitudeExpr x)


vectorSamples :: (Module.C a v) =>
   (Expr q -> ProcI.T q a) -> T a q v -> ProcI.T q [v]
vectorSamples toAmpScalar sig =
   do y <- toAmpScalar (amplitudeExpr sig)
      return (y *> SigP.samples sig)

scalarSamples :: (Ring.C a) =>
   (Expr q -> ProcI.T q a) -> T a q a -> ProcI.T q [a]
scalarSamples toAmpScalar sig =
   do y <- toAmpScalar (amplitudeExpr sig)
      return (map (y*) (SigP.samples sig))


{- |
  A complex signal graph can be built without ever mentioning a sampling rate.
  However when it comes to playing or writing a file,
  we must determine the sampling rate eventually.
  This function simply passes a signal through
  while forcing it to the given sampling rate.
-}
fixSampleRate :: (Eq q) =>
      q          {-^ sample rate -}
   -> T a q v    {-^ passed through signal -}
   -> Process a q v
fixSampleRate sampleRate x =
   do ProcI.equalValue (IS.constant sampleRate) (SigP.sampleRate x)
      return x

{- | Create a loop (feedback) from one node to another one.
     That is, compute the fix point of a process iteration. -}
loop :: (Eq q) =>
      (T a q v -> Process a q v) {-^ process chain that shall be looped -}
   -> Process a q v
loop f = mfix (\signalIn ->
   do sampleRateIn <- ProcI.newVariable
      amplitudeIn  <- ProcI.newVariable
      signalOut <- f (SigP.cons sampleRateIn amplitudeIn
                                (SigP.samples signalIn))
      ProcI.equalValue sampleRateIn (SigP.sampleRate signalOut)
      ProcI.equalValue amplitudeIn  (SigP.amplitude  signalOut)
      return signalOut)