{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Interpolation.Module (
   T,
   constant,
   linear,
   cubic,
   cubicAlt,
   piecewise,
   piecewiseConstant,
   piecewiseLinear,
   piecewiseCubic,
   function,
   ) where
import qualified Synthesizer.State.Signal  as Sig
import qualified Synthesizer.Plain.Control as Ctrl
import qualified Synthesizer.Interpolation.Core as Core
import Synthesizer.Interpolation (
   T, cons, getNode, fromPrefixReader,
   constant,
   )
import qualified Algebra.Module    as Module
import qualified Algebra.Field     as Field
import qualified Control.Applicative.HT as App
import NumericPrelude.Numeric
import NumericPrelude.Base
{-# INLINE linear #-}
linear :: (Module.C t y) => T t y
linear =
   fromPrefixReader "linear" 0
      (App.lift2 Core.linear getNode getNode)
{-# INLINE cubic #-}
cubic :: (Field.C t, Module.C t y) => T t y
cubic =
   fromPrefixReader "cubic" 1
      (App.lift4 Core.cubic getNode getNode getNode getNode)
{-# INLINE cubicAlt #-}
cubicAlt :: (Field.C t, Module.C t y) => T t y
cubicAlt =
   fromPrefixReader "cubicAlt" 1
      (App.lift4 Core.cubicAlt getNode getNode getNode getNode)
{-# INLINE piecewise #-}
piecewise :: (Module.C t y) =>
   Int -> [t -> t] -> T t y
piecewise center ps =
   cons (length ps) (center-1)
      (\t -> Sig.linearComb (Sig.fromList (map ($t) (reverse ps))))
{-# INLINE piecewiseConstant #-}
piecewiseConstant :: (Module.C t y) => T t y
piecewiseConstant =
   piecewise 1 [const 1]
{-# INLINE piecewiseLinear #-}
piecewiseLinear :: (Module.C t y) => T t y
piecewiseLinear =
   piecewise 1 [id, (1-)]
{-# INLINE piecewiseCubic #-}
piecewiseCubic :: (Field.C t, Module.C t y) => T t y
piecewiseCubic =
   piecewise 2 $
      Ctrl.cubicFunc (0,(0,0))    (1,(0,1/2)) :
      Ctrl.cubicFunc (0,(0,1/2))  (1,(1,0)) :
      Ctrl.cubicFunc (0,(1,0))    (1,(0,-1/2)) :
      Ctrl.cubicFunc (0,(0,-1/2)) (1,(0,0)) :
      []
{-# INLINE function #-}
function :: (Module.C t y) =>
      (Int,Int)   
   -> (t -> t)
   -> T t y
function (left,right) f =
   let len = left+right
       ps  = Sig.take len $ Sig.iterate pred (pred right)
       
   in  cons len left
          (\t -> Sig.linearComb $
                   Sig.map (\x -> f (t + fromIntegral x)) ps)