{-# LANGUAGE
FlexibleInstances,
TypeSynonymInstances,
Rank2Types #-}
-- | representing volume
module Temporal.Music.Notation.Volume(
-- * Types
-- | Main datatypes are 'Amplitude', 'Diapason' and 'Level'.
-- 'Volume' consists of 'Diapason' and 'Level'. Every
-- 'Volume' can be converted to 'Amplitude' (see 'absVolume').
-- 'Amplitude' is linear units and 'Level' is logarithmic units,
-- or decibels. 'Diapason' defines lower and upper bound for volume level
-- in amplitude linear units.
Amplitude,
Diapason, Accent,
Volume(..), Level(..),
volumeNum, levelNum,
level, mediumLevel,
-- * Transformers
VolFunctor(..), LevelFunctor(..),
setDiapason, setLevel, setAccent,
accent,
loud, quiet, louder, quieter,
dynamic, dynamicRel,
-- * Rendering
amplitude, unsafeAmplitude,
absVolume, unsafeAbsVolume
)
where
import Data.Function(on)
import TypeLevel.NaturalNumber
import Temporal.Music.Notation.Score(Score, Time, tmapRel, linseg)
-- | Linear volume units
type Amplitude = Double
-- | Volume lower and upper bounds. Lower bound must be positive
-- and upper bound must exceed lower bound.
type Diapason = (Amplitude, Amplitude)
-- | 'Accent' defines values between 'Level' values on logarithmic
-- scale. 1 'Accent' == 1 'Level' 's step.
type Accent = Double
-- | 'Volume' consists of 'Diapason' and 'Level'.
data NaturalNumber n => Volume n = Volume
{ volumeDiapason :: Diapason
, volumeLevel :: Level n
} deriving (Show, Eq)
class VolFunctor a where
mapVol :: (forall n . NaturalNumber n => Volume n -> Volume n) -> (a -> a)
instance NaturalNumber n => VolFunctor (Volume n) where
mapVol f = f
instance VolFunctor a => VolFunctor (Score a) where
mapVol f = fmap (mapVol f)
instance NaturalNumber n => LevelFunctor (Volume n) where
mapLevel f = \(Volume d l) -> Volume d $ f l
-- | setDiapason
setDiapason :: VolFunctor a => (Amplitude, Amplitude) -> a -> a
setDiapason x = mapVol $ \(Volume _ l) -> Volume x l
--------------------------------------------------
--------------------------------------------------
-- Level
-- | 'Level' defines number of equally spaced stamps on
-- logarithmic scale (steps), and degree of diversion
-- from the stamps (accents).
data NaturalNumber n => Level n = Level
{ levelAccent :: Accent
, levelStep :: Int
} deriving (Show, Eq)
-- | number of levels in 'Volume' scale
volumeNum :: NaturalNumber n => Volume n -> Int
volumeNum = phantomNum
-- | number of levels in 'Level' scale
levelNum :: NaturalNumber n => Level n -> Int
levelNum = phantomNum
phantomNum :: NaturalNumber n => f n -> Int
phantomNum = naturalNumberAsInt . num
where num :: f n -> n
num = const undefined
-------------------------------------------
-- constructors
-- | 'level' constructs 'Level' from 'Int'. 'Accent' is set to zero.
-- If input exceeds 'levelNum' then result is set to 'levelNum',
-- if input is negative then result set is to zero.
level :: NaturalNumber n => Int -> Level n
level x = res
where n = levelNum res
res = Level 0 $ sat 0 n x
-------------------------------------------
-- instances
instance NaturalNumber n => Enum (Level n) where
toEnum = level
fromEnum = levelStep
instance NaturalNumber n => Ord (Level n) where
compare = compare `on` (\(Level a s) -> fromIntegral s + a)
instance NaturalNumber n => Num (Level n) where
(+) = liftBi (+) (+)
(-) = liftBi (-) (-)
(*) = liftBi (*) (*)
abs = id
signum x
| x == level 0 = 0
| otherwise = 1
fromInteger = level . fromInteger
--------------------------------------
-- transformers
class LevelFunctor a where
mapLevel :: (forall n . NaturalNumber n => Level n -> Level n) -> (a -> a)
instance NaturalNumber n => LevelFunctor (Level n) where
mapLevel f = f
instance LevelFunctor a => LevelFunctor (Score a) where
mapLevel f = fmap (mapLevel f)
-- | 'accent' increases 'Accent' value by some degree
accent :: LevelFunctor a => Accent -> a -> a
accent d = mapLevel $ \(Level a s) -> Level (a+d) s
-- | 'setAccent' sets 'Accent' value to given input
setAccent :: LevelFunctor a => Accent -> a -> a
setAccent d = mapLevel $ \(Level _ s) -> Level d s
-- | 'setLevel' sets 'levelStep' to given input
setLevel :: LevelFunctor a => Int -> a -> a
setLevel n = mapLevel
(\l@(Level a _) -> Level a $ sat 0 (levelNum l) n)
-- | Input becomes one step louder
loud :: LevelFunctor a => a -> a
loud = louder 1
-- | Input becomes one step quieter
quiet :: LevelFunctor a => a -> a
quiet = quieter 1
-- | Input becomes given number of steps quieter
quieter :: LevelFunctor a => Int -> a -> a
quieter n = louder (-n)
-- | Input becomes given number of steps louder
louder :: LevelFunctor a => Int -> a -> a
louder n
| n > 0 = mapLevel ( + level n)
| n < 0 = mapLevel (\x -> x - level n)
-- | Medium level
mediumLevel :: NaturalNumber n => Level n
mediumLevel = res
where res = level $ round $ fromIntegral n / 2
n = levelNum res
-- | Accent that depends on time of note
dynamic :: LevelFunctor a => (Time -> Accent) -> Score a -> Score a
dynamic f = tmapRel $ \t -> accent (f t)
-- | Linear relative 'dynamic' function. Function is defined by list of
-- its values equaly spaced along time axis. For example
-- list [0, 1, 0] defines rise then decay lineary along full 'Score' 's
-- input duration. Time intervals of
-- rise and decay segments are equal to 'dur' /2. And list [0, 1, 0.5, 0]
-- defines
-- rise and decay again but here decay segment is twice longer then
-- rise segment.
dynamicRel :: LevelFunctor a => [Accent] -> Score a -> Score a
dynamicRel xs = dynamic $ linseg $ init $ f =<< xs
where dt = recip $ fromIntegral $ length xs
f x = [x, dt]
--------------------------------------------------
-- rendering
-- | converts volume to amplitude with 'amplitude' function
absVolume :: NaturalNumber n => Volume n -> Amplitude
absVolume (Volume d l) = amplitude d l
-- | converts volume to amplitude with 'unsafeAmplitude' function
unsafeAbsVolume :: NaturalNumber n => Volume n -> Amplitude
unsafeAbsVolume (Volume d l) = unsafeAmplitude d l
-- | converts equally spaced between lower and upper diapason bounds
-- 'Level' values to amplitudes.
-- Here resulting amplitude value lies within 'Diapason' interval.
-- All outsiders are placed inside interval with saturation.
amplitude :: NaturalNumber n => Diapason -> Level n -> Amplitude
amplitude d l = amplitudeGen (sat 0 $ fromIntegral $ levelNum l) d l
-- | unsafe analog of 'amplitude' function. Here result can go
-- beyond limits of 'Diapason' interval.
unsafeAmplitude :: NaturalNumber n => Diapason -> Level n -> Amplitude
unsafeAmplitude = amplitudeGen id
amplitudeGen :: NaturalNumber n
=> (Double -> Double)
-> Diapason -> Level n -> Amplitude
amplitudeGen bound (low, high) l@(Level a s) = (low * ) $ (high / low) ** x
where n = fromIntegral $ levelNum l
x = ( / n) $ bound $ fromIntegral s + a
--------------------------------------
-- level manipulation
liftBi :: NaturalNumber n
=> (Accent -> Accent -> Accent)
-> (Int -> Int -> Int )
-> (Level n -> Level n -> Level n)
liftBi f g l@(Level a s) (Level a' s') =
Level (a `f` a') (sat 0 (levelNum l) $ s `g` s')
sat :: Ord a => a -> a -> a -> a
sat low high x
| x < low = low
| x > high = high
| otherwise = x