-- | This module contains some basic samples which can be combined to
-- generate interesting sounds 
module LambdaSound.Samples where

import Data.Coerce
import Data.Fixed (mod')
import Data.Massiv.Array qualified as M
import Data.Massiv.Array.Unsafe qualified as MU
import LambdaSound.Sound
import System.Random as R
import LambdaSound.Create

-- | Pure sinus sound
--
-- Warm and round
sineWave :: Hz -> Sound I Pulse
sineWave :: Hz -> Sound 'I Pulse
sineWave Hz
hz = (\Time
t -> Pulse -> Pulse
forall a. Floating a => a -> a
sin (Hz -> Pulse
forall a b. Coercible a b => a -> b
coerce Hz
hz Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
* Time -> Pulse
forall a b. Coercible a b => a -> b
coerce Time
t Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
* Pulse
2 Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
* Pulse
forall a. Floating a => a
pi)) (Time -> Pulse) -> Sound 'I Time -> Sound 'I Pulse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sound 'I Time
time

-- | Triangle wave
--
-- Similar to sine but colder
triangleWave :: Hz -> Sound I Pulse
triangleWave :: Hz -> Sound 'I Pulse
triangleWave Hz
hz =
  (Time -> Pulse) -> Sound 'I Time -> Sound 'I Pulse
forall a b. (a -> b) -> Sound 'I a -> Sound 'I b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    ( \Time
t ->
        let x :: Pulse
x = (Hz -> Pulse
forall a b. Coercible a b => a -> b
coerce Hz
hz Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
* Time -> Pulse
forall a b. Coercible a b => a -> b
coerce Time
t) Pulse -> Pulse -> Pulse
forall a. Real a => a -> a -> a
`mod'` Pulse
1
         in if Pulse
x Pulse -> Pulse -> Bool
forall a. Ord a => a -> a -> Bool
< Pulse
0.5
              then Pulse
x Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
* Pulse
4 Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
- Pulse
1
              else Pulse
3 Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
- Pulse
x Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
* Pulse
4
    )
    Sound 'I Time
time

-- | Sawtooth wave
--
-- Warm and sharp
sawWave :: Hz -> Sound I Pulse
sawWave :: Hz -> Sound 'I Pulse
sawWave Hz
hz = (\Time
t -> (Hz -> Pulse
forall a b. Coercible a b => a -> b
coerce Hz
hz Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
* Time -> Pulse
forall a b. Coercible a b => a -> b
coerce Time
t Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
* Pulse
2) Pulse -> Pulse -> Pulse
forall a. Real a => a -> a -> a
`mod'` Pulse
2 Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
- Pulse
1) (Time -> Pulse) -> Sound 'I Time -> Sound 'I Pulse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sound 'I Time
time

-- | Produces a square wave
--
-- Cold
squareWave :: Hz -> Sound I Pulse
squareWave :: Hz -> Sound 'I Pulse
squareWave Hz
hz = (\Time
t -> forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int (Ix1 -> Pulse) -> Ix1 -> Pulse
forall a b. (a -> b) -> a -> b
$ Time -> Ix1
forall b. Integral b => Time -> b
forall a b. (RealFrac a, Integral b) => a -> b
round ((Hz -> Time
forall a b. Coercible a b => a -> b
coerce Hz
hz Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
t) Time -> Time -> Time
forall a. Real a => a -> a -> a
`mod'` Time
1) Ix1 -> Ix1 -> Ix1
forall a. Num a => a -> a -> a
* Ix1
2 Ix1 -> Ix1 -> Ix1
forall a. Num a => a -> a -> a
- Ix1
1) (Time -> Pulse) -> Sound 'I Time -> Sound 'I Pulse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sound 'I Time
time

-- | Random noise between (-1,1). The given value is used as the seed value,
-- so the same seed will result in the same noise
noise :: Int -> Sound I Pulse
noise :: Ix1 -> Sound 'I Pulse
noise Ix1
initial =
  (SamplingInfo -> Array S Ix1 Float)
-> Sound 'I (Array S Ix1 Float -> Pulse) -> Sound 'I Pulse
forall a (d :: SoundDuration) b.
(SamplingInfo -> a) -> Sound d (a -> b) -> Sound d b
computeOnce
    ( \SamplingInfo
sr ->
        forall r ix e r'.
(Manifest r e, Load r' ix e) =>
Array r' ix e -> Array r ix e
M.compute @M.S (Array DL Ix1 Float -> Array S Ix1 Float)
-> Array DL Ix1 Float -> Array S Ix1 Float
forall a b. (a -> b) -> a -> b
$
          Sz Ix1
-> (StdGen -> (Float, StdGen)) -> StdGen -> Array DL Ix1 Float
forall ix e a.
Index ix =>
Sz ix -> (a -> (e, a)) -> a -> Array DL ix e
M.unfoldrS_
            (Ix1 -> Sz Ix1
M.Sz1 SamplingInfo
sr.samples)
            ((Float, Float) -> StdGen -> (Float, StdGen)
forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
R.uniformR (-Float
1, Float
1))
            (Ix1 -> StdGen
mkStdGen Ix1
initial)
    )
    ((Float -> Pulse)
-> (Array S Ix1 Float -> Float) -> Array S Ix1 Float -> Pulse
forall a b.
(a -> b) -> (Array S Ix1 Float -> a) -> Array S Ix1 Float -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Pulse
Pulse ((Array S Ix1 Float -> Float) -> Array S Ix1 Float -> Pulse)
-> (Ix1 -> Array S Ix1 Float -> Float)
-> Ix1
-> Array S Ix1 Float
-> Pulse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array S Ix1 Float -> Ix1 -> Float)
-> Ix1 -> Array S Ix1 Float -> Float
forall a b c. (a -> b -> c) -> b -> a -> c
flip Array S Ix1 Float -> Ix1 -> Float
forall ix. Index ix => Array S ix Float -> ix -> Float
forall r e ix. (Source r e, Index ix) => Array r ix e -> ix -> e
MU.unsafeIndex (Ix1 -> Array S Ix1 Float -> Pulse)
-> Sound 'I Ix1 -> Sound 'I (Array S Ix1 Float -> Pulse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sound 'I Ix1
sampleIndex)