synthesizer-inference-0.2: src/Synthesizer/Inference/Reader/Signal.hs

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

Copyright   :  (c) Henning Thielemann 2007
License     :  GPL

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes (OccasionallyScalar)
-}
module Synthesizer.Inference.Reader.Signal (
    T(..),
    run,
    addSampleRate,
    apply,
    lift,
    returnCons,

    toTimeScalar,
    toFrequencyScalar,
    toAmplitudeScalar,
    toGradientScalar,

    scalarSamples,
    vectorSamples,

    ($-),
    constant,
   ) where

import Synthesizer.Inference.Reader.Process (($:))
import qualified Synthesizer.Inference.Reader.Process as Proc

import qualified Synthesizer.SampleRateContext.Rate   as Rate
import qualified Synthesizer.SampleRateContext.Signal as SigC
import qualified Synthesizer.Physical.Signal as SigP

import Synthesizer.SampleRateContext.Signal (T(Cons, samples, amplitude))

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 NumericPrelude
import PreludeBase as P



run ::
   t' -> Proc.T t t' (T y y' yv) -> SigP.T t t' y y' yv
run sr proc =
   uncurry addSampleRate (Proc.run sr proc)

{-
run ::
   Rate.T t t' -> Proc.T t t' (T y y' yv) -> SigP.T t t' y y' yv
run sr proc =
   uncurry addSampleRate (Proc.run (Rate.toNumber sr) proc)
-}

addSampleRate ::
   t' -> T y y' yv -> SigP.T t t' y y' yv
addSampleRate = SigP.addPlainSampleRate

apply ::
   (Proc.T t t' (T y0 y0' y0v -> T y1 y1' y1v))
    -> SigP.T t t' y0 y0' y0v
    -> SigP.T t t' y1 y1' y1v
apply proc (SigP.Cons sr sig) =
   let (sr', f) = Proc.run (Rate.toNumber sr) proc
   in  addSampleRate sr' (f sig)


lift :: (Rate.T t t' -> a) -> Proc.T t t' a
lift f = Proc.Cons $ f . Rate.fromNumber


returnCons ::
   y' -> [yv] -> Proc.T t t' (T y y' yv)
returnCons amp sig = Proc.pure (Cons amp sig)

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

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

toTimeScalar :: (Ring.C t', OccScalar.C t t') =>
   t' -> t' -> t
toTimeScalar sampleRate t = toScalar (t * sampleRate)

toFrequencyScalar :: (Field.C t', OccScalar.C t t') =>
   t' -> t' -> t
toFrequencyScalar sampleRate f = toScalar (f / sampleRate)

toAmplitudeScalar :: (Field.C y', OccScalar.C y y') =>
   T y y' yv -> y' -> y
toAmplitudeScalar sig y =
   toScalar (y / amplitude sig)

toGradientScalar :: (Field.C q', OccScalar.C q q') =>
   q' -> q' -> q' -> q
toGradientScalar amp sampleRate steepness =
   toFrequencyScalar sampleRate (steepness / amp)


scalarSamples :: (Ring.C y) =>
   (y' -> y) -> T y y' y -> [y]
scalarSamples toAmpScalar sig =
   let y = toAmpScalar (amplitude sig)
   in  map (y*) (samples sig)

vectorSamples :: (Module.C y yv) =>
   (y' -> y) -> T y y' yv -> [yv]
vectorSamples toAmpScalar sig =
   let y = toAmpScalar (amplitude sig)
   in  y *> samples sig


{- |
Take a scalar argument where a process expects a signal.
-}
($-) :: Ring.C yv =>
    Proc.T t t' (T y y' yv -> a) -> y' -> Proc.T t t' a
($-) f x = f $: Proc.pure (constant x)

{-
Should be in Control module.
-}
constant :: Ring.C yv => y' -> T y y' yv
constant x = Cons x (repeat 1)