CommonPacked.hs

module Synthesizer.LLVM.Server.CommonPacked where

import Synthesizer.LLVM.Server.Common

import qualified Synthesizer.LLVM.Frame.SerialVector as Serial

import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
import qualified Synthesizer.LLVM.CausalParameterized.Functional as F
import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
import qualified Synthesizer.LLVM.Parameter as Param

import qualified Data.List.Match as Match

import qualified Algebra.Additive as Additive

import qualified Types.Data.Num as TypeNum

import Control.Arrow (arr, )

import NumericPrelude.Numeric ((+), (-), (*), )
import Prelude hiding (Real, (+), (-), (*), )


sumNested :: (Additive.C a) => [a] -> a
sumNested [] = Additive.zero
sumNested xs@(_:rs) =
   let ys = xs ++ Match.take rs (sum2 ys)
   in  last ys

sum2 :: (Additive.C a) => [a] -> [a]
sum2 (x:y:rest) = (x+y) : sum2 rest
sum2 xs = xs


-- maybe this can be merged into a PCS.controllerDiscrete
stair :: Real -> Real
stair i =
   let n = fromIntegral (round i :: Int)
       r = i - n
   in  n + 0.01*r


type Param p = Param.T (SampleRate Real, p)
type SigP p = SigP.T (SampleRate Real, p)
type CausalP p = CausalP.T (SampleRate Real, p)
type FuncP p = F.T (SampleRate Real, p)


type Vector = Serial.Plain VectorSize Real
type VectorValue = Serial.Value VectorSize Real
type VectorSize = TypeNum.D4


vectorSize :: Int
vectorSize = TypeNum.fromIntegerT (undefined :: VectorSize)

vectorRate :: Fractional a => SampleRate a -> a
vectorRate (SampleRate sampleRate) =
   sampleRate / fromIntegral vectorSize


vectorTime :: (p -> Real) -> Param p Real
vectorTime param =
   arr (\(SampleRate sampleRate, p) ->
          param p * sampleRate / fromIntegral vectorSize)

noiseReference :: Real -> Param p Real
noiseReference freq =
   arr (\(SampleRate sampleRate, _p) -> sampleRate/freq)