haskore-realtime-0.1: Routines for realtime playback of Haskore songsSource codeContentsIndex
Haskore.RealTime.EventList.TimeTime
Description
Apply actions to event lists (starting with time, ending with time) at given times.
Synopsis
data T time body
mapBody :: (body0 -> body1) -> T time body0 -> T time body1
mapTime :: (time0 -> time1) -> T time0 body -> T time1 body
mapM :: Monad m => (time0 -> m time1) -> (body0 -> m body1) -> T time0 body0 -> m (T time1 body1)
mapM_ :: Monad m => (time -> m ()) -> (body -> m ()) -> T time body -> m ()
empty :: T time body
pause :: time -> T time body
merge :: (C time, Ord body) => T time body -> T time body -> T time body
insert :: (C time, Ord body) => time -> body -> T time body -> T time body
decreaseStart :: C time => time -> T time body -> T time body
delay :: C time => time -> T time body -> T time body
filter :: Num time => (body -> Bool) -> T time body -> T time body
foldr :: (time -> a -> b) -> (body -> b -> a) -> a -> T time body -> b
viewTimeL :: T time body -> (time, T time body)
viewBodyL :: T time body -> Maybe (body, T time body)
viewTimeR :: T time body -> (T time body, time)
viewBodyR :: T time body -> Maybe (T time body, body)
cons :: time -> body -> T time body -> T time body
consBody :: body -> T time body -> T time body
consTime :: time -> T time body -> T time body
snoc :: T time body -> body -> time -> T time body
snocBody :: T time body -> body -> T time body
snocTime :: T time body -> time -> T time body
mapTimeL :: (time -> time, T time body0 -> T time body1) -> T time body0 -> T time body1
mapTimeHead :: (time -> time) -> T time body -> T time body
mapTimeTail :: (T time body0 -> T time body1) -> T time body0 -> T time body1
mapBodyL :: (body -> body, T time0 body -> T time1 body) -> T time0 body -> T time1 body
mapBodyHead :: (body -> body) -> T time body -> T time body
mapBodyTail :: (T time0 body -> T time1 body) -> T time0 body -> T time1 body
mapTimeR :: (T time body0 -> T time body1, time -> time) -> T time body0 -> T time body1
mapTimeLast :: (time -> time) -> T time body -> T time body
mapTimeInit :: (T time body0 -> T time body1) -> T time body0 -> T time body1
mapBodyR :: (T time0 body -> T time1 body, body -> body) -> T time0 body -> T time1 body
mapBodyLast :: (body -> body) -> T time body -> T time body
mapBodyInit :: (T time0 body -> T time1 body) -> T time0 body -> T time1 body
catMaybes :: Num time => T time (Maybe body) -> T time body
append :: C time => T time body -> T time body -> T time body
concat :: C time => [T time body] -> T time body
concatNaive :: C time => [T time body] -> T time body
resample :: (C time, RealFrac time, C i, Integral i) => time -> T time body -> T i body
toAbsoluteEventList :: Num time => time -> T time body -> T time body
run :: (RealFrac time, Monad m) => T m -> (body -> m a) -> T time body -> m [a]
runTimeStamp :: (RealFrac time, Monad m) => T m -> (time -> body -> m a) -> T time body -> m [a]
runTimeStampGrouped :: (RealFrac time, Monad m) => T m -> (time -> [body] -> m a) -> T time body -> m [a]
runRelative :: (C time, RealFrac time, Monad m) => T m -> (body -> m a) -> T time body -> m [a]
collectCoincident :: C time => T time body -> T time [body]
flatten :: Num time => T time [body] -> T time body
mapCoincident :: C time => ([a] -> [b]) -> T time a -> T time b
Documentation
data T time body Source
show/hide Instances
(Eq time, Eq body) => Eq (T time body)
(Ord time, Ord body) => Ord (T time body)
(Show time, Show body) => Show (T time body)
(Arbitrary time, Arbitrary body) => Arbitrary (T time body)
mapBody :: (body0 -> body1) -> T time body0 -> T time body1Source
mapTime :: (time0 -> time1) -> T time0 body -> T time1 bodySource
mapM :: Monad m => (time0 -> m time1) -> (body0 -> m body1) -> T time0 body0 -> m (T time1 body1)Source
mapM_ :: Monad m => (time -> m ()) -> (body -> m ()) -> T time body -> m ()Source
empty :: T time bodySource
pause :: time -> T time bodySource
merge :: (C time, Ord body) => T time body -> T time body -> T time bodySource
The first important function is merge which merges the events of two lists into a new time order list.
insert :: (C time, Ord body) => time -> body -> T time body -> T time bodySource

Note that merge compares entire events rather than just start times. This is to ensure that it is commutative, a desirable condition for some of the proofs used in secref{equivalence}. It is also necessary to assert a unique representation of the performance independent of the structure of the 'Music.T note'. The same function for inserting into a time ordered list with a trailing pause. The strictness annotation is necessary for working with infinite lists.

Here are two other functions that are already known for non-padded time lists.

decreaseStart :: C time => time -> T time body -> T time bodySource
delay :: C time => time -> T time body -> T time bodySource
filter :: Num time => (body -> Bool) -> T time body -> T time bodySource
Analogously to the concat / concatNaive pair we have to versions of filter, where the clever implementation sums up pauses from the beginning to the end.
foldr :: (time -> a -> b) -> (body -> b -> a) -> a -> T time body -> bSource
viewTimeL :: T time body -> (time, T time body)Source
viewBodyL :: T time body -> Maybe (body, T time body)Source
viewTimeR :: T time body -> (T time body, time)Source
viewBodyR :: T time body -> Maybe (T time body, body)Source
cons :: time -> body -> T time body -> T time bodySource
consBody :: body -> T time body -> T time bodySource
consTime :: time -> T time body -> T time bodySource
snoc :: T time body -> body -> time -> T time bodySource
snocBody :: T time body -> body -> T time bodySource
snocTime :: T time body -> time -> T time bodySource
mapTimeL :: (time -> time, T time body0 -> T time body1) -> T time body0 -> T time body1Source
mapTimeHead :: (time -> time) -> T time body -> T time bodySource
mapTimeTail :: (T time body0 -> T time body1) -> T time body0 -> T time body1Source
mapBodyL :: (body -> body, T time0 body -> T time1 body) -> T time0 body -> T time1 bodySource
mapBodyHead :: (body -> body) -> T time body -> T time bodySource
mapBodyTail :: (T time0 body -> T time1 body) -> T time0 body -> T time1 bodySource
mapTimeR :: (T time body0 -> T time body1, time -> time) -> T time body0 -> T time body1Source
mapTimeLast :: (time -> time) -> T time body -> T time bodySource
mapTimeInit :: (T time body0 -> T time body1) -> T time body0 -> T time body1Source
mapBodyR :: (T time0 body -> T time1 body, body -> body) -> T time0 body -> T time1 bodySource
mapBodyLast :: (body -> body) -> T time body -> T time bodySource
mapBodyInit :: (T time0 body -> T time1 body) -> T time0 body -> T time1 bodySource
catMaybes :: Num time => T time (Maybe body) -> T time bodySource
Adds times in a left-associative fashion. Use this if the time is a strict data type.
append :: C time => T time body -> T time body -> T time bodySource
concat :: C time => [T time body] -> T time bodySource
concatNaive :: C time => [T time body] -> T time bodySource
concat and concatNaive are essentially the same. concat must use foldr in order to work on infinite lists, however if there are many empty lists, summing of their durations will be done from right to left, which is inefficient. Thus we detect subsequent empty lists and merge them from left to right.
resample :: (C time, RealFrac time, C i, Integral i) => time -> T time body -> T i bodySource
toAbsoluteEventList :: Num time => time -> T time body -> T time bodySource
run :: (RealFrac time, Monad m) => T m -> (body -> m a) -> T time body -> m [a]Source
runTimeStamp :: (RealFrac time, Monad m) => T m -> (time -> body -> m a) -> T time body -> m [a]Source
runTimeStampGrouped :: (RealFrac time, Monad m) => T m -> (time -> [body] -> m a) -> T time body -> m [a]Source
runRelative :: (C time, RealFrac time, Monad m) => T m -> (body -> m a) -> T time body -> m [a]Source
collectCoincident :: C time => T time body -> T time [body]Source
flatten :: Num time => T time [body] -> T time bodySource
mapCoincident :: C time => ([a] -> [b]) -> T time a -> T time bSource
Produced by Haddock version 2.7.2