module Music.Score.Ties (
Tiable(..),
TieT(..),
splitTiesVoiceAt,
) where
import Control.Applicative
import Data.Bifunctor
import Control.Comonad
import Control.Lens hiding (transform)
import Control.Monad
import Control.Monad.Plus
import Data.AffineSpace
import Data.Default
import Data.Foldable hiding (concat)
import Data.Functor.Adjunction (unzipR)
import qualified Data.List as List
import Data.Maybe
import Data.Ratio
import Data.Semigroup
import Data.Typeable
import Data.VectorSpace hiding (Sum)
import Music.Dynamics.Literal
import Music.Pitch.Literal
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, Comonad)
instance Wrapped (TieT a) where
type Unwrapped (TieT a) = ((Any, Any), a)
_Wrapped' = iso getTieT TieT
instance Rewrapped (TieT a) (TieT b)
instance Tiable Double where { beginTie = id ; endTie = id }
instance Tiable Float where { beginTie = id ; endTie = id }
instance Tiable Char 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 (TieT a) where
toTied (TieT ((prevTie, nextTie), a)) = (TieT ((prevTie, Any True), b), TieT ((Any True, nextTie), c))
where (b,c) = toTied a
instance Tiable a => Tiable [a] where
toTied = unzip . fmap toTied
instance Tiable a => Tiable (Behavior a) where
toTied = unzipR . fmap toTied
instance Tiable a => Tiable (c, a) where
toTied = unzipR . fmap toTied
instance Tiable a => Tiable (Maybe a) where
toTied = unzipR . fmap toTied
instance Tiable a => Tiable (Sum a) where
toTied = unzipR . fmap toTied
instance Tiable a => Tiable (Product a) where
toTied = unzipR . fmap toTied
instance IsPitch a => IsPitch (TieT a) where
fromPitch = pure . fromPitch
instance IsDynamics a => IsDynamics (TieT a) where
fromDynamics = return . fromDynamics
instance Transformable a => Transformable (TieT a) where
transform s = fmap (transform s)
instance Reversible a => Reversible (TieT a) where
rev = fmap rev
instance Num a => Num (TieT a) where
(+) = liftA2 (+)
(*) = liftA2 (*)
() = liftA2 ()
abs = fmap abs
signum = fmap signum
fromInteger = pure . fromInteger
instance Fractional a => Fractional (TieT a) where
recip = fmap recip
fromRational = pure . fromRational
instance Floating a => Floating (TieT a) where
pi = pure pi
sqrt = fmap sqrt
exp = fmap exp
log = fmap log
sin = fmap sin
cos = fmap cos
asin = fmap asin
atan = fmap atan
acos = fmap acos
sinh = fmap sinh
cosh = fmap cosh
asinh = fmap asinh
atanh = fmap atanh
acosh = fmap acos
instance Enum a => Enum (TieT a) where
toEnum = pure . toEnum
fromEnum = fromEnum . extract
instance Bounded a => Bounded (TieT a) where
minBound = pure minBound
maxBound = pure maxBound
instance (Num a, Ord a, Real a) => Real (TieT a) where
toRational = toRational . extract
instance (Real a, Enum a, Integral a) => Integral (TieT a) where
quot = liftA2 quot
rem = liftA2 rem
toInteger = toInteger . extract
splitTiesVoiceAt :: Tiable a => [Duration] -> Voice a -> [Voice a]
splitTiesVoiceAt barDurs x = fmap ((^. voice) . map (^. stretched)) $ splitTiesVoiceAt' barDurs ((map (^. from stretched) . (^. stretcheds)) 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 (map (^. from stretched) . (^. stretcheds)) . splitTiesVoiceAt barDurs . ((^. voice) . map (^. stretched)) . 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
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