module LambdaSound.Create
  ( -- * Basic sounds
    time,
    progress,
    sampleIndex,
    constant,
    silence,

    -- * Iterating
    iterateSound,
    iterateSoundPulse,

    -- * Unfolding
    unfoldlSound,
    unfoldlSoundPulse,
    unfoldrSound,
    unfoldrSoundPulse,
    iUnfoldlSound,
    iUnfoldlSoundPulse,
    iUnfoldrSound,
    iUnfoldrSoundPulse,
  )
where

import Data.Coerce (coerce)
import Data.Massiv.Array qualified as M
import LambdaSound.Sound

-- | A 'Sound' with @0@ volume
silence :: Sound I Pulse
silence :: Sound 'I Pulse
silence = Pulse -> Sound 'I Pulse
forall a. a -> Sound 'I a
constant Pulse
0

-- | A constant 'Sound'
constant :: a -> Sound I a
constant :: forall a. a -> Sound 'I a
constant a
a = (SamplingInfo -> Int -> a) -> Sound 'I a
forall a. (SamplingInfo -> Int -> a) -> Sound 'I a
makeSound ((SamplingInfo -> Int -> a) -> Sound 'I a)
-> (SamplingInfo -> Int -> a) -> Sound 'I a
forall a b. (a -> b) -> a -> b
$ (Int -> a) -> SamplingInfo -> Int -> a
forall a b. a -> b -> a
const (a -> Int -> a
forall a b. a -> b -> a
const a
a)

-- | Iterate over the samples to create the sound.
-- 
-- The 'Pulse' version is faster then the non-'Pulse' version
iterateSoundPulse :: (Pulse -> Pulse) -> Pulse -> Sound I Pulse
iterateSoundPulse :: (Pulse -> Pulse) -> Pulse -> Sound 'I Pulse
iterateSoundPulse Pulse -> Pulse
f Pulse
s = (SamplingInfo -> Vector DL Pulse) -> Sound 'I Pulse
forall r.
Load r Int Pulse =>
(SamplingInfo -> Vector r Pulse) -> Sound 'I Pulse
fillWholeSound ((SamplingInfo -> Vector DL Pulse) -> Sound 'I Pulse)
-> (SamplingInfo -> Vector DL Pulse) -> Sound 'I Pulse
forall a b. (a -> b) -> a -> b
$ \SamplingInfo
si ->
  Sz Int -> (Pulse -> Pulse) -> Pulse -> Vector DL Pulse
forall ix e. Index ix => Sz ix -> (e -> e) -> e -> Array DL ix e
M.iterateN (Int -> Sz Int
M.Sz1 SamplingInfo
si.samples) Pulse -> Pulse
f Pulse
s

-- | Iterate over the samples to create the sound.
iterateSound :: (a -> a) -> a -> Sound I a
iterateSound :: forall a. (a -> a) -> a -> Sound 'I a
iterateSound a -> a
f a
s = (SamplingInfo -> Vector D a) -> Sound 'I a
forall a. (SamplingInfo -> Vector D a) -> Sound 'I a
makeSoundVector ((SamplingInfo -> Vector D a) -> Sound 'I a)
-> (SamplingInfo -> Vector D a) -> Sound 'I a
forall a b. (a -> b) -> a -> b
$ \SamplingInfo
si ->
  Array B Int a -> Vector D a
forall ix r e.
(Index ix, Source r e) =>
Array r ix e -> Array D ix e
M.delay (Array B Int a -> Vector D a) -> Array B Int a -> Vector D a
forall a b. (a -> b) -> a -> b
$ forall r ix e r'.
(Manifest r e, Load r' ix e) =>
Array r' ix e -> Array r ix e
M.compute @M.B (Array DL Int a -> Array B Int a)
-> Array DL Int a -> Array B Int a
forall a b. (a -> b) -> a -> b
$ Sz Int -> (a -> a) -> a -> Array DL Int a
forall ix e. Index ix => Sz ix -> (e -> e) -> e -> Array DL ix e
M.iterateN (Int -> Sz Int
M.Sz1 SamplingInfo
si.samples) a -> a
f a
s

-- | Unfold the samples of a sound from the start to the end
--
--  The 'Pulse' version is faster then the non-'Pulse' version
unfoldlSoundPulse :: (s -> (s, Pulse)) -> s -> Sound I Pulse
unfoldlSoundPulse :: forall s. (s -> (s, Pulse)) -> s -> Sound 'I Pulse
unfoldlSoundPulse s -> (s, Pulse)
f s
s = (SamplingInfo -> Vector DL Pulse) -> Sound 'I Pulse
forall r.
Load r Int Pulse =>
(SamplingInfo -> Vector r Pulse) -> Sound 'I Pulse
fillWholeSound ((SamplingInfo -> Vector DL Pulse) -> Sound 'I Pulse)
-> (SamplingInfo -> Vector DL Pulse) -> Sound 'I Pulse
forall a b. (a -> b) -> a -> b
$ \SamplingInfo
si ->
  Sz Int -> (s -> (s, Pulse)) -> s -> Vector DL Pulse
forall ix a e.
Index ix =>
Sz ix -> (a -> (a, e)) -> a -> Array DL ix e
M.unfoldlS_ (Int -> Sz Int
M.Sz1 SamplingInfo
si.samples) s -> (s, Pulse)
f s
s

-- | Unfold the samples of a sound from the start to the end
unfoldlSound :: (s -> (s, a)) -> s -> Sound I a
unfoldlSound :: forall s a. (s -> (s, a)) -> s -> Sound 'I a
unfoldlSound s -> (s, a)
f s
s = (SamplingInfo -> Vector D a) -> Sound 'I a
forall a. (SamplingInfo -> Vector D a) -> Sound 'I a
makeSoundVector ((SamplingInfo -> Vector D a) -> Sound 'I a)
-> (SamplingInfo -> Vector D a) -> Sound 'I a
forall a b. (a -> b) -> a -> b
$ \SamplingInfo
si ->
  Array B Int a -> Vector D a
forall ix r e.
(Index ix, Source r e) =>
Array r ix e -> Array D ix e
M.delay (Array B Int a -> Vector D a) -> Array B Int a -> Vector D a
forall a b. (a -> b) -> a -> b
$ forall r ix e r'.
(Manifest r e, Load r' ix e) =>
Array r' ix e -> Array r ix e
M.compute @M.B (Array DL Int a -> Array B Int a)
-> Array DL Int a -> Array B Int a
forall a b. (a -> b) -> a -> b
$ Sz Int -> (s -> (s, a)) -> s -> Array DL Int a
forall ix a e.
Index ix =>
Sz ix -> (a -> (a, e)) -> a -> Array DL ix e
M.unfoldlS_ (Int -> Sz Int
M.Sz1 SamplingInfo
si.samples) s -> (s, a)
f s
s

-- | Unfold the samples of a sound from the end to start
--
-- The 'Pulse' version is faster then the non-'Pulse' version
unfoldrSoundPulse :: (s -> (Pulse, s)) -> s -> Sound I Pulse
unfoldrSoundPulse :: forall s. (s -> (Pulse, s)) -> s -> Sound 'I Pulse
unfoldrSoundPulse s -> (Pulse, s)
f s
s = (SamplingInfo -> Vector DL Pulse) -> Sound 'I Pulse
forall r.
Load r Int Pulse =>
(SamplingInfo -> Vector r Pulse) -> Sound 'I Pulse
fillWholeSound ((SamplingInfo -> Vector DL Pulse) -> Sound 'I Pulse)
-> (SamplingInfo -> Vector DL Pulse) -> Sound 'I Pulse
forall a b. (a -> b) -> a -> b
$ \SamplingInfo
si ->
  Sz Int -> (s -> (Pulse, s)) -> s -> Vector DL Pulse
forall ix e a.
Index ix =>
Sz ix -> (a -> (e, a)) -> a -> Array DL ix e
M.unfoldrS_ (Int -> Sz Int
M.Sz1 SamplingInfo
si.samples) s -> (Pulse, s)
f s
s

-- | Unfold the samples of a sound from the end to start
unfoldrSound :: (s -> (a, s)) -> s -> Sound I a
unfoldrSound :: forall s a. (s -> (a, s)) -> s -> Sound 'I a
unfoldrSound s -> (a, s)
f s
s = (SamplingInfo -> Vector D a) -> Sound 'I a
forall a. (SamplingInfo -> Vector D a) -> Sound 'I a
makeSoundVector ((SamplingInfo -> Vector D a) -> Sound 'I a)
-> (SamplingInfo -> Vector D a) -> Sound 'I a
forall a b. (a -> b) -> a -> b
$ \SamplingInfo
si ->
  Array B Int a -> Vector D a
forall ix r e.
(Index ix, Source r e) =>
Array r ix e -> Array D ix e
M.delay (Array B Int a -> Vector D a) -> Array B Int a -> Vector D a
forall a b. (a -> b) -> a -> b
$ forall r ix e r'.
(Manifest r e, Load r' ix e) =>
Array r' ix e -> Array r ix e
M.compute @M.B (Array DL Int a -> Array B Int a)
-> Array DL Int a -> Array B Int a
forall a b. (a -> b) -> a -> b
$ Sz Int -> (s -> (a, s)) -> s -> Array DL Int a
forall ix e a.
Index ix =>
Sz ix -> (a -> (e, a)) -> a -> Array DL ix e
M.unfoldrS_ (Int -> Sz Int
M.Sz1 SamplingInfo
si.samples) s -> (a, s)
f s
s

-- | Unfold the samples of a sound from the start to the end with the index starting at 0
--
--  The 'Pulse' version is faster then the non-'Pulse' version
iUnfoldlSoundPulse :: (Int -> s -> (s, Pulse)) -> s -> Sound I Pulse
iUnfoldlSoundPulse :: forall s. (Int -> s -> (s, Pulse)) -> s -> Sound 'I Pulse
iUnfoldlSoundPulse Int -> s -> (s, Pulse)
f s
s = (SamplingInfo -> Vector DL Pulse) -> Sound 'I Pulse
forall r.
Load r Int Pulse =>
(SamplingInfo -> Vector r Pulse) -> Sound 'I Pulse
fillWholeSound ((SamplingInfo -> Vector DL Pulse) -> Sound 'I Pulse)
-> (SamplingInfo -> Vector DL Pulse) -> Sound 'I Pulse
forall a b. (a -> b) -> a -> b
$ \SamplingInfo
si ->
  Sz Int -> (Int -> s -> (s, Pulse)) -> s -> Vector DL Pulse
forall ix e a.
Index ix =>
Sz ix -> (ix -> a -> (a, e)) -> a -> Array DL ix e
M.iunfoldlS_ (Int -> Sz Int
M.Sz1 SamplingInfo
si.samples) Int -> s -> (s, Pulse)
f s
s

-- | Unfold the samples of a sound from the start to the end with the index starting at 0
iUnfoldlSound :: (Int -> s -> (s, a)) -> s -> Sound I a
iUnfoldlSound :: forall s a. (Int -> s -> (s, a)) -> s -> Sound 'I a
iUnfoldlSound Int -> s -> (s, a)
f s
s = (SamplingInfo -> Vector D a) -> Sound 'I a
forall a. (SamplingInfo -> Vector D a) -> Sound 'I a
makeSoundVector ((SamplingInfo -> Vector D a) -> Sound 'I a)
-> (SamplingInfo -> Vector D a) -> Sound 'I a
forall a b. (a -> b) -> a -> b
$ \SamplingInfo
si ->
  Array B Int a -> Vector D a
forall ix r e.
(Index ix, Source r e) =>
Array r ix e -> Array D ix e
M.delay (Array B Int a -> Vector D a) -> Array B Int a -> Vector D a
forall a b. (a -> b) -> a -> b
$ forall r ix e r'.
(Manifest r e, Load r' ix e) =>
Array r' ix e -> Array r ix e
M.compute @M.B (Array DL Int a -> Array B Int a)
-> Array DL Int a -> Array B Int a
forall a b. (a -> b) -> a -> b
$ Sz Int -> (Int -> s -> (s, a)) -> s -> Array DL Int a
forall ix e a.
Index ix =>
Sz ix -> (ix -> a -> (a, e)) -> a -> Array DL ix e
M.iunfoldlS_ (Int -> Sz Int
M.Sz1 SamplingInfo
si.samples) Int -> s -> (s, a)
f s
s

-- | Unfold the samples of a sound from the end to the start with the index starting at 0
--
--  The 'Pulse' version is faster then the non-'Pulse' version
iUnfoldrSoundPulse :: (s -> Int -> (Pulse, s)) -> s -> Sound I Pulse
iUnfoldrSoundPulse :: forall s. (s -> Int -> (Pulse, s)) -> s -> Sound 'I Pulse
iUnfoldrSoundPulse s -> Int -> (Pulse, s)
f s
s = (SamplingInfo -> Vector DL Pulse) -> Sound 'I Pulse
forall r.
Load r Int Pulse =>
(SamplingInfo -> Vector r Pulse) -> Sound 'I Pulse
fillWholeSound ((SamplingInfo -> Vector DL Pulse) -> Sound 'I Pulse)
-> (SamplingInfo -> Vector DL Pulse) -> Sound 'I Pulse
forall a b. (a -> b) -> a -> b
$ \SamplingInfo
si ->
  Sz Int -> (s -> Int -> (Pulse, s)) -> s -> Vector DL Pulse
forall ix e a.
Index ix =>
Sz ix -> (a -> ix -> (e, a)) -> a -> Array DL ix e
M.iunfoldrS_ (Int -> Sz Int
M.Sz1 SamplingInfo
si.samples) s -> Int -> (Pulse, s)
f s
s

-- | Unfold the samples of a sound from the end to the start with the index starting at 0
iUnfoldrSound :: (s -> Int -> (a, s)) -> s -> Sound I a
iUnfoldrSound :: forall s a. (s -> Int -> (a, s)) -> s -> Sound 'I a
iUnfoldrSound s -> Int -> (a, s)
f s
s = (SamplingInfo -> Vector D a) -> Sound 'I a
forall a. (SamplingInfo -> Vector D a) -> Sound 'I a
makeSoundVector ((SamplingInfo -> Vector D a) -> Sound 'I a)
-> (SamplingInfo -> Vector D a) -> Sound 'I a
forall a b. (a -> b) -> a -> b
$ \SamplingInfo
si ->
  Array B Int a -> Vector D a
forall ix r e.
(Index ix, Source r e) =>
Array r ix e -> Array D ix e
M.delay (Array B Int a -> Vector D a) -> Array B Int a -> Vector D a
forall a b. (a -> b) -> a -> b
$ forall r ix e r'.
(Manifest r e, Load r' ix e) =>
Array r' ix e -> Array r ix e
M.compute @M.B (Array DL Int a -> Array B Int a)
-> Array DL Int a -> Array B Int a
forall a b. (a -> b) -> a -> b
$ Sz Int -> (s -> Int -> (a, s)) -> s -> Array DL Int a
forall ix e a.
Index ix =>
Sz ix -> (a -> ix -> (e, a)) -> a -> Array DL ix e
M.iunfoldrS_ (Int -> Sz Int
M.Sz1 SamplingInfo
si.samples) s -> Int -> (a, s)
f s
s

-- | Get the time for each sample which can be used for sinus wave calculations (e.g. 'sineWave')
time :: Sound I Time
time :: Sound 'I Time
time = (SamplingInfo -> Int -> Time) -> Sound 'I Time
forall a. (SamplingInfo -> Int -> a) -> Sound 'I a
makeSound ((SamplingInfo -> Int -> Time) -> Sound 'I Time)
-> (SamplingInfo -> Int -> Time) -> Sound 'I Time
forall a b. (a -> b) -> a -> b
$ \SamplingInfo
si Int
index ->
  Float -> Time
forall a b. Coercible a b => a -> b
coerce (Float -> Time) -> Float -> Time
forall a b. (a -> b) -> a -> b
$ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index Float -> Float -> Float
forall a. Num a => a -> a -> a
* SamplingInfo
si.period

-- | Get the 'Progress' of a 'Sound'.
-- 'Progress' of '0' means that the sound has just started.
-- 'Progress' of '1' means that the sound has finished.
-- 'Progress' greater than '1' or smaller than '0' is invalid.
progress :: Sound I Progress
progress :: Sound 'I Progress
progress = (SamplingInfo -> Int -> Progress) -> Sound 'I Progress
forall a. (SamplingInfo -> Int -> a) -> Sound 'I a
makeSound ((SamplingInfo -> Int -> Progress) -> Sound 'I Progress)
-> (SamplingInfo -> Int -> Progress) -> Sound 'I Progress
forall a b. (a -> b) -> a -> b
$ \SamplingInfo
si Int
index ->
  Int -> Progress
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index Progress -> Progress -> Progress
forall a. Fractional a => a -> a -> a
/ Int -> Progress
forall a b. (Integral a, Num b) => a -> b
fromIntegral SamplingInfo
si.samples

-- | Tells you the sample index for each sample
sampleIndex :: Sound I Int
sampleIndex :: Sound 'I Int
sampleIndex = (SamplingInfo -> Int -> Int) -> Sound 'I Int
forall a. (SamplingInfo -> Int -> a) -> Sound 'I a
makeSound ((Int -> Int) -> SamplingInfo -> Int -> Int
forall a b. a -> b -> a
const Int -> Int
forall a. a -> a
id)