-- Copyright 2013 Evan Laforge -- This program is distributed under the terms of the GNU General Public -- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt -- | Utilities dealing with speeds. module Derive.Call.Speed where import qualified Derive.Call as Call import qualified Derive.Call.ControlUtil as ControlUtil import qualified Derive.Derive as Derive import qualified Derive.DeriveT as DeriveT import qualified Derive.Deriver.Internal as Internal import qualified Derive.ScoreT as ScoreT import qualified Derive.ShowVal as ShowVal import qualified Derive.Sig as Sig import qualified Derive.Typecheck as Typecheck import qualified Derive.ValType as ValType import qualified Derive.Warp as Warp import qualified Perform.RealTime as RealTime import qualified Ui.ScoreTime as ScoreTime import Global import Types data Speed = Score !ScoreTime | Real !RealTime deriving (Int -> Speed -> ShowS [Speed] -> ShowS Speed -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Speed] -> ShowS $cshowList :: [Speed] -> ShowS show :: Speed -> String $cshow :: Speed -> String showsPrec :: Int -> Speed -> ShowS $cshowsPrec :: Int -> Speed -> ShowS Show) -- TODO this is a lot of boilerplate just to participate in Typecheck. instance Typecheck.Typecheck Speed where from_val :: Val -> Checked Speed from_val = forall a. (Typed Double -> Maybe a) -> Val -> Checked a Typecheck.coerce_to_scalar forall a b. (a -> b) -> a -> b $ \(ScoreT.Typed Type typ Double val) -> case Type typ of Type ScoreT.Untyped -> forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ RealTime -> Speed Real (Double -> RealTime RealTime.seconds Double val) Type ScoreT.Real -> forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ RealTime -> Speed Real (Double -> RealTime RealTime.seconds Double val) Type ScoreT.Score -> forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ ScoreTime -> Speed Score (Double -> ScoreTime ScoreTime.from_double Double val) Type _ -> forall a. Maybe a Nothing to_type :: Proxy Speed -> Type to_type = forall a. TypecheckNum a => Proxy a -> Type Typecheck.num_to_type instance Typecheck.ToVal Speed where to_val :: Speed -> Val to_val (Score ScoreTime a) = forall a. ToVal a => a -> Val Typecheck.to_val ScoreTime a to_val (Real RealTime a) = forall a. ToVal a => a -> Val Typecheck.to_val RealTime a instance Typecheck.TypecheckNum Speed where num_type :: Proxy Speed -> NumType num_type Proxy Speed _ = NumType ValType.TTime instance ShowVal.ShowVal Speed where show_val :: Speed -> Text show_val (Score ScoreTime s) = forall a. ShowVal a => a -> Text ShowVal.show_val ScoreTime s show_val (Real RealTime s) = forall a. ShowVal a => a -> Text ShowVal.show_val RealTime s arg :: Sig.Parser Typecheck.RealTimeFunctionT arg :: Parser RealTimeFunctionT arg = forall a deflt. (Typecheck a, ToVal deflt) => ArgName -> EnvironDefault -> deflt -> Doc -> Parser a Sig.defaulted_env ArgName "speed" EnvironDefault Derive.Both (Int 10 :: Int) Doc "Repeat at this speed. If it's a RealTime, the value is the number of\ \ repeats per second, which will be unaffected by the tempo. If it's\ \ a ScoreTime, the value is the number of repeats per ScoreTime\ \ unit, and will stretch along with tempo changes." -- | Get start times until the end of the range, at the given speed. starts :: Derive.Time t => Typecheck.RealTimeFunctionT -> (t, t) -> Bool -- ^ If True, include a sample at the end time. -> Derive.Deriver [RealTime] starts :: forall t. Time t => RealTimeFunctionT -> (t, t) -> Bool -> Deriver [RealTime] starts (Typecheck.RealTimeFunctionT TimeT ttype Function speed) (t start_, t end_) Bool include_end = do let take_until :: a -> [a] -> [a] take_until a e = if Bool include_end then forall a. a -> a id else forall a. (a -> Bool) -> [a] -> [a] takeWhile (forall a. Ord a => a -> a -> Bool <a e) case TimeT ttype of TimeT ScoreT.TReal -> do (RealTime start, RealTime end) <- (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Time a => a -> Deriver RealTime Derive.real t start_ forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. Time a => a -> Deriver RealTime Derive.real t end_ forall {a}. Ord a => a -> [a] -> [a] take_until RealTime end forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Function -> RealTime -> RealTime -> Deriver [RealTime] real_starts Function speed RealTime start RealTime end TimeT ScoreT.TScore -> do (ScoreTime start, ScoreTime end) <- (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Time a => a -> Deriver ScoreTime Derive.score t start_ forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. Time a => a -> Deriver ScoreTime Derive.score t end_ forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM forall a. Time a => a -> Deriver RealTime Derive.real forall b c a. (b -> c) -> (a -> b) -> a -> c . forall {a}. Ord a => a -> [a] -> [a] take_until ScoreTime end forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Function -> ScoreTime -> ScoreTime -> Deriver [ScoreTime] score_starts Function speed ScoreTime start ScoreTime end -- | Get start times for a changing speed. The difference with 'starts' is -- that the start and end speeds can be different types. starts_curve :: ControlUtil.CurveF -> Speed -> Speed -> (RealTime, RealTime) -> Bool -- ^ If True, include a sample at the end time. -> Derive.Deriver [RealTime] starts_curve :: CurveF -> Speed -> Speed -> (RealTime, RealTime) -> Bool -> Deriver [RealTime] starts_curve CurveF curve Speed start_speed Speed end_speed (RealTime start, RealTime end) Bool include_end = do RealTime start_dur <- forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver RealTime Call.real_duration RealTime start (Speed -> Duration speed_to_duration Speed start_speed) RealTime end_dur <- forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver RealTime Call.real_duration RealTime end (Speed -> Duration speed_to_duration Speed end_speed) let dur_at :: RealTime -> RealTime dur_at = Double -> RealTime RealTime.seconds forall b c a. (b -> c) -> (a -> b) -> a -> c . CurveF -> RealTime -> Double -> RealTime -> Double -> Function ControlUtil.make_function CurveF curve RealTime start (Function RealTime.to_seconds RealTime start_dur) RealTime end (Function RealTime.to_seconds RealTime end_dur) let take_until :: a -> [a] -> [a] take_until a e = if Bool include_end then forall a. a -> a id else forall a. (a -> Bool) -> [a] -> [a] takeWhile (forall a. Ord a => a -> a -> Bool <a e) forall err a. HasCallStack => (err -> Text) -> Either err a -> Deriver a Derive.require_right forall a. a -> a id forall a b. (a -> b) -> a -> b $ forall {a}. Ord a => a -> [a] -> [a] take_until RealTime end forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. (Num a, Ord a, Show a) => (a -> a) -> a -> a -> Either Text [a] duration_starts RealTime -> RealTime dur_at RealTime start RealTime end speed_to_duration :: Speed -> DeriveT.Duration speed_to_duration :: Speed -> Duration speed_to_duration (Score ScoreTime t) = ScoreTime -> Duration DeriveT.ScoreDuration (ScoreTime 1forall a. Fractional a => a -> a -> a /ScoreTime t) speed_to_duration (Real RealTime t) = RealTime -> Duration DeriveT.RealDuration (RealTime 1forall a. Fractional a => a -> a -> a /RealTime t) -- | Emit RealTimes at the given speed, which may change over time. The speed -- is taken as hertz in real time, and must be >0. -- -- This returns samples up to and including the end. real_starts :: ScoreT.Function -> RealTime -> RealTime -> Derive.Deriver [RealTime] real_starts :: Function -> RealTime -> RealTime -> Deriver [RealTime] real_starts Function speed_sig RealTime start RealTime end = forall err a. HasCallStack => (err -> Text) -> Either err a -> Deriver a Derive.require_right forall a. a -> a id forall a b. (a -> b) -> a -> b $ forall a. (Num a, Ord a, Show a) => (a -> a) -> a -> a -> Either Text [a] duration_starts (Double -> RealTime RealTime.seconds forall b c a. (b -> c) -> (a -> b) -> a -> c . (Double 1/) forall b c a. (b -> c) -> (a -> b) -> a -> c . Function speed_sig) RealTime start RealTime end -- | Emit ScoreTimes at the given speed, which may change over time. The -- ScoreTimes are emitted as the reciprocal of the signal at the given point -- in time, so it must be >0. -- -- The result is that the speed of the emitted samples should depend on the -- tempo in effect. -- -- This returns samples up to and including the end. score_starts :: ScoreT.Function -> ScoreTime -> ScoreTime -> Derive.Deriver [ScoreTime] score_starts :: Function -> ScoreTime -> ScoreTime -> Deriver [ScoreTime] score_starts Function speed_sig ScoreTime start ScoreTime end = do ScoreTime -> ScoreTime dur_sig <- Function -> Deriver (ScoreTime -> ScoreTime) convert_score_signal Function speed_sig forall err a. HasCallStack => (err -> Text) -> Either err a -> Deriver a Derive.require_right forall a. a -> a id forall a b. (a -> b) -> a -> b $ forall a. (Num a, Ord a, Show a) => (a -> a) -> a -> a -> Either Text [a] duration_starts ScoreTime -> ScoreTime dur_sig ScoreTime start (ScoreTime end forall a. Num a => a -> a -> a + ScoreTime ScoreTime.eta) -- | Convert a function from RealTime to a ScoreTime duration to a function -- from ScoreTime to ScoreTime duration. convert_score_signal :: ScoreT.Function -> Derive.Deriver (ScoreTime -> ScoreTime) convert_score_signal :: Function -> Deriver (ScoreTime -> ScoreTime) convert_score_signal Function f = do Warp warp <- Deriver Warp Internal.get_warp forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ Double -> ScoreTime ScoreTime.from_double forall b c a. (b -> c) -> (a -> b) -> a -> c . (Double 1/) forall b c a. (b -> c) -> (a -> b) -> a -> c . Function f forall b c a. (b -> c) -> (a -> b) -> a -> c . Warp -> ScoreTime -> RealTime Warp.warp Warp warp duration_starts :: (Num a, Ord a, Show a) => (a -> a) -> a -> a -> Either Text [a] duration_starts :: forall a. (Num a, Ord a, Show a) => (a -> a) -> a -> a -> Either Text [a] duration_starts a -> a dur_at a start a end = a -> a -> a -> Either Text [a] sample (a -> a dur_at a start) a 0 a start where sample :: a -> a -> a -> Either Text [a] sample a prev_dur a n a t0 | a t forall a. Ord a => a -> a -> Bool > a end = forall (m :: * -> *) a. Monad m => a -> m a return [] | a dur forall a. Ord a => a -> a -> Bool <= a 0 = forall a b. a -> Either a b Left forall a b. (a -> b) -> a -> b $ Text "duration <= 0: " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> Text showt a dur forall a. Semigroup a => a -> a -> a <> Text " at " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> Text showt a t -- Avoid loss of precision for the common case of a constant speed -- signal. | a dur forall a. Eq a => a -> a -> Bool == a prev_dur = (a t:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> a -> a -> a -> Either Text [a] sample a prev_dur (a nforall a. Num a => a -> a -> a +a 1) a t0 | Bool otherwise = (a t:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> a -> a -> a -> Either Text [a] sample a dur a 0 (a tforall a. Num a => a -> a -> a +a dur) where t :: a t = a t0 forall a. Num a => a -> a -> a + a prev_dur forall a. Num a => a -> a -> a * a n dur :: a dur = a -> a dur_at a t