haskore-realtime-0.1.1: Routines for realtime playback of Haskore songs

Haskore.RealTime.EventList.TimeTime

Description

Apply actions to event lists (starting with time, ending with time) at given times.

Synopsis

Documentation

data T time body

Instances

Functor (T time) 
Foldable (T time) 
Traversable (T time) 
(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) 
C time => Monoid (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

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 body

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 body

delay :: C time => time -> T time body -> T time body

filter :: Num time => (body -> Bool) -> T time body -> T time body

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 -> 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

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 body

concat :: C time => [T time body] -> T time body

concatNaive :: C time => [T time body] -> T time body

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 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]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]

flatten :: Num time => T time [body] -> T time body

mapCoincident :: C time => ([a] -> [b]) -> T time a -> T time b