module Music.Time.Onset (
HasDuration(..),
stretchTo,
HasOnset(..),
HasOffset(..),
startAt,
stopAt,
withSameOnset,
withSameOffset,
durationDefault,
onsetDefault,
offsetDefault,
) where
import Data.AffineSpace
import Data.AffineSpace.Point
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Semigroup
import Data.Set (Set)
import qualified Data.Set as Set
import Data.VectorSpace hiding (Sum)
import Music.Score.Util
import Music.Time.Delayable
import Music.Time.Stretchable
import Music.Time.Time
class HasDuration a where
duration :: a -> Duration
instance HasDuration Duration where
duration = id
instance HasDuration (Duration, a) where
duration = fst
instance HasDuration (Time, Duration, a) where
duration (t,d,x) = d
instance HasDuration a => HasDuration (Product a) where
duration (Product x) = duration x
stretchTo :: (Stretchable a, HasDuration a) => Duration -> a -> a
class HasOnset a where
onset :: a -> Time
class HasOffset a where
offset :: a -> Time
instance HasOnset Time where
onset = id
instance HasOnset (Time, a) where
onset = fst
instance HasOnset (Time, Duration, a) where
onset (t,d,x) = t
instance HasOffset (Time, Duration, a) where
offset (t,d,x) = t .+^ d
instance HasOnset a => HasOnset [a] where
onset = list origin (minimum . fmap onset)
instance HasOffset a => HasOffset [a] where
offset = list origin (maximum . fmap offset)
instance HasOnset a => HasOnset (Set a) where
onset = list origin (onset . head) . Set.toAscList
instance HasOffset a => HasOffset (Set a) where
offset = list origin (offset . last) . Set.toAscList
instance HasOnset k => HasOnset (Map k a) where
onset = list origin (onset . head) . Map.keys
instance HasOffset k => HasOffset (Map k a) where
offset = list origin (offset . last) . Map.keys
instance HasOnset a => HasOnset (Sum a) where
onset (Sum x) = onset x
startAt :: (HasOnset a, Delayable a) => Time -> a -> a
stopAt :: (HasOffset a, Delayable a) => Time -> a -> a
t `stretchTo` x = (t / duration x) `stretch` x
t `startAt` x = (t .-. onset x) `delay` x
t `stopAt` x = (t .-. offset x) `delay` x
withSameOnset :: (Delayable a, HasOnset a, HasOnset b) => (b -> a) -> b -> a
withSameOffset :: (Delayable a, HasOffset a, HasOffset b) => (b -> a) -> b -> a
withSameOnset f a = startAt (onset a) $ f a
withSameOffset f a = stopAt (offset a) $ f a
durationDefault :: (HasOffset a, HasOnset a) => a -> Duration
durationDefault x = offset x .-. onset x
onsetDefault :: (HasOffset a, HasDuration a) => a -> Time
onsetDefault x = offset x .-^ duration x
offsetDefault :: (HasOnset a, HasDuration a) => a -> Time
offsetDefault x = onset x .+^ duration x