{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.LLVM.Sample where

import qualified LLVM.Extra.Vector as Vector

import Foreign.Storable.Tuple ()

import qualified Synthesizer.LLVM.Frame.Stereo as Stereo

import qualified LLVM.Extra.Arithmetic as A

import qualified LLVM.Core as LLVM
import LLVM.Core
          (Value, valueOf, value, undef,
           Vector, insertelement, extractelement,
           IsPrimitive, IsPowerOf2, IsArithmetic,
           CodeGenFunction, )
import Data.TypeLevel.Num (D2, D4, )

import Data.Word (Word32, )

import Control.Monad (liftM2, )

import NumericPrelude.Numeric hiding (zero, )
import NumericPrelude.Base


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

mixMonoFromStereo ::
   (IsArithmetic a) =>
   Stereo.T (Value a) ->
   CodeGenFunction r (Value a)
mixMonoFromStereo s =
   mixMono (Stereo.left s) (Stereo.right s)

zipStereo ::
   Value a -> Value a ->
   CodeGenFunction r (Stereo.T (Value a))
zipStereo l r =
   return (Stereo.cons l r)


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

vectorFromStereo ::
   (IsPrimitive a) =>
   Stereo.T (Value a) ->
   CodeGenFunction r (Value (Vector D2 a))
vectorFromStereo s = do
   x <- insertelement (value undef) (Stereo.left s) (valueOf 0)
   insertelement x (Stereo.right s) (valueOf 1)


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

vectorFromQuadro ::
   (IsPrimitive a) =>
   Stereo.T (Stereo.T (Value a)) ->
   CodeGenFunction r (Value (Vector D4 a))
vectorFromQuadro s = do
   let x0 = value undef
       sl = Stereo.left s
       sr = Stereo.right s
   x1 <- insertelement x0 (Stereo.left  sl) (valueOf 0)
   x2 <- insertelement x1 (Stereo.right sl) (valueOf 1)
   x3 <- insertelement x2 (Stereo.left  sr) (valueOf 2)
   insertelement       x3 (Stereo.right sr) (valueOf 3)


mixMono ::
   (IsArithmetic a) =>
   Value a -> Value a ->
   CodeGenFunction r (Value a)
mixMono = A.add

mixStereo ::
   (IsArithmetic a) =>
   Stereo.T (Value a) -> Stereo.T (Value a) ->
   CodeGenFunction r (Stereo.T (Value a))
mixStereo x y =
   liftM2 Stereo.cons
      (A.add (Stereo.left  x) (Stereo.left  y))
      (A.add (Stereo.right x) (Stereo.right y))


class Additive a where
   zero :: a
   add :: a -> a -> CodeGenFunction r a

instance (IsArithmetic a) => Additive (Value a) where
   zero = LLVM.value LLVM.zero
   add = A.add

instance (Additive a) => Additive (Stereo.T a) where
   zero = Stereo.cons zero zero
   add x y =
      liftM2 Stereo.cons
         (add (Stereo.left  x) (Stereo.left  y))
         (add (Stereo.right x) (Stereo.right y))



{- |
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, IsPowerOf2 n) =>
   Value (Vector n a) ->
   CodeGenFunction r (Value a)
mixVector = Vector.sum

mixVectorToStereo ::
   (Vector.Arithmetic a, IsPowerOf2 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, IsPowerOf2 n) =>
   Value (Vector n a) ->
   CodeGenFunction r (Stereo.T (Value a))
mixInterleavedVectorToStereo =
   fmap (uncurry Stereo.cons) .
   Vector.sumInterleavedToPair


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

amplifyStereo ::
   (IsArithmetic a) =>
   Value a -> Stereo.T (Value a) ->
   CodeGenFunction r (Stereo.T (Value a))
amplifyStereo x y =
   liftM2 Stereo.cons
      (A.mul x (Stereo.left  y))
      (A.mul x (Stereo.right y))

subsampleVector ::
   (Vector.Access n a v) =>
   v -> CodeGenFunction r a
subsampleVector =
   Vector.extract (LLVM.value LLVM.zero :: Value Word32)