music-score-1.8: src/Music/Score/Tremolo.hs
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-------------------------------------------------------------------------------------
-- |
-- Copyright : (c) Hans Hoglund 2012-2014
--
-- License : BSD-style
--
-- Maintainer : hans@hanshoglund.se
-- Stability : experimental
-- Portability : non-portable (TF,GNTD)
--
-- Provides a representation for tremolo, i.e. rapid iterations of a note.
--
-------------------------------------------------------------------------------------
module Music.Score.Tremolo (
-- * Tremolo
HasTremolo(..),
tremolo,
-- ** Tremolo note transformer
TremoloT,
runTremoloT,
) where
import Control.Applicative
import Control.Comonad
import Control.Lens hiding (transform)
import Data.Foldable
import Data.Foldable
import Data.Functor.Couple
import Data.Ratio
import Data.Semigroup
import Data.Typeable
import Data.Word
import Data.Functor.Adjunction (unzipR)
import Music.Dynamics.Literal
import Music.Pitch.Alterable
import Music.Pitch.Augmentable
import Music.Pitch.Literal
import Music.Score.Part
import Music.Score.Phrases
import Music.Dynamics.Literal
import Music.Pitch.Alterable
import Music.Pitch.Augmentable
import Music.Pitch.Literal
import Music.Score.Articulation
import Music.Score.Dynamics
import Music.Score.Harmonics
import Music.Score.Meta
import Music.Score.Part
import Music.Score.Pitch
import Music.Score.Slide
import Music.Score.Text
import Music.Score.Ties
import Music.Time
class HasTremolo a where
setTrem :: Int -> a -> a
instance HasTremolo a => HasTremolo (b, a) where
setTrem n = fmap (setTrem n)
instance HasTremolo a => HasTremolo (Couple b a) where
setTrem n = fmap (setTrem n)
instance HasTremolo a => HasTremolo [a] where
setTrem n = fmap (setTrem n)
instance HasTremolo a => HasTremolo (Score a) where
setTrem n = fmap (setTrem n)
-- |
-- Set the number of tremolo divisions for all notes in the score.
--
tremolo :: HasTremolo a => Int -> a -> a
tremolo = setTrem
-- TODO these must be moved upwards
deriving instance (Monoid b, IsPitch a) => IsPitch (Couple b a)
deriving instance (Monoid b, IsDynamics a) => IsDynamics (Couple b a)
deriving instance (Monoid b, Transformable a) => Transformable (Couple b a)
deriving instance (Monoid b, Reversible a) => Reversible (Couple b a)
deriving instance (Monoid b, Alterable a) => Alterable (Couple b a)
deriving instance (Monoid b, Augmentable a) => Augmentable (Couple b a)
instance Tiable a => Tiable (Couple b a) where
isTieEndBeginning (Couple (_,a)) = isTieEndBeginning a
toTied = unzipR . fmap toTied
newtype TremoloT a = TremoloT { getTremoloT :: Couple (Max Word) a }
deriving (Eq, Show, Ord, Functor, Foldable, Typeable, Applicative, Monad, Comonad)
--
-- We use Word instead of Int to get (mempty = Max 0), as (Max.mempty = Max minBound)
-- Preferably we would use Natural but unfortunately this is not an instance of Bounded
--
instance Wrapped (TremoloT a) where
type Unwrapped (TremoloT a) = Couple (Max Word) a
_Wrapped' = iso getTremoloT TremoloT
instance Rewrapped (TremoloT a) (TremoloT b)
instance HasTremolo (TremoloT a) where
setTrem n = set (_Wrapped . _Wrapped . _1) (Max $ fromIntegral n)
-- Lifted instances
deriving instance Num a => Num (TremoloT a)
deriving instance Fractional a => Fractional (TremoloT a)
deriving instance Floating a => Floating (TremoloT a)
deriving instance Enum a => Enum (TremoloT a)
deriving instance Bounded a => Bounded (TremoloT a)
deriving instance (Num a, Ord a, Real a) => Real (TremoloT a)
deriving instance (Real a, Enum a, Integral a) => Integral (TremoloT a)
deriving instance IsPitch a => IsPitch (TremoloT a)
deriving instance IsDynamics a => IsDynamics (TremoloT a)
deriving instance Semigroup a => Semigroup (TremoloT a)
deriving instance Tiable a => Tiable (TremoloT a)
deriving instance HasHarmonic a => HasHarmonic (TremoloT a)
deriving instance HasSlide a => HasSlide (TremoloT a)
deriving instance HasText a => HasText (TremoloT a)
deriving instance Transformable a => Transformable (TremoloT a)
deriving instance Reversible a => Reversible (TremoloT a)
deriving instance Alterable a => Alterable (TremoloT a)
deriving instance Augmentable a => Augmentable (TremoloT a)
type instance Pitch (TremoloT a) = Pitch a
type instance SetPitch g (TremoloT a) = TremoloT (SetPitch g a)
type instance Dynamic (TremoloT a) = Dynamic a
type instance SetDynamic g (TremoloT a) = TremoloT (SetDynamic g a)
type instance Articulation (TremoloT a) = Articulation a
type instance SetArticulation g (TremoloT a) = TremoloT (SetArticulation g a)
instance (HasPitches a b) => HasPitches (TremoloT a) (TremoloT b) where
pitches = _Wrapped . pitches
instance (HasPitch a b) => HasPitch (TremoloT a) (TremoloT b) where
pitch = _Wrapped . pitch
instance (HasDynamics a b) => HasDynamics (TremoloT a) (TremoloT b) where
dynamics = _Wrapped . dynamics
instance (HasDynamic a b) => HasDynamic (TremoloT a) (TremoloT b) where
dynamic = _Wrapped . dynamic
instance (HasArticulations a b) => HasArticulations (TremoloT a) (TremoloT b) where
articulations = _Wrapped . articulations
instance (HasArticulation a b) => HasArticulation (TremoloT a) (TremoloT b) where
articulation = _Wrapped . articulation
-- |
-- Get the number of tremolo divisions.
--
runTremoloT :: TremoloT a -> (Int, a)
runTremoloT (TremoloT (Couple (Max n, a))) = (fromIntegral n, a)