module LambdaSound.Sound.Types where

import Control.DeepSeq (NFData)
import Data.Hashable (Hashable)
import Foreign.Storable (Storable)
import GHC.Generics (Generic)
import Data.Coerce (coerce)

-- | An audio sample
newtype Pulse = Pulse Float deriving (Int -> Pulse -> ShowS
[Pulse] -> ShowS
Pulse -> String
(Int -> Pulse -> ShowS)
-> (Pulse -> String) -> ([Pulse] -> ShowS) -> Show Pulse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pulse -> ShowS
showsPrec :: Int -> Pulse -> ShowS
$cshow :: Pulse -> String
show :: Pulse -> String
$cshowList :: [Pulse] -> ShowS
showList :: [Pulse] -> ShowS
Show, Pulse -> Pulse -> Bool
(Pulse -> Pulse -> Bool) -> (Pulse -> Pulse -> Bool) -> Eq Pulse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pulse -> Pulse -> Bool
== :: Pulse -> Pulse -> Bool
$c/= :: Pulse -> Pulse -> Bool
/= :: Pulse -> Pulse -> Bool
Eq, Fractional Pulse
Pulse
Fractional Pulse =>
Pulse
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse -> Pulse)
-> (Pulse -> Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> Floating Pulse
Pulse -> Pulse
Pulse -> Pulse -> Pulse
forall a.
Fractional a =>
a
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> Floating a
$cpi :: Pulse
pi :: Pulse
$cexp :: Pulse -> Pulse
exp :: Pulse -> Pulse
$clog :: Pulse -> Pulse
log :: Pulse -> Pulse
$csqrt :: Pulse -> Pulse
sqrt :: Pulse -> Pulse
$c** :: Pulse -> Pulse -> Pulse
** :: Pulse -> Pulse -> Pulse
$clogBase :: Pulse -> Pulse -> Pulse
logBase :: Pulse -> Pulse -> Pulse
$csin :: Pulse -> Pulse
sin :: Pulse -> Pulse
$ccos :: Pulse -> Pulse
cos :: Pulse -> Pulse
$ctan :: Pulse -> Pulse
tan :: Pulse -> Pulse
$casin :: Pulse -> Pulse
asin :: Pulse -> Pulse
$cacos :: Pulse -> Pulse
acos :: Pulse -> Pulse
$catan :: Pulse -> Pulse
atan :: Pulse -> Pulse
$csinh :: Pulse -> Pulse
sinh :: Pulse -> Pulse
$ccosh :: Pulse -> Pulse
cosh :: Pulse -> Pulse
$ctanh :: Pulse -> Pulse
tanh :: Pulse -> Pulse
$casinh :: Pulse -> Pulse
asinh :: Pulse -> Pulse
$cacosh :: Pulse -> Pulse
acosh :: Pulse -> Pulse
$catanh :: Pulse -> Pulse
atanh :: Pulse -> Pulse
$clog1p :: Pulse -> Pulse
log1p :: Pulse -> Pulse
$cexpm1 :: Pulse -> Pulse
expm1 :: Pulse -> Pulse
$clog1pexp :: Pulse -> Pulse
log1pexp :: Pulse -> Pulse
$clog1mexp :: Pulse -> Pulse
log1mexp :: Pulse -> Pulse
Floating, Integer -> Pulse
Pulse -> Pulse
Pulse -> Pulse -> Pulse
(Pulse -> Pulse -> Pulse)
-> (Pulse -> Pulse -> Pulse)
-> (Pulse -> Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Integer -> Pulse)
-> Num Pulse
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Pulse -> Pulse -> Pulse
+ :: Pulse -> Pulse -> Pulse
$c- :: Pulse -> Pulse -> Pulse
- :: Pulse -> Pulse -> Pulse
$c* :: Pulse -> Pulse -> Pulse
* :: Pulse -> Pulse -> Pulse
$cnegate :: Pulse -> Pulse
negate :: Pulse -> Pulse
$cabs :: Pulse -> Pulse
abs :: Pulse -> Pulse
$csignum :: Pulse -> Pulse
signum :: Pulse -> Pulse
$cfromInteger :: Integer -> Pulse
fromInteger :: Integer -> Pulse
Num, Num Pulse
Num Pulse =>
(Pulse -> Pulse -> Pulse)
-> (Pulse -> Pulse) -> (Rational -> Pulse) -> Fractional Pulse
Rational -> Pulse
Pulse -> Pulse
Pulse -> Pulse -> Pulse
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: Pulse -> Pulse -> Pulse
/ :: Pulse -> Pulse -> Pulse
$crecip :: Pulse -> Pulse
recip :: Pulse -> Pulse
$cfromRational :: Rational -> Pulse
fromRational :: Rational -> Pulse
Fractional, Eq Pulse
Eq Pulse =>
(Pulse -> Pulse -> Ordering)
-> (Pulse -> Pulse -> Bool)
-> (Pulse -> Pulse -> Bool)
-> (Pulse -> Pulse -> Bool)
-> (Pulse -> Pulse -> Bool)
-> (Pulse -> Pulse -> Pulse)
-> (Pulse -> Pulse -> Pulse)
-> Ord Pulse
Pulse -> Pulse -> Bool
Pulse -> Pulse -> Ordering
Pulse -> Pulse -> Pulse
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Pulse -> Pulse -> Ordering
compare :: Pulse -> Pulse -> Ordering
$c< :: Pulse -> Pulse -> Bool
< :: Pulse -> Pulse -> Bool
$c<= :: Pulse -> Pulse -> Bool
<= :: Pulse -> Pulse -> Bool
$c> :: Pulse -> Pulse -> Bool
> :: Pulse -> Pulse -> Bool
$c>= :: Pulse -> Pulse -> Bool
>= :: Pulse -> Pulse -> Bool
$cmax :: Pulse -> Pulse -> Pulse
max :: Pulse -> Pulse -> Pulse
$cmin :: Pulse -> Pulse -> Pulse
min :: Pulse -> Pulse -> Pulse
Ord, Num Pulse
Ord Pulse
(Num Pulse, Ord Pulse) => (Pulse -> Rational) -> Real Pulse
Pulse -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Pulse -> Rational
toRational :: Pulse -> Rational
Real, Fractional Pulse
Real Pulse
(Real Pulse, Fractional Pulse) =>
(forall b. Integral b => Pulse -> (b, Pulse))
-> (forall b. Integral b => Pulse -> b)
-> (forall b. Integral b => Pulse -> b)
-> (forall b. Integral b => Pulse -> b)
-> (forall b. Integral b => Pulse -> b)
-> RealFrac Pulse
forall b. Integral b => Pulse -> b
forall b. Integral b => Pulse -> (b, Pulse)
forall a.
(Real a, Fractional a) =>
(forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
$cproperFraction :: forall b. Integral b => Pulse -> (b, Pulse)
properFraction :: forall b. Integral b => Pulse -> (b, Pulse)
$ctruncate :: forall b. Integral b => Pulse -> b
truncate :: forall b. Integral b => Pulse -> b
$cround :: forall b. Integral b => Pulse -> b
round :: forall b. Integral b => Pulse -> b
$cceiling :: forall b. Integral b => Pulse -> b
ceiling :: forall b. Integral b => Pulse -> b
$cfloor :: forall b. Integral b => Pulse -> b
floor :: forall b. Integral b => Pulse -> b
RealFrac, Pulse -> ()
(Pulse -> ()) -> NFData Pulse
forall a. (a -> ()) -> NFData a
$crnf :: Pulse -> ()
rnf :: Pulse -> ()
NFData, Ptr Pulse -> IO Pulse
Ptr Pulse -> Int -> IO Pulse
Ptr Pulse -> Int -> Pulse -> IO ()
Ptr Pulse -> Pulse -> IO ()
Pulse -> Int
(Pulse -> Int)
-> (Pulse -> Int)
-> (Ptr Pulse -> Int -> IO Pulse)
-> (Ptr Pulse -> Int -> Pulse -> IO ())
-> (forall b. Ptr b -> Int -> IO Pulse)
-> (forall b. Ptr b -> Int -> Pulse -> IO ())
-> (Ptr Pulse -> IO Pulse)
-> (Ptr Pulse -> Pulse -> IO ())
-> Storable Pulse
forall b. Ptr b -> Int -> IO Pulse
forall b. Ptr b -> Int -> Pulse -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: Pulse -> Int
sizeOf :: Pulse -> Int
$calignment :: Pulse -> Int
alignment :: Pulse -> Int
$cpeekElemOff :: Ptr Pulse -> Int -> IO Pulse
peekElemOff :: Ptr Pulse -> Int -> IO Pulse
$cpokeElemOff :: Ptr Pulse -> Int -> Pulse -> IO ()
pokeElemOff :: Ptr Pulse -> Int -> Pulse -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Pulse
peekByteOff :: forall b. Ptr b -> Int -> IO Pulse
$cpokeByteOff :: forall b. Ptr b -> Int -> Pulse -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Pulse -> IO ()
$cpeek :: Ptr Pulse -> IO Pulse
peek :: Ptr Pulse -> IO Pulse
$cpoke :: Ptr Pulse -> Pulse -> IO ()
poke :: Ptr Pulse -> Pulse -> IO ()
Storable, Eq Pulse
Eq Pulse =>
(Int -> Pulse -> Int) -> (Pulse -> Int) -> Hashable Pulse
Int -> Pulse -> Int
Pulse -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Pulse -> Int
hashWithSalt :: Int -> Pulse -> Int
$chash :: Pulse -> Int
hash :: Pulse -> Int
Hashable, Int -> Pulse
Pulse -> Int
Pulse -> [Pulse]
Pulse -> Pulse
Pulse -> Pulse -> [Pulse]
Pulse -> Pulse -> Pulse -> [Pulse]
(Pulse -> Pulse)
-> (Pulse -> Pulse)
-> (Int -> Pulse)
-> (Pulse -> Int)
-> (Pulse -> [Pulse])
-> (Pulse -> Pulse -> [Pulse])
-> (Pulse -> Pulse -> [Pulse])
-> (Pulse -> Pulse -> Pulse -> [Pulse])
-> Enum Pulse
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Pulse -> Pulse
succ :: Pulse -> Pulse
$cpred :: Pulse -> Pulse
pred :: Pulse -> Pulse
$ctoEnum :: Int -> Pulse
toEnum :: Int -> Pulse
$cfromEnum :: Pulse -> Int
fromEnum :: Pulse -> Int
$cenumFrom :: Pulse -> [Pulse]
enumFrom :: Pulse -> [Pulse]
$cenumFromThen :: Pulse -> Pulse -> [Pulse]
enumFromThen :: Pulse -> Pulse -> [Pulse]
$cenumFromTo :: Pulse -> Pulse -> [Pulse]
enumFromTo :: Pulse -> Pulse -> [Pulse]
$cenumFromThenTo :: Pulse -> Pulse -> Pulse -> [Pulse]
enumFromThenTo :: Pulse -> Pulse -> Pulse -> [Pulse]
Enum)

-- | The duration of a 'Sound'
newtype Duration = Duration Float deriving (Int -> Duration -> ShowS
[Duration] -> ShowS
Duration -> String
(Int -> Duration -> ShowS)
-> (Duration -> String) -> ([Duration] -> ShowS) -> Show Duration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Duration -> ShowS
showsPrec :: Int -> Duration -> ShowS
$cshow :: Duration -> String
show :: Duration -> String
$cshowList :: [Duration] -> ShowS
showList :: [Duration] -> ShowS
Show, Duration -> Duration -> Bool
(Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool) -> Eq Duration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Duration -> Duration -> Bool
== :: Duration -> Duration -> Bool
$c/= :: Duration -> Duration -> Bool
/= :: Duration -> Duration -> Bool
Eq, Fractional Duration
Duration
Fractional Duration =>
Duration
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> Floating Duration
Duration -> Duration
Duration -> Duration -> Duration
forall a.
Fractional a =>
a
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> Floating a
$cpi :: Duration
pi :: Duration
$cexp :: Duration -> Duration
exp :: Duration -> Duration
$clog :: Duration -> Duration
log :: Duration -> Duration
$csqrt :: Duration -> Duration
sqrt :: Duration -> Duration
$c** :: Duration -> Duration -> Duration
** :: Duration -> Duration -> Duration
$clogBase :: Duration -> Duration -> Duration
logBase :: Duration -> Duration -> Duration
$csin :: Duration -> Duration
sin :: Duration -> Duration
$ccos :: Duration -> Duration
cos :: Duration -> Duration
$ctan :: Duration -> Duration
tan :: Duration -> Duration
$casin :: Duration -> Duration
asin :: Duration -> Duration
$cacos :: Duration -> Duration
acos :: Duration -> Duration
$catan :: Duration -> Duration
atan :: Duration -> Duration
$csinh :: Duration -> Duration
sinh :: Duration -> Duration
$ccosh :: Duration -> Duration
cosh :: Duration -> Duration
$ctanh :: Duration -> Duration
tanh :: Duration -> Duration
$casinh :: Duration -> Duration
asinh :: Duration -> Duration
$cacosh :: Duration -> Duration
acosh :: Duration -> Duration
$catanh :: Duration -> Duration
atanh :: Duration -> Duration
$clog1p :: Duration -> Duration
log1p :: Duration -> Duration
$cexpm1 :: Duration -> Duration
expm1 :: Duration -> Duration
$clog1pexp :: Duration -> Duration
log1pexp :: Duration -> Duration
$clog1mexp :: Duration -> Duration
log1mexp :: Duration -> Duration
Floating, Integer -> Duration
Duration -> Duration
Duration -> Duration -> Duration
(Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Duration -> Duration)
-> (Integer -> Duration)
-> Num Duration
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Duration -> Duration -> Duration
+ :: Duration -> Duration -> Duration
$c- :: Duration -> Duration -> Duration
- :: Duration -> Duration -> Duration
$c* :: Duration -> Duration -> Duration
* :: Duration -> Duration -> Duration
$cnegate :: Duration -> Duration
negate :: Duration -> Duration
$cabs :: Duration -> Duration
abs :: Duration -> Duration
$csignum :: Duration -> Duration
signum :: Duration -> Duration
$cfromInteger :: Integer -> Duration
fromInteger :: Integer -> Duration
Num, Num Duration
Num Duration =>
(Duration -> Duration -> Duration)
-> (Duration -> Duration)
-> (Rational -> Duration)
-> Fractional Duration
Rational -> Duration
Duration -> Duration
Duration -> Duration -> Duration
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: Duration -> Duration -> Duration
/ :: Duration -> Duration -> Duration
$crecip :: Duration -> Duration
recip :: Duration -> Duration
$cfromRational :: Rational -> Duration
fromRational :: Rational -> Duration
Fractional, Eq Duration
Eq Duration =>
(Duration -> Duration -> Ordering)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> Ord Duration
Duration -> Duration -> Bool
Duration -> Duration -> Ordering
Duration -> Duration -> Duration
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Duration -> Duration -> Ordering
compare :: Duration -> Duration -> Ordering
$c< :: Duration -> Duration -> Bool
< :: Duration -> Duration -> Bool
$c<= :: Duration -> Duration -> Bool
<= :: Duration -> Duration -> Bool
$c> :: Duration -> Duration -> Bool
> :: Duration -> Duration -> Bool
$c>= :: Duration -> Duration -> Bool
>= :: Duration -> Duration -> Bool
$cmax :: Duration -> Duration -> Duration
max :: Duration -> Duration -> Duration
$cmin :: Duration -> Duration -> Duration
min :: Duration -> Duration -> Duration
Ord, Num Duration
Ord Duration
(Num Duration, Ord Duration) =>
(Duration -> Rational) -> Real Duration
Duration -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Duration -> Rational
toRational :: Duration -> Rational
Real, Fractional Duration
Real Duration
(Real Duration, Fractional Duration) =>
(forall b. Integral b => Duration -> (b, Duration))
-> (forall b. Integral b => Duration -> b)
-> (forall b. Integral b => Duration -> b)
-> (forall b. Integral b => Duration -> b)
-> (forall b. Integral b => Duration -> b)
-> RealFrac Duration
forall b. Integral b => Duration -> b
forall b. Integral b => Duration -> (b, Duration)
forall a.
(Real a, Fractional a) =>
(forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
$cproperFraction :: forall b. Integral b => Duration -> (b, Duration)
properFraction :: forall b. Integral b => Duration -> (b, Duration)
$ctruncate :: forall b. Integral b => Duration -> b
truncate :: forall b. Integral b => Duration -> b
$cround :: forall b. Integral b => Duration -> b
round :: forall b. Integral b => Duration -> b
$cceiling :: forall b. Integral b => Duration -> b
ceiling :: forall b. Integral b => Duration -> b
$cfloor :: forall b. Integral b => Duration -> b
floor :: forall b. Integral b => Duration -> b
RealFrac, Duration -> ()
(Duration -> ()) -> NFData Duration
forall a. (a -> ()) -> NFData a
$crnf :: Duration -> ()
rnf :: Duration -> ()
NFData, Ptr Duration -> IO Duration
Ptr Duration -> Int -> IO Duration
Ptr Duration -> Int -> Duration -> IO ()
Ptr Duration -> Duration -> IO ()
Duration -> Int
(Duration -> Int)
-> (Duration -> Int)
-> (Ptr Duration -> Int -> IO Duration)
-> (Ptr Duration -> Int -> Duration -> IO ())
-> (forall b. Ptr b -> Int -> IO Duration)
-> (forall b. Ptr b -> Int -> Duration -> IO ())
-> (Ptr Duration -> IO Duration)
-> (Ptr Duration -> Duration -> IO ())
-> Storable Duration
forall b. Ptr b -> Int -> IO Duration
forall b. Ptr b -> Int -> Duration -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: Duration -> Int
sizeOf :: Duration -> Int
$calignment :: Duration -> Int
alignment :: Duration -> Int
$cpeekElemOff :: Ptr Duration -> Int -> IO Duration
peekElemOff :: Ptr Duration -> Int -> IO Duration
$cpokeElemOff :: Ptr Duration -> Int -> Duration -> IO ()
pokeElemOff :: Ptr Duration -> Int -> Duration -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Duration
peekByteOff :: forall b. Ptr b -> Int -> IO Duration
$cpokeByteOff :: forall b. Ptr b -> Int -> Duration -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Duration -> IO ()
$cpeek :: Ptr Duration -> IO Duration
peek :: Ptr Duration -> IO Duration
$cpoke :: Ptr Duration -> Duration -> IO ()
poke :: Ptr Duration -> Duration -> IO ()
Storable, Eq Duration
Eq Duration =>
(Int -> Duration -> Int) -> (Duration -> Int) -> Hashable Duration
Int -> Duration -> Int
Duration -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Duration -> Int
hashWithSalt :: Int -> Duration -> Int
$chash :: Duration -> Int
hash :: Duration -> Int
Hashable, Int -> Duration
Duration -> Int
Duration -> [Duration]
Duration -> Duration
Duration -> Duration -> [Duration]
Duration -> Duration -> Duration -> [Duration]
(Duration -> Duration)
-> (Duration -> Duration)
-> (Int -> Duration)
-> (Duration -> Int)
-> (Duration -> [Duration])
-> (Duration -> Duration -> [Duration])
-> (Duration -> Duration -> [Duration])
-> (Duration -> Duration -> Duration -> [Duration])
-> Enum Duration
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Duration -> Duration
succ :: Duration -> Duration
$cpred :: Duration -> Duration
pred :: Duration -> Duration
$ctoEnum :: Int -> Duration
toEnum :: Int -> Duration
$cfromEnum :: Duration -> Int
fromEnum :: Duration -> Int
$cenumFrom :: Duration -> [Duration]
enumFrom :: Duration -> [Duration]
$cenumFromThen :: Duration -> Duration -> [Duration]
enumFromThen :: Duration -> Duration -> [Duration]
$cenumFromTo :: Duration -> Duration -> [Duration]
enumFromTo :: Duration -> Duration -> [Duration]
$cenumFromThenTo :: Duration -> Duration -> Duration -> [Duration]
enumFromThenTo :: Duration -> Duration -> Duration -> [Duration]
Enum)

-- | The progress of a 'Sound'. A sound progresses from '0' to '1'
-- while it plays.
newtype Progress = Progress Float deriving (Int -> Progress -> ShowS
[Progress] -> ShowS
Progress -> String
(Int -> Progress -> ShowS)
-> (Progress -> String) -> ([Progress] -> ShowS) -> Show Progress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Progress -> ShowS
showsPrec :: Int -> Progress -> ShowS
$cshow :: Progress -> String
show :: Progress -> String
$cshowList :: [Progress] -> ShowS
showList :: [Progress] -> ShowS
Show, Progress -> Progress -> Bool
(Progress -> Progress -> Bool)
-> (Progress -> Progress -> Bool) -> Eq Progress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Progress -> Progress -> Bool
== :: Progress -> Progress -> Bool
$c/= :: Progress -> Progress -> Bool
/= :: Progress -> Progress -> Bool
Eq, Fractional Progress
Progress
Fractional Progress =>
Progress
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress -> Progress)
-> (Progress -> Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> Floating Progress
Progress -> Progress
Progress -> Progress -> Progress
forall a.
Fractional a =>
a
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> Floating a
$cpi :: Progress
pi :: Progress
$cexp :: Progress -> Progress
exp :: Progress -> Progress
$clog :: Progress -> Progress
log :: Progress -> Progress
$csqrt :: Progress -> Progress
sqrt :: Progress -> Progress
$c** :: Progress -> Progress -> Progress
** :: Progress -> Progress -> Progress
$clogBase :: Progress -> Progress -> Progress
logBase :: Progress -> Progress -> Progress
$csin :: Progress -> Progress
sin :: Progress -> Progress
$ccos :: Progress -> Progress
cos :: Progress -> Progress
$ctan :: Progress -> Progress
tan :: Progress -> Progress
$casin :: Progress -> Progress
asin :: Progress -> Progress
$cacos :: Progress -> Progress
acos :: Progress -> Progress
$catan :: Progress -> Progress
atan :: Progress -> Progress
$csinh :: Progress -> Progress
sinh :: Progress -> Progress
$ccosh :: Progress -> Progress
cosh :: Progress -> Progress
$ctanh :: Progress -> Progress
tanh :: Progress -> Progress
$casinh :: Progress -> Progress
asinh :: Progress -> Progress
$cacosh :: Progress -> Progress
acosh :: Progress -> Progress
$catanh :: Progress -> Progress
atanh :: Progress -> Progress
$clog1p :: Progress -> Progress
log1p :: Progress -> Progress
$cexpm1 :: Progress -> Progress
expm1 :: Progress -> Progress
$clog1pexp :: Progress -> Progress
log1pexp :: Progress -> Progress
$clog1mexp :: Progress -> Progress
log1mexp :: Progress -> Progress
Floating, Integer -> Progress
Progress -> Progress
Progress -> Progress -> Progress
(Progress -> Progress -> Progress)
-> (Progress -> Progress -> Progress)
-> (Progress -> Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Progress -> Progress)
-> (Integer -> Progress)
-> Num Progress
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Progress -> Progress -> Progress
+ :: Progress -> Progress -> Progress
$c- :: Progress -> Progress -> Progress
- :: Progress -> Progress -> Progress
$c* :: Progress -> Progress -> Progress
* :: Progress -> Progress -> Progress
$cnegate :: Progress -> Progress
negate :: Progress -> Progress
$cabs :: Progress -> Progress
abs :: Progress -> Progress
$csignum :: Progress -> Progress
signum :: Progress -> Progress
$cfromInteger :: Integer -> Progress
fromInteger :: Integer -> Progress
Num, Num Progress
Num Progress =>
(Progress -> Progress -> Progress)
-> (Progress -> Progress)
-> (Rational -> Progress)
-> Fractional Progress
Rational -> Progress
Progress -> Progress
Progress -> Progress -> Progress
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: Progress -> Progress -> Progress
/ :: Progress -> Progress -> Progress
$crecip :: Progress -> Progress
recip :: Progress -> Progress
$cfromRational :: Rational -> Progress
fromRational :: Rational -> Progress
Fractional, Eq Progress
Eq Progress =>
(Progress -> Progress -> Ordering)
-> (Progress -> Progress -> Bool)
-> (Progress -> Progress -> Bool)
-> (Progress -> Progress -> Bool)
-> (Progress -> Progress -> Bool)
-> (Progress -> Progress -> Progress)
-> (Progress -> Progress -> Progress)
-> Ord Progress
Progress -> Progress -> Bool
Progress -> Progress -> Ordering
Progress -> Progress -> Progress
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Progress -> Progress -> Ordering
compare :: Progress -> Progress -> Ordering
$c< :: Progress -> Progress -> Bool
< :: Progress -> Progress -> Bool
$c<= :: Progress -> Progress -> Bool
<= :: Progress -> Progress -> Bool
$c> :: Progress -> Progress -> Bool
> :: Progress -> Progress -> Bool
$c>= :: Progress -> Progress -> Bool
>= :: Progress -> Progress -> Bool
$cmax :: Progress -> Progress -> Progress
max :: Progress -> Progress -> Progress
$cmin :: Progress -> Progress -> Progress
min :: Progress -> Progress -> Progress
Ord, Num Progress
Ord Progress
(Num Progress, Ord Progress) =>
(Progress -> Rational) -> Real Progress
Progress -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Progress -> Rational
toRational :: Progress -> Rational
Real, Fractional Progress
Real Progress
(Real Progress, Fractional Progress) =>
(forall b. Integral b => Progress -> (b, Progress))
-> (forall b. Integral b => Progress -> b)
-> (forall b. Integral b => Progress -> b)
-> (forall b. Integral b => Progress -> b)
-> (forall b. Integral b => Progress -> b)
-> RealFrac Progress
forall b. Integral b => Progress -> b
forall b. Integral b => Progress -> (b, Progress)
forall a.
(Real a, Fractional a) =>
(forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
$cproperFraction :: forall b. Integral b => Progress -> (b, Progress)
properFraction :: forall b. Integral b => Progress -> (b, Progress)
$ctruncate :: forall b. Integral b => Progress -> b
truncate :: forall b. Integral b => Progress -> b
$cround :: forall b. Integral b => Progress -> b
round :: forall b. Integral b => Progress -> b
$cceiling :: forall b. Integral b => Progress -> b
ceiling :: forall b. Integral b => Progress -> b
$cfloor :: forall b. Integral b => Progress -> b
floor :: forall b. Integral b => Progress -> b
RealFrac, Progress -> ()
(Progress -> ()) -> NFData Progress
forall a. (a -> ()) -> NFData a
$crnf :: Progress -> ()
rnf :: Progress -> ()
NFData, Ptr Progress -> IO Progress
Ptr Progress -> Int -> IO Progress
Ptr Progress -> Int -> Progress -> IO ()
Ptr Progress -> Progress -> IO ()
Progress -> Int
(Progress -> Int)
-> (Progress -> Int)
-> (Ptr Progress -> Int -> IO Progress)
-> (Ptr Progress -> Int -> Progress -> IO ())
-> (forall b. Ptr b -> Int -> IO Progress)
-> (forall b. Ptr b -> Int -> Progress -> IO ())
-> (Ptr Progress -> IO Progress)
-> (Ptr Progress -> Progress -> IO ())
-> Storable Progress
forall b. Ptr b -> Int -> IO Progress
forall b. Ptr b -> Int -> Progress -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: Progress -> Int
sizeOf :: Progress -> Int
$calignment :: Progress -> Int
alignment :: Progress -> Int
$cpeekElemOff :: Ptr Progress -> Int -> IO Progress
peekElemOff :: Ptr Progress -> Int -> IO Progress
$cpokeElemOff :: Ptr Progress -> Int -> Progress -> IO ()
pokeElemOff :: Ptr Progress -> Int -> Progress -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Progress
peekByteOff :: forall b. Ptr b -> Int -> IO Progress
$cpokeByteOff :: forall b. Ptr b -> Int -> Progress -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Progress -> IO ()
$cpeek :: Ptr Progress -> IO Progress
peek :: Ptr Progress -> IO Progress
$cpoke :: Ptr Progress -> Progress -> IO ()
poke :: Ptr Progress -> Progress -> IO ()
Storable, Eq Progress
Eq Progress =>
(Int -> Progress -> Int) -> (Progress -> Int) -> Hashable Progress
Int -> Progress -> Int
Progress -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Progress -> Int
hashWithSalt :: Int -> Progress -> Int
$chash :: Progress -> Int
hash :: Progress -> Int
Hashable, Int -> Progress
Progress -> Int
Progress -> [Progress]
Progress -> Progress
Progress -> Progress -> [Progress]
Progress -> Progress -> Progress -> [Progress]
(Progress -> Progress)
-> (Progress -> Progress)
-> (Int -> Progress)
-> (Progress -> Int)
-> (Progress -> [Progress])
-> (Progress -> Progress -> [Progress])
-> (Progress -> Progress -> [Progress])
-> (Progress -> Progress -> Progress -> [Progress])
-> Enum Progress
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Progress -> Progress
succ :: Progress -> Progress
$cpred :: Progress -> Progress
pred :: Progress -> Progress
$ctoEnum :: Int -> Progress
toEnum :: Int -> Progress
$cfromEnum :: Progress -> Int
fromEnum :: Progress -> Int
$cenumFrom :: Progress -> [Progress]
enumFrom :: Progress -> [Progress]
$cenumFromThen :: Progress -> Progress -> [Progress]
enumFromThen :: Progress -> Progress -> [Progress]
$cenumFromTo :: Progress -> Progress -> [Progress]
enumFromTo :: Progress -> Progress -> [Progress]
$cenumFromThenTo :: Progress -> Progress -> Progress -> [Progress]
enumFromThenTo :: Progress -> Progress -> Progress -> [Progress]
Enum)

-- | The percentage of a 'Sound'. '0.3' corresponds to 30% of a 'Sound'.
newtype Percentage = Percentage Float deriving (Int -> Percentage -> ShowS
[Percentage] -> ShowS
Percentage -> String
(Int -> Percentage -> ShowS)
-> (Percentage -> String)
-> ([Percentage] -> ShowS)
-> Show Percentage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Percentage -> ShowS
showsPrec :: Int -> Percentage -> ShowS
$cshow :: Percentage -> String
show :: Percentage -> String
$cshowList :: [Percentage] -> ShowS
showList :: [Percentage] -> ShowS
Show, Percentage -> Percentage -> Bool
(Percentage -> Percentage -> Bool)
-> (Percentage -> Percentage -> Bool) -> Eq Percentage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Percentage -> Percentage -> Bool
== :: Percentage -> Percentage -> Bool
$c/= :: Percentage -> Percentage -> Bool
/= :: Percentage -> Percentage -> Bool
Eq, Fractional Percentage
Percentage
Fractional Percentage =>
Percentage
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage -> Percentage)
-> (Percentage -> Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> Floating Percentage
Percentage -> Percentage
Percentage -> Percentage -> Percentage
forall a.
Fractional a =>
a
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> Floating a
$cpi :: Percentage
pi :: Percentage
$cexp :: Percentage -> Percentage
exp :: Percentage -> Percentage
$clog :: Percentage -> Percentage
log :: Percentage -> Percentage
$csqrt :: Percentage -> Percentage
sqrt :: Percentage -> Percentage
$c** :: Percentage -> Percentage -> Percentage
** :: Percentage -> Percentage -> Percentage
$clogBase :: Percentage -> Percentage -> Percentage
logBase :: Percentage -> Percentage -> Percentage
$csin :: Percentage -> Percentage
sin :: Percentage -> Percentage
$ccos :: Percentage -> Percentage
cos :: Percentage -> Percentage
$ctan :: Percentage -> Percentage
tan :: Percentage -> Percentage
$casin :: Percentage -> Percentage
asin :: Percentage -> Percentage
$cacos :: Percentage -> Percentage
acos :: Percentage -> Percentage
$catan :: Percentage -> Percentage
atan :: Percentage -> Percentage
$csinh :: Percentage -> Percentage
sinh :: Percentage -> Percentage
$ccosh :: Percentage -> Percentage
cosh :: Percentage -> Percentage
$ctanh :: Percentage -> Percentage
tanh :: Percentage -> Percentage
$casinh :: Percentage -> Percentage
asinh :: Percentage -> Percentage
$cacosh :: Percentage -> Percentage
acosh :: Percentage -> Percentage
$catanh :: Percentage -> Percentage
atanh :: Percentage -> Percentage
$clog1p :: Percentage -> Percentage
log1p :: Percentage -> Percentage
$cexpm1 :: Percentage -> Percentage
expm1 :: Percentage -> Percentage
$clog1pexp :: Percentage -> Percentage
log1pexp :: Percentage -> Percentage
$clog1mexp :: Percentage -> Percentage
log1mexp :: Percentage -> Percentage
Floating, Integer -> Percentage
Percentage -> Percentage
Percentage -> Percentage -> Percentage
(Percentage -> Percentage -> Percentage)
-> (Percentage -> Percentage -> Percentage)
-> (Percentage -> Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Integer -> Percentage)
-> Num Percentage
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Percentage -> Percentage -> Percentage
+ :: Percentage -> Percentage -> Percentage
$c- :: Percentage -> Percentage -> Percentage
- :: Percentage -> Percentage -> Percentage
$c* :: Percentage -> Percentage -> Percentage
* :: Percentage -> Percentage -> Percentage
$cnegate :: Percentage -> Percentage
negate :: Percentage -> Percentage
$cabs :: Percentage -> Percentage
abs :: Percentage -> Percentage
$csignum :: Percentage -> Percentage
signum :: Percentage -> Percentage
$cfromInteger :: Integer -> Percentage
fromInteger :: Integer -> Percentage
Num, Num Percentage
Num Percentage =>
(Percentage -> Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Rational -> Percentage)
-> Fractional Percentage
Rational -> Percentage
Percentage -> Percentage
Percentage -> Percentage -> Percentage
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: Percentage -> Percentage -> Percentage
/ :: Percentage -> Percentage -> Percentage
$crecip :: Percentage -> Percentage
recip :: Percentage -> Percentage
$cfromRational :: Rational -> Percentage
fromRational :: Rational -> Percentage
Fractional, Eq Percentage
Eq Percentage =>
(Percentage -> Percentage -> Ordering)
-> (Percentage -> Percentage -> Bool)
-> (Percentage -> Percentage -> Bool)
-> (Percentage -> Percentage -> Bool)
-> (Percentage -> Percentage -> Bool)
-> (Percentage -> Percentage -> Percentage)
-> (Percentage -> Percentage -> Percentage)
-> Ord Percentage
Percentage -> Percentage -> Bool
Percentage -> Percentage -> Ordering
Percentage -> Percentage -> Percentage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Percentage -> Percentage -> Ordering
compare :: Percentage -> Percentage -> Ordering
$c< :: Percentage -> Percentage -> Bool
< :: Percentage -> Percentage -> Bool
$c<= :: Percentage -> Percentage -> Bool
<= :: Percentage -> Percentage -> Bool
$c> :: Percentage -> Percentage -> Bool
> :: Percentage -> Percentage -> Bool
$c>= :: Percentage -> Percentage -> Bool
>= :: Percentage -> Percentage -> Bool
$cmax :: Percentage -> Percentage -> Percentage
max :: Percentage -> Percentage -> Percentage
$cmin :: Percentage -> Percentage -> Percentage
min :: Percentage -> Percentage -> Percentage
Ord, Num Percentage
Ord Percentage
(Num Percentage, Ord Percentage) =>
(Percentage -> Rational) -> Real Percentage
Percentage -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Percentage -> Rational
toRational :: Percentage -> Rational
Real, Fractional Percentage
Real Percentage
(Real Percentage, Fractional Percentage) =>
(forall b. Integral b => Percentage -> (b, Percentage))
-> (forall b. Integral b => Percentage -> b)
-> (forall b. Integral b => Percentage -> b)
-> (forall b. Integral b => Percentage -> b)
-> (forall b. Integral b => Percentage -> b)
-> RealFrac Percentage
forall b. Integral b => Percentage -> b
forall b. Integral b => Percentage -> (b, Percentage)
forall a.
(Real a, Fractional a) =>
(forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
$cproperFraction :: forall b. Integral b => Percentage -> (b, Percentage)
properFraction :: forall b. Integral b => Percentage -> (b, Percentage)
$ctruncate :: forall b. Integral b => Percentage -> b
truncate :: forall b. Integral b => Percentage -> b
$cround :: forall b. Integral b => Percentage -> b
round :: forall b. Integral b => Percentage -> b
$cceiling :: forall b. Integral b => Percentage -> b
ceiling :: forall b. Integral b => Percentage -> b
$cfloor :: forall b. Integral b => Percentage -> b
floor :: forall b. Integral b => Percentage -> b
RealFrac, Percentage -> ()
(Percentage -> ()) -> NFData Percentage
forall a. (a -> ()) -> NFData a
$crnf :: Percentage -> ()
rnf :: Percentage -> ()
NFData, Ptr Percentage -> IO Percentage
Ptr Percentage -> Int -> IO Percentage
Ptr Percentage -> Int -> Percentage -> IO ()
Ptr Percentage -> Percentage -> IO ()
Percentage -> Int
(Percentage -> Int)
-> (Percentage -> Int)
-> (Ptr Percentage -> Int -> IO Percentage)
-> (Ptr Percentage -> Int -> Percentage -> IO ())
-> (forall b. Ptr b -> Int -> IO Percentage)
-> (forall b. Ptr b -> Int -> Percentage -> IO ())
-> (Ptr Percentage -> IO Percentage)
-> (Ptr Percentage -> Percentage -> IO ())
-> Storable Percentage
forall b. Ptr b -> Int -> IO Percentage
forall b. Ptr b -> Int -> Percentage -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: Percentage -> Int
sizeOf :: Percentage -> Int
$calignment :: Percentage -> Int
alignment :: Percentage -> Int
$cpeekElemOff :: Ptr Percentage -> Int -> IO Percentage
peekElemOff :: Ptr Percentage -> Int -> IO Percentage
$cpokeElemOff :: Ptr Percentage -> Int -> Percentage -> IO ()
pokeElemOff :: Ptr Percentage -> Int -> Percentage -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Percentage
peekByteOff :: forall b. Ptr b -> Int -> IO Percentage
$cpokeByteOff :: forall b. Ptr b -> Int -> Percentage -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Percentage -> IO ()
$cpeek :: Ptr Percentage -> IO Percentage
peek :: Ptr Percentage -> IO Percentage
$cpoke :: Ptr Percentage -> Percentage -> IO ()
poke :: Ptr Percentage -> Percentage -> IO ()
Storable, Eq Percentage
Eq Percentage =>
(Int -> Percentage -> Int)
-> (Percentage -> Int) -> Hashable Percentage
Int -> Percentage -> Int
Percentage -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Percentage -> Int
hashWithSalt :: Int -> Percentage -> Int
$chash :: Percentage -> Int
hash :: Percentage -> Int
Hashable, Int -> Percentage
Percentage -> Int
Percentage -> [Percentage]
Percentage -> Percentage
Percentage -> Percentage -> [Percentage]
Percentage -> Percentage -> Percentage -> [Percentage]
(Percentage -> Percentage)
-> (Percentage -> Percentage)
-> (Int -> Percentage)
-> (Percentage -> Int)
-> (Percentage -> [Percentage])
-> (Percentage -> Percentage -> [Percentage])
-> (Percentage -> Percentage -> [Percentage])
-> (Percentage -> Percentage -> Percentage -> [Percentage])
-> Enum Percentage
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Percentage -> Percentage
succ :: Percentage -> Percentage
$cpred :: Percentage -> Percentage
pred :: Percentage -> Percentage
$ctoEnum :: Int -> Percentage
toEnum :: Int -> Percentage
$cfromEnum :: Percentage -> Int
fromEnum :: Percentage -> Int
$cenumFrom :: Percentage -> [Percentage]
enumFrom :: Percentage -> [Percentage]
$cenumFromThen :: Percentage -> Percentage -> [Percentage]
enumFromThen :: Percentage -> Percentage -> [Percentage]
$cenumFromTo :: Percentage -> Percentage -> [Percentage]
enumFromTo :: Percentage -> Percentage -> [Percentage]
$cenumFromThenTo :: Percentage -> Percentage -> Percentage -> [Percentage]
enumFromThenTo :: Percentage -> Percentage -> Percentage -> [Percentage]
Enum)

-- | Hz are the unit for frequencies. 440 Hz means that 440 oscillations happen per second
newtype Hz = Hz Float deriving (Int -> Hz -> ShowS
[Hz] -> ShowS
Hz -> String
(Int -> Hz -> ShowS)
-> (Hz -> String) -> ([Hz] -> ShowS) -> Show Hz
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hz -> ShowS
showsPrec :: Int -> Hz -> ShowS
$cshow :: Hz -> String
show :: Hz -> String
$cshowList :: [Hz] -> ShowS
showList :: [Hz] -> ShowS
Show, Hz -> Hz -> Bool
(Hz -> Hz -> Bool) -> (Hz -> Hz -> Bool) -> Eq Hz
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hz -> Hz -> Bool
== :: Hz -> Hz -> Bool
$c/= :: Hz -> Hz -> Bool
/= :: Hz -> Hz -> Bool
Eq, Eq Hz
Eq Hz =>
(Hz -> Hz -> Ordering)
-> (Hz -> Hz -> Bool)
-> (Hz -> Hz -> Bool)
-> (Hz -> Hz -> Bool)
-> (Hz -> Hz -> Bool)
-> (Hz -> Hz -> Hz)
-> (Hz -> Hz -> Hz)
-> Ord Hz
Hz -> Hz -> Bool
Hz -> Hz -> Ordering
Hz -> Hz -> Hz
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Hz -> Hz -> Ordering
compare :: Hz -> Hz -> Ordering
$c< :: Hz -> Hz -> Bool
< :: Hz -> Hz -> Bool
$c<= :: Hz -> Hz -> Bool
<= :: Hz -> Hz -> Bool
$c> :: Hz -> Hz -> Bool
> :: Hz -> Hz -> Bool
$c>= :: Hz -> Hz -> Bool
>= :: Hz -> Hz -> Bool
$cmax :: Hz -> Hz -> Hz
max :: Hz -> Hz -> Hz
$cmin :: Hz -> Hz -> Hz
min :: Hz -> Hz -> Hz
Ord, Integer -> Hz
Hz -> Hz
Hz -> Hz -> Hz
(Hz -> Hz -> Hz)
-> (Hz -> Hz -> Hz)
-> (Hz -> Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Integer -> Hz)
-> Num Hz
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Hz -> Hz -> Hz
+ :: Hz -> Hz -> Hz
$c- :: Hz -> Hz -> Hz
- :: Hz -> Hz -> Hz
$c* :: Hz -> Hz -> Hz
* :: Hz -> Hz -> Hz
$cnegate :: Hz -> Hz
negate :: Hz -> Hz
$cabs :: Hz -> Hz
abs :: Hz -> Hz
$csignum :: Hz -> Hz
signum :: Hz -> Hz
$cfromInteger :: Integer -> Hz
fromInteger :: Integer -> Hz
Num, Num Hz
Num Hz =>
(Hz -> Hz -> Hz) -> (Hz -> Hz) -> (Rational -> Hz) -> Fractional Hz
Rational -> Hz
Hz -> Hz
Hz -> Hz -> Hz
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: Hz -> Hz -> Hz
/ :: Hz -> Hz -> Hz
$crecip :: Hz -> Hz
recip :: Hz -> Hz
$cfromRational :: Rational -> Hz
fromRational :: Rational -> Hz
Fractional, Fractional Hz
Hz
Fractional Hz =>
Hz
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz -> Hz)
-> (Hz -> Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> (Hz -> Hz)
-> Floating Hz
Hz -> Hz
Hz -> Hz -> Hz
forall a.
Fractional a =>
a
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> Floating a
$cpi :: Hz
pi :: Hz
$cexp :: Hz -> Hz
exp :: Hz -> Hz
$clog :: Hz -> Hz
log :: Hz -> Hz
$csqrt :: Hz -> Hz
sqrt :: Hz -> Hz
$c** :: Hz -> Hz -> Hz
** :: Hz -> Hz -> Hz
$clogBase :: Hz -> Hz -> Hz
logBase :: Hz -> Hz -> Hz
$csin :: Hz -> Hz
sin :: Hz -> Hz
$ccos :: Hz -> Hz
cos :: Hz -> Hz
$ctan :: Hz -> Hz
tan :: Hz -> Hz
$casin :: Hz -> Hz
asin :: Hz -> Hz
$cacos :: Hz -> Hz
acos :: Hz -> Hz
$catan :: Hz -> Hz
atan :: Hz -> Hz
$csinh :: Hz -> Hz
sinh :: Hz -> Hz
$ccosh :: Hz -> Hz
cosh :: Hz -> Hz
$ctanh :: Hz -> Hz
tanh :: Hz -> Hz
$casinh :: Hz -> Hz
asinh :: Hz -> Hz
$cacosh :: Hz -> Hz
acosh :: Hz -> Hz
$catanh :: Hz -> Hz
atanh :: Hz -> Hz
$clog1p :: Hz -> Hz
log1p :: Hz -> Hz
$cexpm1 :: Hz -> Hz
expm1 :: Hz -> Hz
$clog1pexp :: Hz -> Hz
log1pexp :: Hz -> Hz
$clog1mexp :: Hz -> Hz
log1mexp :: Hz -> Hz
Floating, Int -> Hz
Hz -> Int
Hz -> [Hz]
Hz -> Hz
Hz -> Hz -> [Hz]
Hz -> Hz -> Hz -> [Hz]
(Hz -> Hz)
-> (Hz -> Hz)
-> (Int -> Hz)
-> (Hz -> Int)
-> (Hz -> [Hz])
-> (Hz -> Hz -> [Hz])
-> (Hz -> Hz -> [Hz])
-> (Hz -> Hz -> Hz -> [Hz])
-> Enum Hz
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Hz -> Hz
succ :: Hz -> Hz
$cpred :: Hz -> Hz
pred :: Hz -> Hz
$ctoEnum :: Int -> Hz
toEnum :: Int -> Hz
$cfromEnum :: Hz -> Int
fromEnum :: Hz -> Int
$cenumFrom :: Hz -> [Hz]
enumFrom :: Hz -> [Hz]
$cenumFromThen :: Hz -> Hz -> [Hz]
enumFromThen :: Hz -> Hz -> [Hz]
$cenumFromTo :: Hz -> Hz -> [Hz]
enumFromTo :: Hz -> Hz -> [Hz]
$cenumFromThenTo :: Hz -> Hz -> Hz -> [Hz]
enumFromThenTo :: Hz -> Hz -> Hz -> [Hz]
Enum, (forall x. Hz -> Rep Hz x)
-> (forall x. Rep Hz x -> Hz) -> Generic Hz
forall x. Rep Hz x -> Hz
forall x. Hz -> Rep Hz x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Hz -> Rep Hz x
from :: forall x. Hz -> Rep Hz x
$cto :: forall x. Rep Hz x -> Hz
to :: forall x. Rep Hz x -> Hz
Generic, Num Hz
Ord Hz
(Num Hz, Ord Hz) => (Hz -> Rational) -> Real Hz
Hz -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Hz -> Rational
toRational :: Hz -> Rational
Real, Fractional Hz
Real Hz
(Real Hz, Fractional Hz) =>
(forall b. Integral b => Hz -> (b, Hz))
-> (forall b. Integral b => Hz -> b)
-> (forall b. Integral b => Hz -> b)
-> (forall b. Integral b => Hz -> b)
-> (forall b. Integral b => Hz -> b)
-> RealFrac Hz
forall b. Integral b => Hz -> b
forall b. Integral b => Hz -> (b, Hz)
forall a.
(Real a, Fractional a) =>
(forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
$cproperFraction :: forall b. Integral b => Hz -> (b, Hz)
properFraction :: forall b. Integral b => Hz -> (b, Hz)
$ctruncate :: forall b. Integral b => Hz -> b
truncate :: forall b. Integral b => Hz -> b
$cround :: forall b. Integral b => Hz -> b
round :: forall b. Integral b => Hz -> b
$cceiling :: forall b. Integral b => Hz -> b
ceiling :: forall b. Integral b => Hz -> b
$cfloor :: forall b. Integral b => Hz -> b
floor :: forall b. Integral b => Hz -> b
RealFrac)

-- | 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' 
newtype Time = Time Float deriving (Int -> Time -> ShowS
[Time] -> ShowS
Time -> String
(Int -> Time -> ShowS)
-> (Time -> String) -> ([Time] -> ShowS) -> Show Time
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Time -> ShowS
showsPrec :: Int -> Time -> ShowS
$cshow :: Time -> String
show :: Time -> String
$cshowList :: [Time] -> ShowS
showList :: [Time] -> ShowS
Show, Time -> Time -> Bool
(Time -> Time -> Bool) -> (Time -> Time -> Bool) -> Eq Time
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Time -> Time -> Bool
== :: Time -> Time -> Bool
$c/= :: Time -> Time -> Bool
/= :: Time -> Time -> Bool
Eq, Fractional Time
Time
Fractional Time =>
Time
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time -> Time)
-> (Time -> Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> Floating Time
Time -> Time
Time -> Time -> Time
forall a.
Fractional a =>
a
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> Floating a
$cpi :: Time
pi :: Time
$cexp :: Time -> Time
exp :: Time -> Time
$clog :: Time -> Time
log :: Time -> Time
$csqrt :: Time -> Time
sqrt :: Time -> Time
$c** :: Time -> Time -> Time
** :: Time -> Time -> Time
$clogBase :: Time -> Time -> Time
logBase :: Time -> Time -> Time
$csin :: Time -> Time
sin :: Time -> Time
$ccos :: Time -> Time
cos :: Time -> Time
$ctan :: Time -> Time
tan :: Time -> Time
$casin :: Time -> Time
asin :: Time -> Time
$cacos :: Time -> Time
acos :: Time -> Time
$catan :: Time -> Time
atan :: Time -> Time
$csinh :: Time -> Time
sinh :: Time -> Time
$ccosh :: Time -> Time
cosh :: Time -> Time
$ctanh :: Time -> Time
tanh :: Time -> Time
$casinh :: Time -> Time
asinh :: Time -> Time
$cacosh :: Time -> Time
acosh :: Time -> Time
$catanh :: Time -> Time
atanh :: Time -> Time
$clog1p :: Time -> Time
log1p :: Time -> Time
$cexpm1 :: Time -> Time
expm1 :: Time -> Time
$clog1pexp :: Time -> Time
log1pexp :: Time -> Time
$clog1mexp :: Time -> Time
log1mexp :: Time -> Time
Floating, Integer -> Time
Time -> Time
Time -> Time -> Time
(Time -> Time -> Time)
-> (Time -> Time -> Time)
-> (Time -> Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Time -> Time)
-> (Integer -> Time)
-> Num Time
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Time -> Time -> Time
+ :: Time -> Time -> Time
$c- :: Time -> Time -> Time
- :: Time -> Time -> Time
$c* :: Time -> Time -> Time
* :: Time -> Time -> Time
$cnegate :: Time -> Time
negate :: Time -> Time
$cabs :: Time -> Time
abs :: Time -> Time
$csignum :: Time -> Time
signum :: Time -> Time
$cfromInteger :: Integer -> Time
fromInteger :: Integer -> Time
Num, Num Time
Num Time =>
(Time -> Time -> Time)
-> (Time -> Time) -> (Rational -> Time) -> Fractional Time
Rational -> Time
Time -> Time
Time -> Time -> Time
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: Time -> Time -> Time
/ :: Time -> Time -> Time
$crecip :: Time -> Time
recip :: Time -> Time
$cfromRational :: Rational -> Time
fromRational :: Rational -> Time
Fractional, Eq Time
Eq Time =>
(Time -> Time -> Ordering)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Time)
-> (Time -> Time -> Time)
-> Ord Time
Time -> Time -> Bool
Time -> Time -> Ordering
Time -> Time -> Time
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Time -> Time -> Ordering
compare :: Time -> Time -> Ordering
$c< :: Time -> Time -> Bool
< :: Time -> Time -> Bool
$c<= :: Time -> Time -> Bool
<= :: Time -> Time -> Bool
$c> :: Time -> Time -> Bool
> :: Time -> Time -> Bool
$c>= :: Time -> Time -> Bool
>= :: Time -> Time -> Bool
$cmax :: Time -> Time -> Time
max :: Time -> Time -> Time
$cmin :: Time -> Time -> Time
min :: Time -> Time -> Time
Ord, Num Time
Ord Time
(Num Time, Ord Time) => (Time -> Rational) -> Real Time
Time -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Time -> Rational
toRational :: Time -> Rational
Real, Fractional Time
Real Time
(Real Time, Fractional Time) =>
(forall b. Integral b => Time -> (b, Time))
-> (forall b. Integral b => Time -> b)
-> (forall b. Integral b => Time -> b)
-> (forall b. Integral b => Time -> b)
-> (forall b. Integral b => Time -> b)
-> RealFrac Time
forall b. Integral b => Time -> b
forall b. Integral b => Time -> (b, Time)
forall a.
(Real a, Fractional a) =>
(forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
$cproperFraction :: forall b. Integral b => Time -> (b, Time)
properFraction :: forall b. Integral b => Time -> (b, Time)
$ctruncate :: forall b. Integral b => Time -> b
truncate :: forall b. Integral b => Time -> b
$cround :: forall b. Integral b => Time -> b
round :: forall b. Integral b => Time -> b
$cceiling :: forall b. Integral b => Time -> b
ceiling :: forall b. Integral b => Time -> b
$cfloor :: forall b. Integral b => Time -> b
floor :: forall b. Integral b => Time -> b
RealFrac, Time -> ()
(Time -> ()) -> NFData Time
forall a. (a -> ()) -> NFData a
$crnf :: Time -> ()
rnf :: Time -> ()
NFData, Ptr Time -> IO Time
Ptr Time -> Int -> IO Time
Ptr Time -> Int -> Time -> IO ()
Ptr Time -> Time -> IO ()
Time -> Int
(Time -> Int)
-> (Time -> Int)
-> (Ptr Time -> Int -> IO Time)
-> (Ptr Time -> Int -> Time -> IO ())
-> (forall b. Ptr b -> Int -> IO Time)
-> (forall b. Ptr b -> Int -> Time -> IO ())
-> (Ptr Time -> IO Time)
-> (Ptr Time -> Time -> IO ())
-> Storable Time
forall b. Ptr b -> Int -> IO Time
forall b. Ptr b -> Int -> Time -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: Time -> Int
sizeOf :: Time -> Int
$calignment :: Time -> Int
alignment :: Time -> Int
$cpeekElemOff :: Ptr Time -> Int -> IO Time
peekElemOff :: Ptr Time -> Int -> IO Time
$cpokeElemOff :: Ptr Time -> Int -> Time -> IO ()
pokeElemOff :: Ptr Time -> Int -> Time -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Time
peekByteOff :: forall b. Ptr b -> Int -> IO Time
$cpokeByteOff :: forall b. Ptr b -> Int -> Time -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Time -> IO ()
$cpeek :: Ptr Time -> IO Time
peek :: Ptr Time -> IO Time
$cpoke :: Ptr Time -> Time -> IO ()
poke :: Ptr Time -> Time -> IO ()
Storable, Eq Time
Eq Time => (Int -> Time -> Int) -> (Time -> Int) -> Hashable Time
Int -> Time -> Int
Time -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Time -> Int
hashWithSalt :: Int -> Time -> Int
$chash :: Time -> Int
hash :: Time -> Int
Hashable, Int -> Time
Time -> Int
Time -> [Time]
Time -> Time
Time -> Time -> [Time]
Time -> Time -> Time -> [Time]
(Time -> Time)
-> (Time -> Time)
-> (Int -> Time)
-> (Time -> Int)
-> (Time -> [Time])
-> (Time -> Time -> [Time])
-> (Time -> Time -> [Time])
-> (Time -> Time -> Time -> [Time])
-> Enum Time
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Time -> Time
succ :: Time -> Time
$cpred :: Time -> Time
pred :: Time -> Time
$ctoEnum :: Int -> Time
toEnum :: Int -> Time
$cfromEnum :: Time -> Int
fromEnum :: Time -> Int
$cenumFrom :: Time -> [Time]
enumFrom :: Time -> [Time]
$cenumFromThen :: Time -> Time -> [Time]
enumFromThen :: Time -> Time -> [Time]
$cenumFromTo :: Time -> Time -> [Time]
enumFromTo :: Time -> Time -> [Time]
$cenumFromThenTo :: Time -> Time -> Time -> [Time]
enumFromThenTo :: Time -> Time -> Time -> [Time]
Enum)

-- | Gives information about how many samples are needed during computation
data SamplingInfo = SamplingInfo
  { SamplingInfo -> Float
period :: !Float,
    SamplingInfo -> Hz
sampleRate :: Hz,
    SamplingInfo -> Int
samples :: Int
  }
  deriving ((forall x. SamplingInfo -> Rep SamplingInfo x)
-> (forall x. Rep SamplingInfo x -> SamplingInfo)
-> Generic SamplingInfo
forall x. Rep SamplingInfo x -> SamplingInfo
forall x. SamplingInfo -> Rep SamplingInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SamplingInfo -> Rep SamplingInfo x
from :: forall x. SamplingInfo -> Rep SamplingInfo x
$cto :: forall x. Rep SamplingInfo x -> SamplingInfo
to :: forall x. Rep SamplingInfo x -> SamplingInfo
Generic, Int -> SamplingInfo -> ShowS
[SamplingInfo] -> ShowS
SamplingInfo -> String
(Int -> SamplingInfo -> ShowS)
-> (SamplingInfo -> String)
-> ([SamplingInfo] -> ShowS)
-> Show SamplingInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SamplingInfo -> ShowS
showsPrec :: Int -> SamplingInfo -> ShowS
$cshow :: SamplingInfo -> String
show :: SamplingInfo -> String
$cshowList :: [SamplingInfo] -> ShowS
showList :: [SamplingInfo] -> ShowS
Show, SamplingInfo -> SamplingInfo -> Bool
(SamplingInfo -> SamplingInfo -> Bool)
-> (SamplingInfo -> SamplingInfo -> Bool) -> Eq SamplingInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SamplingInfo -> SamplingInfo -> Bool
== :: SamplingInfo -> SamplingInfo -> Bool
$c/= :: SamplingInfo -> SamplingInfo -> Bool
/= :: SamplingInfo -> SamplingInfo -> Bool
Eq)

instance Hashable Hz

instance Hashable SamplingInfo where

makeSamplingInfo :: Hz -> Duration -> SamplingInfo
makeSamplingInfo :: Hz -> Duration -> SamplingInfo
makeSamplingInfo Hz
hz Duration
duration =
  let period :: Float
period = Hz -> Float
forall a b. Coercible a b => a -> b
coerce (Hz -> Float) -> Hz -> Float
forall a b. (a -> b) -> a -> b
$ Hz
1 Hz -> Hz -> Hz
forall a. Fractional a => a -> a -> a
/ Hz
hz
   in Float -> Hz -> Int -> SamplingInfo
SamplingInfo Float
period Hz
hz (Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ Duration -> Float
forall a b. Coercible a b => a -> b
coerce Duration
duration Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
period)