module Music.Score.Ties (
Tiable(..),
TieT(..),
splitTiesVoice,
splitTiesVoiceAt,
) where
import Control.Applicative
import Control.Arrow
import Control.Lens
import Control.Monad
import Control.Monad.Plus
import Data.AffineSpace
import Data.Default
import Data.Foldable hiding (concat)
import qualified Data.List as List
import Data.Maybe
import Data.Ratio
import Data.Semigroup
import Data.Typeable
import Data.VectorSpace
import Music.Score.Combinators
import Music.Score.Convert
import Music.Score.Part
import Music.Score.Score
import Music.Score.Voice
import Music.Time
class Tiable a where
beginTie :: a -> a
beginTie = fst . toTied
endTie :: a -> a
endTie = snd . toTied
toTied :: a -> (a, a)
toTied a = (beginTie a, endTie a)
newtype TieT a = TieT { getTieT :: ((Any, Any), a) }
deriving (Eq, Ord, Show, Functor, Foldable, Typeable, Applicative, Monad)
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
instance Tiable a => Tiable (TieT a) where
toTied (TieT ((prevTie, nextTie), a)) = (TieT ((prevTie, Any True), b), TieT ((Any True, nextTie), c))
where (b,c) = toTied a
splitTiesVoice :: Tiable a => Voice a -> Voice a
splitTiesVoice = (^. voice) . concat . snd . List.mapAccumL g 0 . (^. from voice)
where
g t (d, x) = (t + d, occs)
where
(_, barTime) = properFraction t
remBarTime = 1 barTime
occs = splitDurThen remBarTime 1 (d,x)
splitTiesVoiceAt :: Tiable a => [Duration] -> Voice a -> [Voice a]
splitTiesVoiceAt barDurs x = fmap (^. voice) $ splitTiesVoiceAt' barDurs ((^. from voice) x)
splitTiesVoiceAt' :: Tiable a => [Duration] -> [(Duration, a)] -> [[(Duration, a)]]
splitTiesVoiceAt' [] _ = []
splitTiesVoiceAt' _ [] = []
splitTiesVoiceAt' (barDur : rbarDur) occs = case splitDurFor barDur occs of
(barOccs, []) -> barOccs : []
(barOccs, restOccs) -> barOccs : splitTiesVoiceAt' rbarDur restOccs
tsplitTiesVoiceAt :: [Duration] -> [Duration] -> [[(Duration, Char)]]
tsplitTiesVoiceAt barDurs = fmap (^. from voice) . splitTiesVoiceAt barDurs . (^. voice) . fmap (\x -> (x,'_'))
splitDurThen :: Tiable a => Duration -> Duration -> (Duration, a) -> [(Duration, a)]
splitDurThen s t x = case splitDur s x of
(a, Nothing) -> [a]
(a, Just b) -> a : splitDurThen t t b
splitDurFor :: Tiable a => Duration -> [(Duration, a)] -> ([(Duration, a)], [(Duration, a)])
splitDurFor remDur [] = ([], [])
splitDurFor remDur (x : xs) = case splitDur remDur x of
(x@(d,_), Nothing) ->
if d < remDur then
first (x:) $ splitDurFor (remDur d) xs
else
([x], xs)
(x@(d,_), Just rest) -> ([x], rest : xs)
tsplitDurFor :: Duration -> [Duration] -> ([(Duration,Char)], [(Duration,Char)])
tsplitDurFor maxDur xs = splitDurFor maxDur $ fmap (\x -> (x,'_')) xs
instance Tiable Char where
toTied _ = ('(',')')
splitDur :: Tiable a => Duration -> (Duration, a) -> ((Duration, a), Maybe (Duration, a))
splitDur maxDur (d,a)
| maxDur <= 0 = error "splitDur: maxDur must be > 0"
| d <= maxDur = ((d, a), Nothing)
| d > maxDur = ((maxDur, b), Just (d maxDur, c)) where (b,c) = toTied a