Safe Haskell | Safe-Inferred |
---|---|
Language | GHC2021 |
This module exports all needed datatypes and all the combinators needed to manipulate them.
Synopsis
- data Sound (d :: SoundDuration) a where
- TimedSound :: !Duration -> ComputeSound a -> Sound T a
- InfiniteSound :: ComputeSound a -> Sound I a
- data SoundDuration
- newtype Pulse = Pulse Float
- newtype Duration = Duration Float
- newtype Progress = Progress Float
- newtype Percentage = Percentage Float
- data SamplingInfo = SamplingInfo {}
- newtype Hz = Hz Float
- newtype Time = Time Float
- type family DetermineDuration (d1 :: SoundDuration) (d2 :: SoundDuration) where ...
- makeSound :: (SamplingInfo -> Int -> a) -> Sound I a
- makeSoundVector :: (SamplingInfo -> Vector D a) -> Sound I a
- fillWholeSound :: Load r Ix1 Pulse => (SamplingInfo -> Vector r Pulse) -> Sound I Pulse
- fillWholeSoundST :: (SamplingInfo -> MVector RealWorld S Pulse -> ST RealWorld ()) -> Sound I Pulse
- computeOnce :: (SamplingInfo -> a) -> Sound d (a -> b) -> Sound d b
- timedSequentially :: Sound T Pulse -> Sound T Pulse -> Sound T Pulse
- (>>>) :: Sound T Pulse -> Sound T Pulse -> Sound T Pulse
- sequentially :: [Sound T Pulse] -> Sound T Pulse
- infiniteSequentially :: Percentage -> Sound I Pulse -> Sound I Pulse -> Sound I Pulse
- parallel2 :: Sound d Pulse -> Sound d Pulse -> Sound d Pulse
- parallel :: Monoid (Sound d Pulse) => [Sound d Pulse] -> Sound d Pulse
- amplify :: Float -> Sound d Pulse -> Sound d Pulse
- reduce :: Float -> Sound d Pulse -> Sound d Pulse
- raise :: Float -> Sound d Pulse -> Sound d Pulse
- diminish :: Float -> Sound d Pulse -> Sound d Pulse
- setDuration :: Duration -> Sound d a -> Sound T a
- (|->) :: Duration -> Sound d a -> Sound 'T a
- getDuration :: Sound T a -> Duration
- scaleDuration :: Float -> Sound T a -> Sound T a
- dropDuration :: Sound d a -> Sound I a
- adoptDuration :: Sound d a -> Sound x b -> Sound d b
- reverseSound :: Sound d a -> Sound d a
- dropSound :: Duration -> Sound T a -> Sound T a
- takeSound :: Duration -> Sound T a -> Sound T a
- zipSoundWith :: (a -> b -> c) -> Sound d1 a -> Sound d2 b -> Sound (DetermineDuration d1 d2) c
- zipSound :: Sound d1 (a -> b) -> Sound d2 a -> Sound (DetermineDuration d1 d2) b
- changeTempo :: (Progress -> Progress) -> Sound d a -> Sound d a
- changeTempoM :: Sound I (Progress -> Progress) -> Sound d a -> Sound d a
- modifyWholeSound :: Load r Ix1 Pulse => (Vector S Pulse -> Vector r Pulse) -> Sound d Pulse -> Sound d Pulse
- modifyWholeSoundST :: (Vector S Pulse -> MVector RealWorld S Pulse -> ST RealWorld ()) -> Sound d Pulse -> Sound d Pulse
- withSamplingInfo :: (SamplingInfo -> Sound d a) -> Sound I a
- withSampledSound :: Sound T a -> (Vector D a -> Sound I b) -> Sound I b
- withSampledSoundPulse :: Sound T Pulse -> (Vector S Pulse -> Sound I a) -> Sound I a
- embedIO :: IO (Sound d a) -> Sound I a
- embedIOLazily :: IO (Sound d a) -> Sound I a
Sound types
data Sound (d :: SoundDuration) a where Source #
TimedSound :: !Duration -> ComputeSound a -> Sound T a | |
InfiniteSound :: ComputeSound a -> Sound I a |
data SoundDuration Source #
An audio sample
Instances
Storable Pulse Source # | |
Enum Pulse Source # | |
Defined in LambdaSound.Sound.Types | |
Floating Pulse Source # | |
Num Pulse Source # | |
Fractional Pulse Source # | |
Real Pulse Source # | |
Defined in LambdaSound.Sound.Types toRational :: Pulse -> Rational # | |
RealFrac Pulse Source # | |
Show Pulse Source # | |
NFData Pulse Source # | |
Defined in LambdaSound.Sound.Types | |
Eq Pulse Source # | |
Ord Pulse Source # | |
Hashable Pulse Source # | |
Defined in LambdaSound.Sound.Types | |
Monoid (Sound 'I Pulse) Source # | |
Monoid (Sound 'T Pulse) Source # | |
Semigroup (Sound d Pulse) Source # | |
Show (Sound d Pulse) Source # | |
The duration of a Sound
Instances
Storable Duration Source # | |
Defined in LambdaSound.Sound.Types | |
Enum Duration Source # | |
Floating Duration Source # | |
Defined in LambdaSound.Sound.Types sqrt :: Duration -> Duration # (**) :: Duration -> Duration -> Duration # logBase :: Duration -> Duration -> Duration # asin :: Duration -> Duration # acos :: Duration -> Duration # atan :: Duration -> Duration # sinh :: Duration -> Duration # cosh :: Duration -> Duration # tanh :: Duration -> Duration # asinh :: Duration -> Duration # acosh :: Duration -> Duration # atanh :: Duration -> Duration # log1p :: Duration -> Duration # expm1 :: Duration -> Duration # | |
Num Duration Source # | |
Fractional Duration Source # | |
Real Duration Source # | |
Defined in LambdaSound.Sound.Types toRational :: Duration -> Rational # | |
RealFrac Duration Source # | |
Show Duration Source # | |
NFData Duration Source # | |
Defined in LambdaSound.Sound.Types | |
Eq Duration Source # | |
Ord Duration Source # | |
Defined in LambdaSound.Sound.Types | |
Hashable Duration Source # | |
Defined in LambdaSound.Sound.Types |
The progress of a Sound
. A sound progresses from '0' to '1'
while it plays.
Instances
Storable Progress Source # | |
Defined in LambdaSound.Sound.Types | |
Enum Progress Source # | |
Floating Progress Source # | |
Defined in LambdaSound.Sound.Types sqrt :: Progress -> Progress # (**) :: Progress -> Progress -> Progress # logBase :: Progress -> Progress -> Progress # asin :: Progress -> Progress # acos :: Progress -> Progress # atan :: Progress -> Progress # sinh :: Progress -> Progress # cosh :: Progress -> Progress # tanh :: Progress -> Progress # asinh :: Progress -> Progress # acosh :: Progress -> Progress # atanh :: Progress -> Progress # log1p :: Progress -> Progress # expm1 :: Progress -> Progress # | |
Num Progress Source # | |
Fractional Progress Source # | |
Real Progress Source # | |
Defined in LambdaSound.Sound.Types toRational :: Progress -> Rational # | |
RealFrac Progress Source # | |
Show Progress Source # | |
NFData Progress Source # | |
Defined in LambdaSound.Sound.Types | |
Eq Progress Source # | |
Ord Progress Source # | |
Defined in LambdaSound.Sound.Types | |
Hashable Progress Source # | |
Defined in LambdaSound.Sound.Types |
newtype Percentage Source #
The percentage of a Sound
. '0.3' corresponds to 30% of a Sound
.
Instances
data SamplingInfo Source #
Gives information about how many samples are needed during computation
Instances
Hz are the unit for frequencies. 440 Hz means that 440 oscillations happen per second
Instances
Enum Hz Source # | |
Floating Hz Source # | |
Defined in LambdaSound.Sound.Types | |
Generic Hz Source # | |
Num Hz Source # | |
Fractional Hz Source # | |
Real Hz Source # | |
Defined in LambdaSound.Sound.Types toRational :: Hz -> Rational # | |
RealFrac Hz Source # | |
Show Hz Source # | |
Eq Hz Source # | |
Ord Hz Source # | |
Hashable Hz Source # | |
Defined in LambdaSound.Sound.Types | |
type Rep Hz Source # | |
Defined in LambdaSound.Sound.Types |
Time progresses while a Sound
is playing and is used to create samples.
It is not guaranteed that Time
will correspond to the real runtime of a Sound
Instances
Storable Time Source # | |
Defined in LambdaSound.Sound.Types | |
Enum Time Source # | |
Floating Time Source # | |
Num Time Source # | |
Fractional Time Source # | |
Real Time Source # | |
Defined in LambdaSound.Sound.Types toRational :: Time -> Rational # | |
RealFrac Time Source # | |
Show Time Source # | |
NFData Time Source # | |
Defined in LambdaSound.Sound.Types | |
Eq Time Source # | |
Ord Time Source # | |
Hashable Time Source # | |
Defined in LambdaSound.Sound.Types |
type family DetermineDuration (d1 :: SoundDuration) (d2 :: SoundDuration) where ... Source #
Determines the duration of two sounds when they are combined
DetermineDuration I d = d | |
DetermineDuration d I = d | |
DetermineDuration T _ = T | |
DetermineDuration _ T = T |
Make new sounds
makeSound :: (SamplingInfo -> Int -> a) -> Sound I a Source #
Calculate sound samples based on their index.
Take a look at LambdaSound.Create
for other creation functions.
makeSoundVector :: (SamplingInfo -> Vector D a) -> Sound I a Source #
Calculate the samples of the sound as one vector
Take a look at LambdaSound.Create
for other creation functions.
fillWholeSound :: Load r Ix1 Pulse => (SamplingInfo -> Vector r Pulse) -> Sound I Pulse Source #
Fill a sound with a vector of sound samples. Keep in mind that the vector has the appropriate length!
fillWholeSoundST :: (SamplingInfo -> MVector RealWorld S Pulse -> ST RealWorld ()) -> Sound I Pulse Source #
Fill a sound with a vector of sound samples in a mutable fashion.
computeOnce :: (SamplingInfo -> a) -> Sound d (a -> b) -> Sound d b Source #
Compute a value once and then reuse it while computing all samples
Sounds in sequence
timedSequentially :: Sound T Pulse -> Sound T Pulse -> Sound T Pulse Source #
Append two sounds. This is only possible for sounds with a duration.
sequentially :: [Sound T Pulse] -> Sound T Pulse Source #
Combine a list of sounds in a sequential manner.
infiniteSequentially :: Percentage -> Sound I Pulse -> Sound I Pulse -> Sound I Pulse Source #
Append two infinite sounds where the Percentage
in the range [0,1]
specifies when the first sound ends and the next begins.
Sounds in parallel
parallel2 :: Sound d Pulse -> Sound d Pulse -> Sound d Pulse Source #
Combine two sounds such that they play in parallel. If one Sound
is longer than the other,
it will be played without the shorter one for its remaining time
parallel :: Monoid (Sound d Pulse) => [Sound d Pulse] -> Sound d Pulse Source #
Combine a lists of sounds such that they play in parallel
Volume
Pitch
raise :: Float -> Sound d Pulse -> Sound d Pulse Source #
Raises the frequency of the Sound
by the given factor.
Only works if the sound is based on some frequency (e.g. sineWave
but not noise
)
diminish :: Float -> Sound d Pulse -> Sound d Pulse Source #
Diminishes the frequency of the Sound
by the given factor.
Only works if the sound is based on some frequency (e.g. pulse
but not noise
)
Duration
(|->) :: Duration -> Sound d a -> Sound 'T a infix 7 Source #
Same as setDuration
but in operator form.
Sample order
dropSound :: Duration -> Sound T a -> Sound T a Source #
Drop parts of a sound similar to drop
for lists
takeSound :: Duration -> Sound T a -> Sound T a Source #
Take parts of a sound similar to take
for lists
Zipping
zipSoundWith :: (a -> b -> c) -> Sound d1 a -> Sound d2 b -> Sound (DetermineDuration d1 d2) c Source #
Change play behavior of a sound
Modify the samples of a sound
modifyWholeSound :: Load r Ix1 Pulse => (Vector S Pulse -> Vector r Pulse) -> Sound d Pulse -> Sound d Pulse Source #
Modify all samples of a sound so that you can look into the past and future of a sound (e.g. IIR filter).
modifyWholeSoundST :: (Vector S Pulse -> MVector RealWorld S Pulse -> ST RealWorld ()) -> Sound d Pulse -> Sound d Pulse Source #
Modify all samples of a sound so that you can look into the past and future of a sound (e.g. IIR filter).
Access the samples of a sound
withSamplingInfo :: (SamplingInfo -> Sound d a) -> Sound I a Source #
Access the sample rate of an infinite sound
withSampledSound :: Sound T a -> (Vector D a -> Sound I b) -> Sound I b Source #
Access the samples of a sound.
withSampledSoundPulse :: Sound T Pulse -> (Vector S Pulse -> Sound I a) -> Sound I a Source #
Access the samples of a sound.
The pulse version is slightly faster since you get a storable vector