module Music.Pitch.Absolute
(
Hertz(..),
Cents,
Fifths,
HasFrequency(..),
fifths,
cents,
) where
import Control.Applicative
import Control.Monad
import Data.AdditiveGroup
import Data.AffineSpace
import Data.Either
import Data.Maybe
import Data.Semigroup
import Data.VectorSpace
import Music.Pitch.Literal
newtype Hertz = Hertz { getHertz :: Double }
deriving (Read, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac)
newtype Octaves = Octaves { getOctaves :: Hertz }
deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac)
newtype Fifths = Fifths { getFifths :: Hertz }
deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac)
newtype Cents = Cents { getCents :: Hertz }
deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac)
instance Show Hertz where show h = (show (getHertz h)) ++ " Hz"
instance Semigroup Hertz where (<>) = (*)
instance Semigroup Octaves where (<>) = (+)
instance Semigroup Fifths where (<>) = (+)
instance Semigroup Cents where (<>) = (+)
instance Monoid Hertz where mempty = 1 ; mappend = (*)
instance Monoid Octaves where mempty = 0 ; mappend = (+)
instance Monoid Fifths where mempty = 0 ; mappend = (+)
instance Monoid Cents where mempty = 0 ; mappend = (+)
instance AffineSpace Hertz where
type Diff Hertz = Double
(.-.) f1 f2 = (getHertz f1) / (getHertz f2)
(.+^) f x = Hertz $ (getHertz f) * x
class HasFrequency a where
frequency :: a -> Hertz
instance HasFrequency Hertz where
frequency = id
instance HasFrequency Octaves where
frequency (Octaves f) = (2/1) ** f
instance HasFrequency Fifths where
frequency (Fifths f) = (3/2) ** f
instance HasFrequency Cents where
frequency (Cents f) = (2/1) ** (f / 1200)
octaves :: HasFrequency a => a -> Octaves
octaves a = Octaves $ logBase (2/1) (frequency a)
fifths :: HasFrequency a => a -> Fifths
fifths a = Fifths $ logBase (3/2) (frequency a)
cents :: HasFrequency a => a -> Cents
cents a = Cents $ logBase (2/1) (frequency a) * 1200