-- | 'V.Vector' variants of "Sound.SC3.Common.Buffer".
module Sound.SC3.Common.Buffer.Vector where

import qualified Data.Vector.Storable as V {- vector -}

import qualified Sound.SC3.Common.Buffer as C {- hsc3 -}

-- | 'C.clipAt'.
clipAt :: V.Storable t => Int -> V.Vector t -> t
clipAt :: Int -> Vector t -> t
clipAt Int
ix Vector t
c =
    let r :: Int
r = Vector t -> Int
forall a. Storable a => Vector a -> Int
V.length Vector t
c
        f :: Int -> t
f = Vector t -> Int -> t
forall a. Storable a => Vector a -> Int -> a
(V.!) Vector t
c
    in if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 then Int -> t
f (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) else Int -> t
f Int
ix

-- | 'C.blendAtBy' of 'clipAt'.
--
-- > blendAt 0 (V.fromList [2,5,6]) == 2
-- > blendAt 0.4 (V.fromList [2,5,6]) == 3.2
-- > blendAt 2.1 (V.fromList [2,5,6]) == 6
blendAt :: (V.Storable t,RealFrac t) => t -> V.Vector t -> t
blendAt :: t -> Vector t -> t
blendAt = (Int -> Vector t -> t) -> t -> Vector t -> t
forall i n t.
(Integral i, RealFrac n) =>
(i -> t -> n) -> n -> t -> n
C.blendAtBy Int -> Vector t -> t
forall t. Storable t => Int -> Vector t -> t
clipAt

-- | 'C.from_wavetable'
--
-- > from_wavetable (V.fromList [-0.5,0.5,0,0.5,1.5,-0.5,1,-0.5])
from_wavetable :: (V.Storable t,Num t) => V.Vector t -> V.Vector t
from_wavetable :: Vector t -> Vector t
from_wavetable Vector t
wt =
  let n :: Int
n = Vector t -> Int
forall a. Storable a => Vector a -> Int
V.length Vector t
wt
      f :: Int -> t
f Int
k = let k2 :: Int
k2 = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 in (Vector t
wt Vector t -> Int -> t
forall a. Storable a => Vector a -> Int -> a
V.! Int
k2) t -> t -> t
forall a. Num a => a -> a -> a
+ (Vector t
wt Vector t -> Int -> t
forall a. Storable a => Vector a -> Int -> a
V.! (Int
k2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
  in Int -> (Int -> t) -> Vector t
forall a. Storable a => Int -> (Int -> a) -> Vector a
V.generate (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int -> t
f

-- | 'C.resamp1'.
--
-- > resamp1 12 (V.fromList [1,2,3,4])
-- > resamp1 3 (V.fromList [1,2,3,4]) == V.fromList [1,2.5,4]
resamp1 :: (V.Storable t,RealFrac t) => Int -> V.Vector t -> V.Vector t
resamp1 :: Int -> Vector t -> Vector t
resamp1 Int
n Vector t
c =
    let gen :: Int -> t
gen = Int -> Int -> (Int -> Vector t -> t) -> Vector t -> Int -> t
forall i n t.
(Integral i, RealFrac n) =>
i -> i -> (i -> t -> n) -> t -> i -> n
C.resamp1_gen Int
n (Vector t -> Int
forall a. Storable a => Vector a -> Int
V.length Vector t
c) Int -> Vector t -> t
forall t. Storable t => Int -> Vector t -> t
clipAt Vector t
c
    in Int -> (Int -> t) -> Vector t
forall a. Storable a => Int -> (Int -> a) -> Vector a
V.generate Int
n Int -> t
gen