module Music.Time.Behavior (
Behavior,
) where
import Prelude hiding (trimAfter)
import Control.Applicative
import Control.Arrow
import Control.Lens
import Control.Monad
import Control.Monad.Compose
import Control.Monad.Plus
import Data.AffineSpace
import Data.AffineSpace.Point
import Data.Foldable (Foldable)
import qualified Data.Foldable as F
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.NumInstances ()
import Data.Profunctor
import Data.Semigroup
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable (Traversable)
import qualified Data.Traversable as T
import Data.Typeable
import Data.VectorSpace
import Music.Dynamics.Literal
import Music.Pitch.Literal
import Music.Time.Delayable
import Music.Time.Reactive
import Music.Time.Span
import Music.Time.Stretchable
import Music.Time.Time
import Music.Time.Time
newtype Behavior a = Behavior { getBehavior :: Reactive (Time -> a) }
deriving (Functor, Semigroup, Monoid)
instance Delayable (Behavior a) where
delay n (Behavior x) = Behavior (fmap (delay n) $ delay n x)
instance Stretchable (Behavior a) where
stretch n (Behavior x) = Behavior (fmap (stretch n) $ stretch n x)
instance Wrapped (Behavior a) where
type Unwrapped (Behavior a) = (Reactive (Time -> a))
_Wrapped' = iso getBehavior Behavior
instance Applicative Behavior where
pure = (^. _Unwrapped') . pure . pure
((^. _Wrapped') -> f) <*> ((^. _Wrapped') -> x) = (^. _Unwrapped') $ liftA2 (<*>) f x
instance HasBehavior Behavior where
(?) = behAt
deriving instance Num a => Num (Behavior a)
deriving instance Fractional a => Fractional (Behavior a)
deriving instance Floating a => Floating (Behavior a)
instance IsPitch a => IsPitch (Behavior a) where
fromPitch = pure . fromPitch
instance IsInterval a => IsInterval (Behavior a) where
fromInterval = pure . fromInterval
instance IsDynamics a => IsDynamics (Behavior a) where
fromDynamics = pure . fromDynamics
instance AdditiveGroup a => AdditiveGroup (Behavior a) where
zeroV = pure zeroV
negateV = fmap negateV
(^+^) = liftA2 (^+^)
instance AffineSpace a => AffineSpace (Behavior a) where
type Diff (Behavior a) = Behavior (Diff a)
(.+^) = liftA2 (.+^)
(.-.) = liftA2 (.-.)
constant :: a -> Behavior a
constant = (^. _Unwrapped') . pure . pure
behavior :: (Time -> a) -> Behavior a
behavior = (^. _Unwrapped') . pure
varying :: (Duration -> a) -> Behavior a
varying = varyingIn sunit
varyingIn :: Span -> (Duration -> a) -> Behavior a
varyingIn s f = behavior $ sapp (sinvert s) (lmap (.-. start) f)
behAt :: Behavior a -> Time -> a
b `behAt` t = ((^. _Wrapped') b ? t) t
time :: Behavior Time
time = behavior id