module Music.Time.Delayed (
Delayed,
delayed,
delayedValue,
) where
import Data.AffineSpace
import Data.AffineSpace.Point
import Data.Bifunctor
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Ratio
import Data.Semigroup
import Data.Set (Set)
import qualified Data.Set as Set
import Data.VectorSpace
import Data.String
import Data.Functor.Adjunction (unzipR)
import Control.Applicative
import Control.Comonad
import Control.Comonad.Env
import Control.Lens hiding (Indexable, Level, above, below,
index, inside, parts, reversed,
transform, (<|), (|>))
import Data.Foldable (Foldable)
import qualified Data.Foldable as Foldable
import Data.PairMonad
import Data.Typeable
import Music.Dynamics.Literal
import Music.Pitch.Literal
import Music.Time.Reverse
import Music.Time.Split
newtype Delayed a = Delayed { _delayedValue :: (Time, a) }
deriving (Eq,
Applicative, Monad,
Functor, Foldable, Traversable, Typeable)
instance (Show a, Transformable a) => Show (Delayed a) where
show x = show (x^.from delayed) ++ "^.delayed"
instance Wrapped (Delayed a) where
type Unwrapped (Delayed a) = (Time, a)
_Wrapped' = iso _delayedValue Delayed
instance Rewrapped (Delayed a) (Delayed b)
instance Transformable (Delayed a) where
transform t = over _Wrapped $ first (transform t)
instance HasDuration (Delayed a) where
_duration x = _offset x .-. _onset x
instance HasPosition (Delayed a) where
x `_position` p = ask (view _Wrapped x) `_position` p
instance Reversible (Delayed a) where
rev = revDefault
instance Splittable a => Splittable (Delayed a) where
split t = unzipR . fmap (split t)
instance IsString a => IsString (Delayed a) where
fromString = pure . fromString
instance IsPitch a => IsPitch (Delayed a) where
fromPitch = pure . fromPitch
instance IsInterval a => IsInterval (Delayed a) where
fromInterval = pure . fromInterval
instance IsDynamics a => IsDynamics (Delayed a) where
fromDynamics = pure . fromDynamics
delayed :: Iso (Time, a) (Time, b) (Delayed a) (Delayed b)
delayed = _Unwrapped
delayedValue :: (Transformable a, Transformable b)
=> Lens
(Delayed a) (Delayed b)
a b
delayedValue = lens runDelayed (flip $ _delayed . const)
where
_delayed f (Delayed (t,x)) = Delayed (t, f `whilst` delaying (t .-. 0) $ x)
runDelayed :: Transformable a => Delayed a -> a
runDelayed = uncurry delayTime . view _Wrapped
where
delayTime t = delay (t .-. 0)