------------------------------------------------------------------------------------- -- | -- Copyright : (c) Hans Hoglund 2012 -- -- License : BSD-style -- -- Maintainer : hans@hanshoglund.se -- Stability : experimental -- Portability : portable -- -- Provides overloaded pitch literals. -- ------------------------------------------------------------------------------------- module Music.Dynamics.Literal ( DynamicsL(..), IsDynamics(..), pppppp, ppppp, pppp, ppp, pp, _p, mp, mf, _f, ff, fff, ffff, fffff, ffffff, sffz, sfz, fz, rfz, fp ) where import Data.Semigroup import Control.Applicative -- | -- Dynamics literal. -- -- First value is start value, second is end value. -- -- * @(Just x, Nothing)@ is a constant dynamic of @x@ -- * @(Just x, Just y)@ is a dynamic varying from @x@ to @y@ -- * @(Nothing, Just y)@ is a dynamic varying from the previous level to @y@ -- * @(Nothing, Nothing)@ is a dynamic varying from the previous level to the next. -- -- For levels, we use @-0.5@ for /mp/, @0.5@ for /mf/ and add or remove one for each level. -- @0@ is an unspecified middle level dynamic. -- newtype DynamicsL = DynamicsL { getDynamicsL :: (Maybe Double, Maybe Double) } deriving (Eq, Show, Ord) -- Like Num can be expressed using arabic numerals, instances -- of IsDynamics can be expressed using Western pitch names (c, c sharp, c flat etc) class IsDynamics a where fromDynamics :: DynamicsL -> a instance IsDynamics DynamicsL where fromDynamics = id instance IsDynamics a => IsDynamics (Maybe a) where fromDynamics = pure . fromDynamics instance (Monoid b, IsDynamics a) => IsDynamics (b, a) where fromDynamics = pure . fromDynamics instance IsDynamics a => IsDynamics [a] where fromDynamics = pure . fromDynamics instance IsDynamics Double where fromDynamics (DynamicsL (Just x, _)) = x fromDynamics (DynamicsL (Nothing, _)) = error "IsDynamics Double: No dynamics" pppppp, ppppp, pppp, ppp, pp, _p, mp, mf, _f, ff, fff, ffff, fffff, ffffff :: IsDynamics a => a sffz, sfz, fz, rfz, fp :: IsDynamics a => a pppppp = fromDynamics $ DynamicsL (Just $ -6.5, Nothing) ppppp = fromDynamics $ DynamicsL (Just $ -5.5, Nothing) pppp = fromDynamics $ DynamicsL (Just $ -4.5, Nothing) ppp = fromDynamics $ DynamicsL (Just $ -3.5, Nothing) pp = fromDynamics $ DynamicsL (Just $ -2.5, Nothing) _p = fromDynamics $ DynamicsL (Just $ -1.5, Nothing) mp = fromDynamics $ DynamicsL (Just $ -0.5, Nothing) mf = fromDynamics $ DynamicsL (Just $ 0.5, Nothing) _f = fromDynamics $ DynamicsL (Just $ 1.5, Nothing) ff = fromDynamics $ DynamicsL (Just $ 2.5, Nothing) fff = fromDynamics $ DynamicsL (Just $ 3.5, Nothing) ffff = fromDynamics $ DynamicsL (Just $ 4.5, Nothing) fffff = fromDynamics $ DynamicsL (Just $ 5.5, Nothing) ffffff = fromDynamics $ DynamicsL (Just $ 6.5, Nothing) sffz = error "Not supported yet" sfz = error "Not supported yet" fz = error "Not supported yet" rfz = error "Not supported yet" fp = error "Not supported yet"