module Music.Score.Ties (
Tiable(..),
TieT(..),
splitTies,
splitTiesSingle,
splitTiesVoice,
) where
import Control.Monad
import Control.Monad.Plus
import Data.Default
import Data.Maybe
import Data.Ratio
import Data.Foldable hiding (concat)
import Data.Typeable
import qualified Data.List as List
import Data.VectorSpace
import Data.AffineSpace
import Music.Score.Voice
import Music.Score.Score
import Music.Score.Combinators
import Music.Score.Part
import Music.Time
class Tiable a where
beginTie :: a -> a
endTie :: a -> a
toTied :: a -> (a, a)
toTied a = (beginTie a, endTie a)
newtype TieT a = TieT { getTieT :: (Bool, a, Bool) }
deriving (Eq, Ord, Show, Functor, Foldable, Typeable)
instance Tiable Double where { beginTie = id ; endTie = id }
instance Tiable Float where { beginTie = id ; endTie = id }
instance Tiable Int where { beginTie = id ; endTie = id }
instance Tiable Integer where { beginTie = id ; endTie = id }
instance Tiable () where { beginTie = id ; endTie = id }
instance Tiable (Ratio a) where { beginTie = id ; endTie = id }
instance Tiable a => Tiable (Maybe a) where
beginTie = fmap beginTie
endTie = fmap endTie
toTied Nothing = (Nothing, Nothing)
toTied (Just a) = (Just b, Just c) where (b,c) = toTied a
instance Tiable a => Tiable (TieT a) where
beginTie (TieT (prevTie, a, nextTie)) = TieT (prevTie, a, True)
endTie (TieT (prevTie, a, nextTie)) = TieT (True, a, nextTie)
toTied (TieT (prevTie, a, nextTie)) = (TieT (prevTie, b, True), TieT (True, c, nextTie))
where (b,c) = toTied a
splitTies :: (HasPart' a, Tiable a) => Score a -> Score a
splitTies = mapParts splitTiesSingle
splitTiesSingle :: Tiable a => Score a -> Score a
splitTiesSingle = voiceToScore' . splitTiesVoice . scoreToVoice
splitTiesVoice :: Tiable a => Voice a -> Voice a
splitTiesVoice = Voice . concat . snd . List.mapAccumL g 0 . getVoice
where
g t (d, x) = (t + d, occs)
where
(_, barTime) = properFraction t
remBarTime = 1 barTime
occs = splitDur remBarTime 1 (d,x)
splitDur :: Tiable a => DurationT -> DurationT -> (DurationT, a) -> [(DurationT, a)]
splitDur s t x = case splitDur' s x of
(a, Nothing) -> [a]
(a, Just b) -> a : splitDur t t b
splitDur' :: Tiable a => DurationT -> (DurationT, a) -> ((DurationT, a), Maybe (DurationT, a))
splitDur' s (d,a) | d <= s = ((d,a), Nothing)
| otherwise = ((s,b), Just (ds, c)) where (b,c) = toTied a