{-# LANGUAGE
FlexibleInstances,
TypeSynonymInstances,
Rank2Types #-}
-- | Representing pitch
module Temporal.Music.Notation.Pitch (
-- * Types
--
-- | There are four main datatypes 'Frequency', 'Pitch', 'Scale' and 'Tone'.
-- 'Pitch' consists of 'Scale' and 'Tone'.
-- Every 'Pitch' can be converted to 'Frequency' (see a 'absPitch').
-- 'Scale' defines logarithmic mapping from 2d integer coordinates of
-- 'Tone' to 1d double values. 'Scale' is 2d logarithmic grid in
-- frequency domain and 'Tone' is point on that grid.
Frequency, c1, a1,
Pitch(..), etPitch,
Interval, Scale(..), scaleSize, fromIntervals,
Bend, Octave, Step,
Tone(..), tone, toneNum,
-- * Transformers
-- ** Pitch
PchFunctor(..),
-- ** Scale
ScaleFunctor(..), setScale, mapBase, setBase, transposeScale,
-- ** Tone
ToneFunctor(..),
setBend, bend, step, low, high, lower, higher, invert,
-- * Rendering
frequency, absPitch
)
where
import TypeLevel.NaturalNumber
import Data.Function(on)
import qualified Data.Vector as V
import Temporal.Music.Notation.Score(Score)
import Control.Arrow(first, second)
type Frequency = Double
-- | middle C (261.626 Hz)
c1 :: Frequency
c1 = 261.626
-- | middle A (440 Hz)
a1 :: Frequency
a1 = 440
-- | 'Pitch' consists of 'Scale' and 'Tone'
data NaturalNumber n => Pitch n = Pitch
{ pitchScale :: Scale n
, pitchTone :: Tone n
} deriving (Show, Eq)
-- | twelve tone equal temperament scale pitch. Scale base tone is @(0, 'c1')@
etPitch :: Tone N12 -> Pitch N12
etPitch = Pitch etc
where etc = Scale (0, c1) 2 (V.fromList $ map ((2 **) . (/12)) [0 .. 11])
--------------------------------------------------------------
-- Scale
-- | Musical interval. Ratio between two frequency values.
type Interval = Frequency
-- | 'Scale' defines 2d grid in frequency domain. First value of 2d vector
-- is octave and second is step. 'Scale' consists of base tone,
-- octave interval and individual tone intervals inside octave.
-- Base tone links scale coordinates to frequency coordinates.
-- Base tone is pair (n, f) of integer value and frequency value,
-- Base tone defines that @'tone' n@ corresponds to frequency @f@.
--
-- For example scales @s1@ and @s2@ are equal
--
-- >import Temporal.Music.Notation.Local.Scales(eqt)
-- >
-- >s1 = eqt 0 c1
-- >s2 = eqt 9 a1
--
-- This doesn't make much sense for equal temperament. But can be useful
-- for just scales. For example this gives just pythagorean scale in G major
--
-- >import Temporal.Music.Notation.Local.Scales(pyth)
-- >
-- >pythG = pyth 7 (3/2 * c1)
--
-- if you write just @pyth 0 (3/2 * c1)@ note (0 :: Tone N12) corresponds
-- to G.
data NaturalNumber n => Scale n = Scale
{ scaleBase :: (Int, Frequency)
-- ^ start point of the grid,
-- @(n, cps)@ corresponds to @(0, n)@
-- where n is step id of 'scaleBase' and
-- @cps@ is 'scaleBase' in frequency units.
, scaleOctave :: Interval
-- ^ octave interval
, scaleSteps :: V.Vector Interval
-- ^ multipliers for each step in octave
} deriving (Show, Eq)
-- | gives number of steps in one octave.
scaleSize :: NaturalNumber n => Scale n -> Int
scaleSize = naturalNumberAsInt . num
where num :: NaturalNumber n => Scale n -> n
num = const undefined
-- | 'fromIntervals' makes scale constructor from 'octave' interval and
-- scale step intervals.
fromIntervals :: NaturalNumber n
=> Interval -> [Interval]
-> (Int -> Frequency -> Scale n)
fromIntervals octave steps = \c0 f0 -> Scale (c0, f0) octave $ V.fromList steps
--------------------------------------------------------------
-- Tone
-- | represents tone's diversion from scale grid.
type Bend = Double
type Octave = Int
type Step = Int
-- | 'Tone' is 2d integer value (octave, step) that can be converted to
-- frequency
-- with some scale. 'Bend' is a level of diversion from scale-tones
-- 1-level bend is equal to 1 step. For tones with fractional bends frequency
-- is calculated with linear interpolation by nearest values in scale.
data NaturalNumber n => Tone n = Tone
{ toneBend :: Bend
, toneOctave :: Octave
, toneStep :: Step
} deriving (Eq, Show)
-- | 'tone' constructs Tone from step value. Bend is set to zero.
tone :: NaturalNumber n => Step -> Tone n
tone x = res
where res = (uncurry $ Tone 0) $ divMod x d
d = toneNum res
-- | 'toneNum' queries number of steps in scale for given tone.
-- It decodes type value to 'Int'.
toneNum :: NaturalNumber n => Tone n -> Int
toneNum x = naturalNumberAsInt $ num x
where num :: NaturalNumber n => Tone n -> n
num = const undefined
-- instances
instance NaturalNumber n => Ord (Tone n) where
compare = compare `on` (\(Tone b o s) -> (o, s, b))
instance NaturalNumber n => Enum (Tone n) where
toEnum = tone
fromEnum x = toneOctave x * toneNum x + toneStep x
instance NaturalNumber n => Num (Tone n) where
(+) = liftBi (+) (+)
(-) = liftBi (-) (-)
(*) = liftBi (*) (*)
abs = liftOne abs abs
signum t@(Tone b o s)
| abs b < 1e-6 && o == 0 && s == 0 = 0
| t > 0 = tone 1
| otherwise = tone $ -1
fromInteger = tone . fromInteger
-------------------------------------------------------------------
-------------------------------------------------------------------
-- Transformers
-- Pitch
class PchFunctor a where
mapPch :: (forall n . NaturalNumber n => Pitch n -> Pitch n) -> (a -> a)
instance NaturalNumber n => PchFunctor (Pitch n) where
mapPch f = f
instance (PchFunctor a) => PchFunctor (Score a) where
mapPch f = fmap (mapPch f)
-- Scale
class ScaleFunctor a where
mapScale :: (forall n . NaturalNumber n => Scale n -> Scale n) -> (a -> a)
instance NaturalNumber n => ScaleFunctor (Scale n) where
mapScale f = f
instance (ScaleFunctor a) => ScaleFunctor (Score a) where
mapScale f = fmap (mapScale f)
instance NaturalNumber n => ScaleFunctor (Pitch n) where
mapScale f (Pitch s t) = Pitch (f s) t
-- | setting specific scale
setScale :: (NaturalNumber n, ScaleFunctor a) => Scale n -> a -> a
setScale x = mapScale $
\s -> s{ scaleBase = scaleBase x, scaleSteps = scaleSteps x }
-- | mapping of scale base tone
mapBase :: ScaleFunctor a => (Frequency -> Frequency) -> a -> a
mapBase f = mapScale $ \s -> s{ scaleBase = second f $ scaleBase s }
-- | setting scale base tone
setBase :: ScaleFunctor a => Frequency -> a -> a
setBase b = mapBase $ const b
-- | 'transposeScale' shifts scaleSteps by given number.
-- For example if your just scale is defined with middle C as base
-- and you want to transpose it to middle D you can write
--
-- >res = someScale 2 (wholeTone * c1)
-- > where wholeTone = 9/8
--
-- or
--
-- >transposeScale 2 $ someScale 0 c1
--
-- And now 0 corresponds to middle C and step multipliers are rearranged
-- so that someScale starts from middle D.
transposeScale :: ScaleFunctor a => Step -> a -> a
transposeScale n = mapScale $ \(Scale b o s) -> Scale b o $ rotateSteps n s
where rotateSteps x s = V.map ( (/d) . (s V.! ) . flip mod n) ids
where n = V.length s
d = s V.! (mod x n)
ids = V.fromList [x .. x + n]
-- Tone
-- | transformer for types that contain tone
class ToneFunctor a where
mapTone :: (forall n . NaturalNumber n => Tone n -> Tone n) -> (a -> a)
instance NaturalNumber n => ToneFunctor (Tone n) where
mapTone f = f
instance ToneFunctor a => ToneFunctor (Score a) where
mapTone f = fmap (mapTone f)
instance NaturalNumber n => ToneFunctor (Pitch n) where
mapTone f (Pitch s t) = Pitch s $ f t
-- | set bend value
setBend :: ToneFunctor a => Bend -> a -> a
setBend d = mapTone $ \x -> x{ toneBend = d }
-- | shift in bends
bend :: ToneFunctor a => Bend -> a -> a
bend d = mapTone $ \x -> x{ toneBend = toneBend x + d }
-- | transposition, shift in steps
step :: ToneFunctor a => Step -> a -> a
step n = mapTone (tone n + )
-- | one octave lower
low :: ToneFunctor a => a -> a
low = lower 1
-- | one octave higher
high :: ToneFunctor a => a -> a
high = higher 1
-- | shifts downwards in octaves
lower :: ToneFunctor a => Int -> a -> a
lower n = higher (-n)
-- | shifts upwards in octaves
higher :: ToneFunctor a => Int -> a -> a
higher n = mapTone $ \(Tone b o s) -> Tone b (o + n) s
-- | inverts note around some tone center. Tone center defines
-- two tones octave apart around current note in wich inversion takes place.
--
-- For example with center at 5 note @c@ in twelve tone scale
-- @[5, 6, 7, 8, 9, bb, 11, c, 1, 2, 3, 4, 5]@ goes into note bb.
-- Inversion counts number of steps from lower center tone to given tone
-- and then result is higher center tone shifted lower by this number.
invert :: ToneFunctor a => Step -> a -> a
invert center = mapTone $
\t@(Tone b o s) ->
let n = toneNum t
c = mod center n
q = if c <= s
then (2 * c + n - s)
else (2 * c - n - s)
(o', s') = divMod q n
in Tone b (o + o') s'
-----------------------------------------------------------
-- rendering
-- | pitch to frequency conversion
absPitch :: NaturalNumber n => Pitch n -> Frequency
absPitch (Pitch s t) = frequency s t
-- | calculates frequency value for given tone on scale grid
frequency :: NaturalNumber n => Scale n -> Tone n -> Frequency
frequency s (Tone b o n) = (bendCoeff r' n' s * ) $
f0 * (scaleOctave s ^^ (o + o')) * (scaleSteps s V.! n')
where (o', n') = divMod (n - c0 + fromIntegral b') $ scaleSize s
b' = floor b
r' = b - fromInteger b'
(c0, f0) = scaleBase s
bendCoeff :: NaturalNumber n => Bend -> Step -> Scale n -> Double
bendCoeff r n s
| abs r < 1e-6 = 1
| r > 0 = flip loginterpCoeff r $ getTones s n $ n + 1
| otherwise = flip loginterpCoeff (abs r) $ getTones s n $ n - 1
where getTones s n1 n2 = (getTone s n1, getTone s n2)
getTone s = frequency s . tone
loginterpCoeff :: (Double, Double) -> Double -> Double
loginterpCoeff (l, r) x = (r / l) ** x
-- tone manipulation
liftOne :: NaturalNumber n
=> (Double -> Double) -> (Int -> Int)
-> Tone n -> Tone n
liftOne f g (Tone b o s) = fit $ Tone (f b) (g o) (g s)
liftBi :: NaturalNumber n
=> (Double -> Double -> Double) -> (Int -> Int -> Int)
-> Tone n -> Tone n -> Tone n
liftBi f g (Tone b o s) (Tone b' o' s') =
fit $ Tone (b `f` b') (o `g` o') (s `g` s')
fit :: NaturalNumber n => Tone n -> Tone n
fit t@(Tone b o s) = Tone b (o + o') s'
where (o', s') = divMod s $ toneNum t