module LambdaSound.Effect where

import Data.Coerce
import LambdaSound.Create
import LambdaSound.Sound

-- | Eases the volume of the sound. The given 'Int' controls the strength of the easing.
easeInOut :: Int -> Sound d Pulse -> Sound d Pulse
easeInOut :: forall (d :: SoundDuration). Int -> Sound d Pulse -> Sound d Pulse
easeInOut Int
strength = (Progress -> Pulse -> Pulse)
-> Sound 'I Progress
-> Sound d Pulse
-> Sound (DetermineDuration 'I d) Pulse
forall a b c (d1 :: SoundDuration) (d2 :: SoundDuration).
(a -> b -> c)
-> Sound d1 a -> Sound d2 b -> Sound (DetermineDuration d1 d2) c
zipSoundWith (\Progress
p -> (Progress -> Pulse
f Progress
p *)) Sound 'I Progress
progress
  where
    f :: Progress -> Pulse
f Progress
p = Progress -> Pulse
forall a b. Coercible a b => a -> b
coerce (Progress -> Pulse) -> Progress -> Pulse
forall a b. (a -> b) -> a -> b
$ -(Progress
2 Progress -> Progress -> Progress
forall a. Num a => a -> a -> a
* Progress
p Progress -> Progress -> Progress
forall a. Num a => a -> a -> a
- Progress
1) Progress -> Progress -> Progress
forall a. Floating a => a -> a -> a
** (Progress -> Progress
forall a. Num a => a -> a
abs (Int -> Progress
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
strength) Progress -> Progress -> Progress
forall a. Num a => a -> a -> a
* Progress
2) Progress -> Progress -> Progress
forall a. Num a => a -> a -> a
+ Progress
1

-- | Repeats a sound such that:
--
-- > repeatSound 3 sound = sound >>> sound >>> sound
repeatSound :: Int -> Sound T Pulse -> Sound T Pulse
repeatSound :: Int -> Sound 'T Pulse -> Sound 'T Pulse
repeatSound Int
n Sound 'T Pulse
s
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Sound 'T Pulse
forall a. Monoid a => a
mempty
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Sound 'T Pulse
s
  | Int -> Bool
forall a. Integral a => a -> Bool
even Int
n = Sound 'T Pulse
s' Sound 'T Pulse -> Sound 'T Pulse -> Sound 'T Pulse
>>> Sound 'T Pulse
s'
  | Bool
otherwise = Sound 'T Pulse
s' Sound 'T Pulse -> Sound 'T Pulse -> Sound 'T Pulse
>>> Sound 'T Pulse
s' Sound 'T Pulse -> Sound 'T Pulse -> Sound 'T Pulse
>>> Sound 'T Pulse
s
  where
    s' :: Sound 'T Pulse
s' = Int -> Sound 'T Pulse -> Sound 'T Pulse
repeatSound (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2) Sound 'T Pulse
s

-- | Plays the sound multiple times to get a simple reverb effect. The duration specifies the length of the reverb.
simpleReverb :: Duration -> Sound T Pulse -> Sound T Pulse
simpleReverb :: Duration -> Sound 'T Pulse -> Sound 'T Pulse
simpleReverb Duration
duration Sound 'T Pulse
sound = (((Float, Duration) -> Sound 'T Pulse)
 -> [(Float, Duration)] -> Sound 'T Pulse)
-> [(Float, Duration)]
-> ((Float, Duration) -> Sound 'T Pulse)
-> Sound 'T Pulse
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Float, Duration) -> Sound 'T Pulse)
-> [(Float, Duration)] -> Sound 'T Pulse
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([Float] -> [Duration] -> [(Float, Duration)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Float
1 ..] [Duration
0, (Duration
duration Duration -> Duration -> Duration
forall a. Fractional a => a -> a -> a
/ Duration
4) .. Duration
duration]) (((Float, Duration) -> Sound 'T Pulse) -> Sound 'T Pulse)
-> ((Float, Duration) -> Sound 'T Pulse) -> Sound 'T Pulse
forall a b. (a -> b) -> a -> b
$ \(Float
v, Duration
d) ->
  Float -> Sound 'T Pulse -> Sound 'T Pulse
forall (d :: SoundDuration).
Float -> Sound d Pulse -> Sound d Pulse
reduce Float
v (Duration -> Sound 'I Pulse -> Sound 'T Pulse
forall (d :: SoundDuration) a. Duration -> Sound d a -> Sound 'T a
setDuration Duration
d Sound 'I Pulse
silence Sound 'T Pulse -> Sound 'T Pulse -> Sound 'T Pulse
>>> Sound 'T Pulse
sound)

-- | ADSR envelope which specifies how the volume of a sound should behave over time
data Envelope = Envelope
  { Envelope -> Duration
attack :: !Duration,
    Envelope -> Duration
decay :: !Duration,
    Envelope -> Duration
release :: !Duration,
    Envelope -> Float
sustain :: !Float
  }
  deriving (Envelope -> Envelope -> Bool
(Envelope -> Envelope -> Bool)
-> (Envelope -> Envelope -> Bool) -> Eq Envelope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Envelope -> Envelope -> Bool
== :: Envelope -> Envelope -> Bool
$c/= :: Envelope -> Envelope -> Bool
/= :: Envelope -> Envelope -> Bool
Eq, Int -> Envelope -> ShowS
[Envelope] -> ShowS
Envelope -> String
(Int -> Envelope -> ShowS)
-> (Envelope -> String) -> ([Envelope] -> ShowS) -> Show Envelope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Envelope -> ShowS
showsPrec :: Int -> Envelope -> ShowS
$cshow :: Envelope -> String
show :: Envelope -> String
$cshowList :: [Envelope] -> ShowS
showList :: [Envelope] -> ShowS
Show)

-- | Apply an ADSR envelope to a sound
applyEnvelope :: Envelope -> Sound T Pulse -> Sound T Pulse
applyEnvelope :: Envelope -> Sound 'T Pulse -> Sound 'T Pulse
applyEnvelope Envelope
envelope Sound 'T Pulse
sound =
  let attack :: Sound 'I Pulse
attack = Progress -> Pulse
forall a b. Coercible a b => a -> b
coerce (Progress -> Pulse) -> Sound 'I Progress -> Sound 'I Pulse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sound 'I Progress
progress
      decay :: Sound 'I Pulse
decay = (Progress -> Pulse) -> Sound 'I Progress -> 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 (\Progress
p -> Float -> Pulse
forall a b. Coercible a b => a -> b
coerce Envelope
envelope.sustain Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
+ (Pulse
1 Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
- Progress -> Pulse
forall a b. Coercible a b => a -> b
coerce Progress
p) Pulse -> Pulse -> Pulse
forall a. Floating a => a -> a -> a
** Pulse
3 Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
* (Pulse
1 Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
- Float -> Pulse
forall a b. Coercible a b => a -> b
coerce Envelope
envelope.sustain)) Sound 'I Progress
progress
      sustain :: Sound 'I Pulse
sustain = Pulse -> Sound 'I Pulse
forall a. a -> Sound 'I a
constant (Float -> Pulse
forall a b. Coercible a b => a -> b
coerce Envelope
envelope.sustain)
      release :: Sound 'I Pulse
release = (Progress -> Pulse) -> Sound 'I Progress -> 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 (\Progress
p -> Float -> Pulse
forall a b. Coercible a b => a -> b
coerce Envelope
envelope.sustain Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
* (Pulse
1 Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
- Progress -> Pulse
forall a b. Coercible a b => a -> b
coerce Progress
p) Pulse -> Pulse -> Pulse
forall a. Floating a => a -> a -> a
** Pulse
3) Sound 'I Progress
progress
      adsrCurve :: Sound 'T Pulse
adsrCurve =
        [Sound 'T Pulse] -> Sound 'T Pulse
sequentially
          [ Envelope
envelope.attack Duration -> Sound 'I Pulse -> Sound 'T Pulse
forall (d :: SoundDuration) a. Duration -> Sound d a -> Sound 'T a
|-> Sound 'I Pulse
attack,
            Envelope
envelope.decay Duration -> Sound 'I Pulse -> Sound 'T Pulse
forall (d :: SoundDuration) a. Duration -> Sound d a -> Sound 'T a
|-> Sound 'I Pulse
decay,
            (Sound 'T Pulse -> Duration
forall a. Sound 'T a -> Duration
getDuration Sound 'T Pulse
sound Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
- Envelope
envelope.release Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
- Envelope
envelope.decay Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
- Envelope
envelope.attack) Duration -> Sound 'I Pulse -> Sound 'T Pulse
forall (d :: SoundDuration) a. Duration -> Sound d a -> Sound 'T a
|-> Sound 'I Pulse
sustain,
            Envelope
envelope.release Duration -> Sound 'I Pulse -> Sound 'T Pulse
forall (d :: SoundDuration) a. Duration -> Sound d a -> Sound 'T a
|-> Sound 'I Pulse
release
          ]
   in (Pulse -> Pulse -> Pulse)
-> Sound 'T Pulse
-> Sound 'T Pulse
-> Sound (DetermineDuration 'T 'T) Pulse
forall a b c (d1 :: SoundDuration) (d2 :: SoundDuration).
(a -> b -> c)
-> Sound d1 a -> Sound d2 b -> Sound (DetermineDuration d1 d2) c
zipSoundWith Pulse -> Pulse -> Pulse
forall a. Num a => a -> a -> a
(*) Sound 'T Pulse
adsrCurve Sound 'T Pulse
sound

-- | Add some harmonic frequencies
harmonic :: (Hz -> Sound I Pulse) -> Hz -> Sound I Pulse
harmonic :: (Hz -> Sound 'I Pulse) -> Hz -> Sound 'I Pulse
harmonic Hz -> Sound 'I Pulse
f Hz
hz = [Sound 'I Pulse] -> Sound 'I Pulse
forall (d :: SoundDuration).
Monoid (Sound d Pulse) =>
[Sound d Pulse] -> Sound d Pulse
parallel ([Sound 'I Pulse] -> Sound 'I Pulse)
-> [Sound 'I Pulse] -> Sound 'I Pulse
forall a b. (a -> b) -> a -> b
$ (\Float
x -> Float -> Sound 'I Pulse -> Sound 'I Pulse
forall (d :: SoundDuration).
Float -> Sound d Pulse -> Sound d Pulse
reduce Float
x (Sound 'I Pulse -> Sound 'I Pulse)
-> Sound 'I Pulse -> Sound 'I Pulse
forall a b. (a -> b) -> a -> b
$ Hz -> Sound 'I Pulse
f (Float -> Hz
forall a b. Coercible a b => a -> b
coerce Float
x Hz -> Hz -> Hz
forall a. Num a => a -> a -> a
* Hz
hz)) (Float -> Sound 'I Pulse) -> [Float] -> [Sound 'I Pulse]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take Int
6 [Float
1 ..]