{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
module Synthesizer.LLVM.Frame where

import qualified Synthesizer.LLVM.Frame.Stereo as Stereo

import qualified LLVM.Extra.Vector as Vector
import qualified LLVM.Extra.Arithmetic as A

import qualified LLVM.Core as LLVM
import LLVM.Core
          (CodeGenFunction, Value, Vector,
           IsPrimitive, IsArithmetic, )

import qualified Type.Data.Num.Decimal as TypeNum
import Type.Data.Num.Decimal (D2, D4, )

import Foreign.Storable.Tuple ()

import qualified Data.Traversable as Trav
import qualified Data.Foldable as Fold

import NumericPrelude.Numeric hiding (zero, one, div, signum, )
import NumericPrelude.Base


{- |
Copy mono signal to both stereo channels.
-}
stereoFromMono ::
   a -> CodeGenFunction r (Stereo.T a)
stereoFromMono x =
   return $ Stereo.cons x x

mixMonoFromStereo ::
   (A.Additive a) =>
   Stereo.T a -> CodeGenFunction r a
mixMonoFromStereo s =
   mix (Stereo.left s) (Stereo.right s)


stereoFromVector ::
   (IsPrimitive a) =>
   Value (Vector D2 a) ->
   CodeGenFunction r (Stereo.T (Value a))
stereoFromVector x =
   Trav.mapM (LLVM.extractelement x . LLVM.valueOf) $ Stereo.cons 0 1

vectorFromStereo ::
   (IsPrimitive a) =>
   Stereo.T (Value a) ->
   CodeGenFunction r (Value (Vector D2 a))
vectorFromStereo =
   Vector.assemble . Fold.toList


quadroFromVector ::
   (IsPrimitive a) =>
   Value (Vector D4 a) ->
   CodeGenFunction r (Stereo.T (Stereo.T (Value a)))
quadroFromVector x =
   Trav.mapM (Trav.mapM (LLVM.extractelement x . LLVM.valueOf)) $
   Stereo.cons (Stereo.cons 0 1) (Stereo.cons 2 3)

vectorFromQuadro ::
   (IsPrimitive a) =>
   Stereo.T (Stereo.T (Value a)) ->
   CodeGenFunction r (Value (Vector D4 a))
vectorFromQuadro =
   Vector.assemble .
   concatMap Fold.toList . Fold.toList


mix ::
   (A.Additive a) =>
   a -> a -> CodeGenFunction r a
mix = A.add


{- |
This may mean more shuffling and is not necessarily better than mixStereo.
-}
mixStereoV ::
   (IsArithmetic a, IsPrimitive a) =>
   Stereo.T (Value a) -> Stereo.T (Value a) ->
   CodeGenFunction r (Stereo.T (Value a))
mixStereoV x y =
   do xv <- vectorFromStereo x
      yv <- vectorFromStereo y
      stereoFromVector =<< A.add xv yv

mixVector ::
   (Vector.Arithmetic a, TypeNum.Positive n) =>
   Value (Vector n a) ->
   CodeGenFunction r (Value a)
mixVector = Vector.sum

mixVectorToStereo ::
   (Vector.Arithmetic a, TypeNum.Positive n) =>
   Value (Vector n a) ->
   CodeGenFunction r (Stereo.T (Value a))
mixVectorToStereo =
   fmap (uncurry Stereo.cons) .
   Vector.sumInterleavedToPair

{- |
Mix components with even index to the left channel
and components with odd index to the right channel.
-}
mixInterleavedVectorToStereo ::
   (Vector.Arithmetic a, TypeNum.Positive n) =>
   Value (Vector n a) ->
   CodeGenFunction r (Stereo.T (Value a))
mixInterleavedVectorToStereo =
   fmap (uncurry Stereo.cons) .
   Vector.sumInterleavedToPair


amplifyMono ::
   (A.PseudoRing a) =>
   a -> a -> CodeGenFunction r a
amplifyMono = A.mul

amplifyStereo ::
   (A.PseudoRing a) =>
   a -> Stereo.T a -> CodeGenFunction r (Stereo.T a)
amplifyStereo x =
   Trav.mapM (A.mul x)