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, Show, 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 Cents = Cents { getCents :: 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)
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 AdditiveGroup Hertz where
zeroV = 1
(^+^) = (*)
negateV f = 1 / f
instance VectorSpace Hertz where
type Scalar Hertz = Hertz
(*^) x f = Hertz ((getHertz f) ** getHertz x)
instance AffineSpace Hertz where
type Diff Hertz = Hertz
(.-.) = ()
(.+^) = (+)
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
instance IsInterval Hertz where
fromInterval (IntervalL (o,d,c)) = (2**fromIntegral o) * (r !! fromIntegral c)
where
r = [
1/1,
(8*2)/15, 9/8, (2*3)/5, 5/4, (2*2)/3,
10/7,
3/2, (4*2)/5, 5/3, (2*8)/9, 15/8
]