module Music.Score.Combinators (
note,
rest,
noteRest,
removeRests,
mapEvents,
filterEvents,
mapFilterEvents,
before,
after,
split,
slice,
splice,
metaAt,
metaAtStart,
withMeta,
withGlobalMeta,
withMetaAtStart,
withGlobalMetaAtStart,
mapFirst,
mapLast,
mapPhrase,
mapPhraseSingle,
filterPart,
extractParts,
extractParts',
mapParts,
mapAllParts,
(</>),
rcat,
applySingle,
) where
import Control.Applicative
import Control.Arrow
import Control.Lens hiding (perform)
import Control.Monad
import Control.Monad.Plus
import Data.AffineSpace
import Data.AffineSpace.Point
import Data.Foldable (Foldable (..))
import Data.Ord
import Data.Ratio
import Data.Semigroup
import Data.String
import Data.Traversable
import Data.VectorSpace
import Music.Score.Convert
import Music.Score.Meta
import Music.Score.Note
import Music.Score.Part
import Music.Score.Score
import Music.Score.Track
import Music.Score.Util
import Music.Score.Voice
import Music.Time
import Music.Time.Reactive
import qualified Data.Foldable as Foldable
import qualified Data.List as List
note :: Monad m => a -> m a
note = return
rest :: MonadPlus m => m (Maybe a)
rest = return Nothing
noteRest :: MonadPlus m => Maybe a -> m a
noteRest = mfromMaybe
removeRests :: MonadPlus m => m (Maybe a) -> m a
removeRests = mcatMaybes
before :: Time -> Score a -> Score a
before u = filterEvents (\t d _ -> t .+^ d <= u)
after :: Time -> Score a -> Score a
after u = filterEvents (\t d _ -> u <= t)
slice :: Time -> Time -> Score a -> Score a
slice u v = filterEvents (\t d _ -> u <= t && t .+^ d <= v)
split :: Time -> Score a -> (Score a, Score a)
split t a = (before t a, after t a)
splice :: Time -> Duration -> Score a -> (Score a, Score a, Score a)
splice t d a = tripr (before t a, split (t .+^ d) a)
mapFirst :: HasPart' a => (a -> b) -> (a -> b) -> Score a -> Score b
mapFirst f g = mapPhrase f g g
mapLast :: HasPart' a => (a -> b) -> (a -> b) -> Score a -> Score b
mapLast f g = mapPhrase g g f
mapPhrase :: HasPart' a => (a -> b) -> (a -> b) -> (a -> b) -> Score a -> Score b
mapPhrase f g h = mapAllParts (fmap $ mapPhraseSingle f g h)
mapPhraseSingle :: (a -> b) -> (a -> b) -> (a -> b) -> Score a -> Score b
mapPhraseSingle f g h = mapAll (mapFTL (_3 %~ f) (_3 %~ g) (_3 %~ h))
mapAll :: ([(Time, Duration, a)] -> [(Time, Duration, b)]) -> Score a -> Score b
mapAll f = saveMeta $ over events f
where
saveMeta f x = (meta .~) ((view meta) x) $ f x
filterPart :: HasPart' a => (Part a -> Bool) -> Score a -> Score a
filterPart p = mfilter (p . getPart)
filterPartIs :: HasPart' a => Part a -> Score a -> Score a
filterPartIs = filterPart <$> (==)
extractParts :: HasPart' a => Score a -> [Score a]
extractParts x = filterPartIs <$> getParts x <*> return x
extractParts' :: HasPart' a => Score a -> [(Part a, Score a)]
extractParts' x = getParts x `zip` extractParts x
mapPart :: (Enum (Part a), HasPart' a) => Part a -> (Score a -> Score a) -> Score a -> Score a
mapParts :: HasPart' a => (Score a -> Score b) -> Score a -> Score b
mapAllParts :: HasPart' a => ([Score a] -> [Score b]) -> Score a -> Score b
mapPart n f = mapAllParts (zipWith ($) (replicate (fromEnum n) id ++ [f] ++ repeat id))
mapParts f = mapAllParts (fmap f)
mapAllParts f = mconcat . f . extractParts
modifyParts :: HasPart' a => (Part a -> Part a) -> Score a -> Score a
modifyParts n = fmap (modifyPart n)
infixr 6 </>
(</>) :: (HasPart' a, Enum (Part a)) => Score a -> Score a -> Score a
a </> b = a <> moveParts offset b
where
offset = succ $ maximum' 0 $ fmap fromEnum $ getParts a
rcat :: (HasPart' a, Enum (Part a)) => [Score a] -> Score a
rcat = List.foldr (</>) mempty
moveParts :: (Integral b, HasPart' a, Enum (Part a)) => b -> Score a -> Score a
moveParts x = modifyParts (successor x)
moveToPart :: (Enum b, HasPart' a, Enum (Part a)) => b -> Score a -> Score a
moveToPart v = moveParts (fromEnum v)
apply :: HasPart' a => Voice (Score a -> Score b) -> Score a -> Score b
apply x = mapAllParts (fmap $ applySingle x)
applySingle :: Voice (Score a -> Score b) -> Score a -> Score b
applySingle fs = notJoin . fmap (uncurry ($)) . sample fs
where
notJoin = mconcat . Foldable.toList
sample fs = snapshotSingle (voiceToScore fs)
snapshot :: HasPart' b => Score a -> Score b -> Score (a, Score b)
snapshot x = mapAllParts (fmap $ snapshotSingle x)
snapshotWith :: HasPart' b => (a -> Score b -> c) -> Score a -> Score b -> Score c
snapshotWith f x = mapAllParts (fmap $ snapshotWithSingle f x)
snapshotSingle :: Score a -> Score b -> Score (a, Score b)
snapshotSingle = snapshotWithSingle (,)
snapshotWithSingle :: (a -> Score b -> c) -> Score a -> Score b -> Score c
snapshotWithSingle g as bs = mapEvents ( \t d a -> g a (onsetIn t d bs) ) as
onsetIn :: Time -> Duration -> Score a -> Score a
onsetIn a b = mapAll $ filterOnce (\(t,d,x) -> a <= t && t < a .+^ b)
withSpan :: Score a -> Score (Span, a)
withSpan = mapEvents (\t d x -> (t >-> d,x))
withTime = mapEvents (\t d x -> (t, x))
inSpan t' (view range -> (t,u)) = t <= t' && t' < u
mapBefore :: Time -> (Score a -> Score a) -> Score a -> Score a
mapDuring :: Span -> (Score a -> Score a) -> Score a -> Score a
mapAfter :: Time -> (Score a -> Score a) -> Score a -> Score a
mapBefore t f x = let (y,n) = (fmap snd *** fmap snd) $ mpartition (\(t2,x) -> t2 < t) (withTime x) in (f y <> n)
mapDuring s f x = let (y,n) = (fmap snd *** fmap snd) $ mpartition (\(t,x) -> t `inSpan` s) (withTime x) in (f y <> n)
mapAfter t f x = let (y,n) = (fmap snd *** fmap snd) $ mpartition (\(t2,x) -> t2 >= t) (withTime x) in (f y <> n)
runScoreMeta :: forall a b . (HasPart' a, IsAttribute b) => Score a -> Reactive b
runScoreMeta = runMeta (Nothing :: Maybe a) . (view meta)
metaAt :: (HasPart' a, IsAttribute b) => Time -> Score a -> b
metaAt x = (? x) . runScoreMeta
metaAtStart :: (HasPart' a, IsAttribute b) => Score a -> b
metaAtStart x = onset x `metaAt` x
withGlobalMeta :: IsAttribute a => (a -> Score b -> Score b) -> Score b -> Score b
withGlobalMeta = withMeta' (Nothing :: Maybe Int)
withMeta :: (IsAttribute a, HasPart' b) => (a -> Score b -> Score b) -> Score b -> Score b
withMeta f x = withMeta' (Just x) f x
withMeta' :: (HasPart' c, IsAttribute a) => Maybe c -> (a -> Score b -> Score b) -> Score b -> Score b
withMeta' part f x = let
m = (view meta) x
r = runMeta part m
in case splitReactive r of
Left a -> f a x
Right ((a, t), bs, (u, c)) ->
(meta .~) m
$ mapBefore t (f a)
$ (composed $ fmap (\(getNote -> (s, a)) -> mapDuring s $ f a) $ bs)
$ mapAfter u (f c)
$ x
withGlobalMetaAtStart :: IsAttribute a => (a -> Score b -> Score b) -> Score b -> Score b
withGlobalMetaAtStart = withMetaAtStart' (Nothing :: Maybe Int)
withMetaAtStart :: (IsAttribute a, HasPart' b) => (a -> Score b -> Score b) -> Score b -> Score b
withMetaAtStart f x = withMetaAtStart' (Just x) f x
withMetaAtStart' :: (IsAttribute b, HasPart' p) =>
Maybe p -> (b -> Score a -> Score a) -> Score a -> Score a
withMetaAtStart' part f x = let
m = (view meta) x
in f (runMeta part m ? onset x) x
iterating :: (a -> a) -> (a -> a) -> Int -> a -> a
iterating f g n
| n < 0 = f . iterating f g (n + 1)
| n == 0 = id
| n > 0 = g . iterating f g (n 1)
successor :: (Integral b, Enum a) => b -> a -> a
successor n = iterating pred succ (fromIntegral n)
maximum' :: (Ord a, Foldable t) => a -> t a -> a
maximum' z = option z getMax . foldMap (Option . Just . Max)
minimum' :: (Ord a, Foldable t) => a -> t a -> a
minimum' z = option z getMin . foldMap (Option . Just . Min)