{-# 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,
Pch(pitch),
Pitch(..),
Interval, Scale(..), scaleSize, fromIntervals,
Bend, Octave, Step,
Tone(..), tone, toneNum,
-- * Transformers
-- ** Pitch
PitchFunctor(..),
-- ** Scale
setScale, mapBase, setBase, transposeScale,
-- ** Tone
ToneFunctor(..),
setBend, bend, step, transp,
low, l', ll', high, h', hh', lower, higher, invert,
-- * Rendering
frequency, absPitch,
toneAsDouble, scaleAt, scaleAtInt, scaleStep
)
where
import Data.Function(on)
import qualified Data.Vector as V
import Temporal.Music.Notation.Score(Score)
import Control.Arrow(first, second)
import Temporal.Music.Notation.Seg
type Frequency = Double
-- | middle C (261.626 Hz)
c1 :: Frequency
c1 = 261.626
-- | middle A (440 Hz)
a1 :: Frequency
a1 = 440
class Seg a => Pch a where
pitch :: Tone a -> Pitch a
{-
instance Nat n => Pch (IntSeg n) where
pitch x = Pitch (defaultScale x) x
where defaultScale x = Scale (0, c1) 2 $ V.fromList $
let n = toneNum x
n' = fromIntegral n
eqt = (2 ** ) . (/n') . fromIntegral
in map eqt [0 .. n-1]
-}
-- | 'Pitch' consists of 'Scale' and 'Tone'
data Seg n => Pitch n = Pitch
{ pitchScale :: Scale
, pitchTone :: Tone n
} deriving (Show, Eq)
--------------------------------------------------------------
-- 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 Scale = 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 :: Scale -> Int
scaleSize = V.length . scaleSteps
-- | 'fromIntervals' makes scale constructor from 'octave' interval and
-- scale step intervals.
fromIntervals ::
Interval -> [Interval]
-> (Int -> Frequency -> Scale)
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 Seg n => Tone n = Tone
{ toneBend :: Bend
, toneOctave :: Octave
, toneStep :: n
} deriving (Eq, Show)
-- | 'tone' constructs Tone from step value. Bend is set to zero.
tone :: Seg n => n -> Tone n
tone = Tone 0 0
-- | 'toneNum' queries number of steps in scale for given tone.
-- It decodes type value to 'Int'.
toneNum :: Seg n => Tone n -> Int
toneNum x = segSize $ num x
where num :: Seg n => Tone n -> n
num = const undefined
-- instances
instance (Eq n, Seg n) => Ord (Tone n) where
compare = compare `on` (\(Tone b o s) -> (o, fromEnum s, b))
instance Seg n => Enum (Tone n) where
toEnum x = res
where res = Tone 0 o $ toEnum s
(o, s) = divMod x (toneNum res)
fromEnum x = toneOctave x * toneNum x + (fromEnum $ toneStep x)
instance (Eq n, Show n, Seg n) => Num (Tone n) where
(+) = liftBi (+) (+) (+)
(-) = liftBi (-) (-) (+)
(*) = liftBi (*) (*) (*)
abs = liftUn abs abs abs
signum t@(Tone b o s)
| abs b < 1e-6 && o == 0 && s == minBound = 0
| t > 0 = fromInteger 1
| otherwise = fromInteger $ -1
fromInteger x = step (fromInteger x) $ tone minBound
-------------------------------------------------------------------
-------------------------------------------------------------------
-- Transformers
-- Pitch
class PitchFunctor a where
mapPitch :: (forall n . Seg n => Pitch n -> Pitch n) -> (a -> a)
instance Seg n => PitchFunctor (Pitch n) where
mapPitch f = f
instance (PitchFunctor a) => PitchFunctor (Score a) where
mapPitch f = fmap (mapPitch f)
-- Scale
mapScale :: PitchFunctor a => (Scale -> Scale) -> a -> a
mapScale f = mapPitch $ \p -> p{ pitchScale = f $ pitchScale p }
-- | setting specific scale
setScale :: PitchFunctor a => Scale -> a -> a
setScale x = mapScale $ const x
-- | mapping of scale base tone
mapBase :: PitchFunctor a => (Frequency -> Frequency) -> a -> a
mapBase f = mapScale $ \s -> s{ scaleBase = second f $ scaleBase s }
-- | setting scale base tone
setBase :: PitchFunctor 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 :: PitchFunctor 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 . Seg n => Tone n -> Tone n) -> (a -> a)
instance Seg n => ToneFunctor (Tone n) where
mapTone f = f
instance ToneFunctor a => ToneFunctor (Score a) where
mapTone f = fmap (mapTone f)
instance Seg 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 $ liftUn id id ( + n)
-- | transposition, shift in steps
transp :: ToneFunctor a => Step -> a -> a
transp = step
-- | one octave lower
low :: ToneFunctor a => a -> a
low = lower 1
-- | shorcut for 'low'
l' :: ToneFunctor a => a -> a
l' = low
-- | shorcut for @'lower' 2@
ll' :: ToneFunctor a => a -> a
ll' = lower 2
-- | one octave higher
high :: ToneFunctor a => a -> a
high = higher 1
-- | shorcut for 'high'
h' :: ToneFunctor a => a -> a
h' = high
-- | shorcut for @'higher' 2@
hh' :: ToneFunctor a => a -> a
hh' = higher 2
-- | 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
w = fromEnum s
q = if c <= w
then (2 * c + n - w)
else (2 * c - n - w)
(o', s') = divMod q n
in Tone b (o + o') $ toEnum s'
-----------------------------------------------------------
-- rendering
-- | pitch to frequency conversion
absPitch :: Seg n => Pitch n -> Frequency
absPitch (Pitch s t) = frequency s t
-- | calculates frequency value for given tone on scale grid
frequency :: Seg n => Scale -> Tone n -> Frequency
frequency s t = scaleAt s $ toneAsDouble t
-- | flattens tone to double.
toneAsDouble :: Seg s => Tone s -> Double
toneAsDouble t@(Tone b o s) = (fromIntegral $ fromEnum t) + b
-- | scale value on doubles
scaleAt :: Scale -> Double -> Double
scaleAt s x = scaleAtInt s d * bendCoeff s n r
where (d, r) = properFraction x
n = mod (d - c0) $ scaleSize s
c0 = fst $ scaleBase s
-- | scale value on integers
scaleAtInt :: Scale -> Int -> Frequency
scaleAtInt s x = f0 * scaleStep s x
where f0 = snd $ scaleBase s
-- | gives scale multiplier
scaleStep :: Scale -> Int -> Interval
scaleStep s x = (scaleOctave s ^ o) * scaleSteps s V.! n
where (o, n) = divMod (x - c0) $ scaleSize s
c0 = fst $ scaleBase s
bendCoeff :: Scale -> Int -> Double -> Frequency
bendCoeff s n x
| abs x < 1e-6 = 1
| x > 0 = flip loginterpCoeff x $ getTones s n $ n + 1
| otherwise = flip loginterpCoeff (abs x) $ getTones s n $ n - 1
where getTones s n1 n2 = (getTone s n1, getTone s n2)
getTone s x
| x >= 0 && x < n = scaleSteps s V.! x
| x == n = o
| x == -1 = scaleSteps s V.! (n-1) / o
| otherwise = error $ "scaleStep: out of bounds"
where n = scaleSize s
o = scaleOctave s
loginterpCoeff :: (Double, Double) -> Double -> Double
loginterpCoeff (l, r) x = (r / l) ** x
-- tone manipulation
liftUn :: Seg n
=> (Double -> Double)
-> (Int -> Int)
-> (Int -> Int)
-> Tone n -> Tone n
liftUn f g h t@(Tone b o s) =
(uncurry $ Tone (f b)) $
fit (toneNum t) (g o, h $ fromEnum s)
liftBi :: Seg n
=> (Double -> Double -> Double)
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> Tone n -> Tone n -> Tone n
liftBi f g h t@(Tone b o s) (Tone b' o' s') =
(uncurry $ Tone (b `f` b')) $
fit (toneNum t) (o `g` o', fromEnum s `h` fromEnum s')
fit :: Seg s => Int -> (Int, Int) -> (Int, s)
fit n (o, s) = (o + o', toEnum s')
where (o', s') = divMod s n