-- 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 {-# LANGUAGE DeriveDataTypeable #-} {- | RealTime represents seconds, as opposed to ScoreTime, which is in abstract units. Everything eventually is transformed into RealTime to be performed. This type has switched from floating point to decimal and back again. The problem is that floating point is not exact, but there are a few operations that require events that have the same ScoreTime to be grouped with each other once they reach RealTime. For instance, controls are clipped to the note boundaries, and a note is required to have a pitch at exactly its starting time. While the event that produces the pitch signal may have the same ScoreTime as the note it belongs to, if imprecision has caused it to drift a little by the time it gets to performance, the note may wind up with no initial pitch, or pick up the pitch of the next note as a pitch bend. An example of how imprecision can accumulate is a block call with pitch set in the caller. If the sub-block has a note at 0 this should line up with the start of the block call in the super-block and hence with a pitch at the same time. But the sub-block has its own warp which is a composition of the its tempo and the super-block's tempo. In theory the sub-block's warp should be shifted so its 0 starts at the calling point in the super-block, but in practice this is a number of floating point operations (addition, linear interpolation, ...) and the value may very well be slightly different. Unfortunately switching RealTime to a lower-precision decimal type has the same problem because it introduces even more imprecision due to the ScoreTime -> RealTime -> ScoreTime conversion (this happens during warp composition, for instance, since shift and stretch are in ScoreTime). And I think it's ultimately not quite right because rounding will still produce incorrect results if the imprecise value falls at a rounding boundary. Eventually, for MIDI at least, everything is rounded down to milliseconds so hopefully any imprecision can be accounted for by the operations that care about it and eventually be removed from the final result. -} module Perform.RealTime ( RealTime, div, mul, large, larger, suffix , show_units -- * convert from , seconds, milliseconds, microseconds, from_score -- * convert to , to_diff, to_seconds, to_milliseconds, to_microseconds, to_score -- * misc , eta, (==), (>), (<=) ) where import qualified Prelude import Prelude hiding ((==), (>), (<=), div) import qualified Control.DeepSeq as DeepSeq import qualified Data.Aeson as Aeson import qualified Data.Text as Text import qualified Data.Time as Time import qualified Data.Typeable as Typeable import qualified Foreign import qualified ForeignC as C import qualified Text.Read as Read import qualified Util.FFI as FFI import qualified Util.Num as Num import qualified Util.Pretty as Pretty import qualified Util.Serialize as Serialize import qualified Util.Test.ApproxEq as ApproxEq import qualified Derive.ShowVal as ShowVal import qualified Ui.ScoreTime as ScoreTime import Global -- | A concrete unit of time. -- -- This must have negative values because it's used for signals, which are -- used for the warp map, which is oriented with zero at the note start. If -- a note wants to get the real time before it, it must look up a negative -- RealTime. newtype RealTime = RealTime Double deriving ( RealTime -> () forall a. (a -> ()) -> NFData a rnf :: RealTime -> () $crnf :: RealTime -> () DeepSeq.NFData, Integer -> RealTime RealTime -> RealTime RealTime -> RealTime -> RealTime forall a. (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> (a -> a) -> (a -> a) -> (a -> a) -> (Integer -> a) -> Num a fromInteger :: Integer -> RealTime $cfromInteger :: Integer -> RealTime signum :: RealTime -> RealTime $csignum :: RealTime -> RealTime abs :: RealTime -> RealTime $cabs :: RealTime -> RealTime negate :: RealTime -> RealTime $cnegate :: RealTime -> RealTime * :: RealTime -> RealTime -> RealTime $c* :: RealTime -> RealTime -> RealTime - :: RealTime -> RealTime -> RealTime $c- :: RealTime -> RealTime -> RealTime + :: RealTime -> RealTime -> RealTime $c+ :: RealTime -> RealTime -> RealTime Num, Num RealTime Rational -> RealTime RealTime -> RealTime RealTime -> RealTime -> RealTime forall a. Num a -> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a fromRational :: Rational -> RealTime $cfromRational :: Rational -> RealTime recip :: RealTime -> RealTime $crecip :: RealTime -> RealTime / :: RealTime -> RealTime -> RealTime $c/ :: RealTime -> RealTime -> RealTime Fractional, Num RealTime Ord RealTime RealTime -> Rational forall a. Num a -> Ord a -> (a -> Rational) -> Real a toRational :: RealTime -> Rational $ctoRational :: RealTime -> Rational Real, Fractional RealTime Real RealTime forall b. Integral b => RealTime -> b forall b. Integral b => RealTime -> (b, RealTime) forall a. Real a -> Fractional a -> (forall b. Integral b => a -> (b, a)) -> (forall b. Integral b => a -> b) -> (forall b. Integral b => a -> b) -> (forall b. Integral b => a -> b) -> (forall b. Integral b => a -> b) -> RealFrac a floor :: forall b. Integral b => RealTime -> b $cfloor :: forall b. Integral b => RealTime -> b ceiling :: forall b. Integral b => RealTime -> b $cceiling :: forall b. Integral b => RealTime -> b round :: forall b. Integral b => RealTime -> b $cround :: forall b. Integral b => RealTime -> b truncate :: forall b. Integral b => RealTime -> b $ctruncate :: forall b. Integral b => RealTime -> b properFraction :: forall b. Integral b => RealTime -> (b, RealTime) $cproperFraction :: forall b. Integral b => RealTime -> (b, RealTime) RealFrac, RealTime -> RealTime -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: RealTime -> RealTime -> Bool $c/= :: RealTime -> RealTime -> Bool == :: RealTime -> RealTime -> Bool $c== :: RealTime -> RealTime -> Bool Eq, Eq RealTime RealTime -> RealTime -> Bool RealTime -> RealTime -> Ordering RealTime -> RealTime -> RealTime forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: RealTime -> RealTime -> RealTime $cmin :: RealTime -> RealTime -> RealTime max :: RealTime -> RealTime -> RealTime $cmax :: RealTime -> RealTime -> RealTime >= :: RealTime -> RealTime -> Bool $c>= :: RealTime -> RealTime -> Bool > :: RealTime -> RealTime -> Bool $c> :: RealTime -> RealTime -> Bool <= :: RealTime -> RealTime -> Bool $c<= :: RealTime -> RealTime -> Bool < :: RealTime -> RealTime -> Bool $c< :: RealTime -> RealTime -> Bool compare :: RealTime -> RealTime -> Ordering $ccompare :: RealTime -> RealTime -> Ordering Ord , Get RealTime Putter RealTime forall a. Putter a -> Get a -> Serialize a get :: Get RealTime $cget :: Get RealTime put :: Putter RealTime $cput :: Putter RealTime Serialize.Serialize, Double -> RealTime -> RealTime -> Bool forall a. (Double -> a -> a -> Bool) -> ApproxEq a eq :: Double -> RealTime -> RealTime -> Bool $ceq :: Double -> RealTime -> RealTime -> Bool ApproxEq.ApproxEq , Typeable.Typeable , [RealTime] -> Encoding [RealTime] -> Value RealTime -> Encoding RealTime -> Value forall a. (a -> Value) -> (a -> Encoding) -> ([a] -> Value) -> ([a] -> Encoding) -> ToJSON a toEncodingList :: [RealTime] -> Encoding $ctoEncodingList :: [RealTime] -> Encoding toJSONList :: [RealTime] -> Value $ctoJSONList :: [RealTime] -> Value toEncoding :: RealTime -> Encoding $ctoEncoding :: RealTime -> Encoding toJSON :: RealTime -> Value $ctoJSON :: RealTime -> Value Aeson.ToJSON, Value -> Parser [RealTime] Value -> Parser RealTime forall a. (Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a parseJSONList :: Value -> Parser [RealTime] $cparseJSONList :: Value -> Parser [RealTime] parseJSON :: Value -> Parser RealTime $cparseJSON :: Value -> Parser RealTime Aeson.FromJSON ) -- I could derive Storable, but technically speaking Double is not necessarily -- the same as CDouble. instance Foreign.Storable RealTime where sizeOf :: RealTime -> Int sizeOf RealTime _ = forall a. Storable a => a -> Int Foreign.sizeOf (CDouble 0 :: C.CDouble) alignment :: RealTime -> Int alignment RealTime _ = forall a. Storable a => a -> Int Foreign.alignment (CDouble 0 :: C.CDouble) poke :: Ptr RealTime -> RealTime -> IO () poke Ptr RealTime p (RealTime Double d) = forall a. Storable a => Ptr a -> a -> IO () Foreign.poke (forall a b. Ptr a -> Ptr b Foreign.castPtr Ptr RealTime p) (Double -> CDouble FFI.c_double Double d) peek :: Ptr RealTime -> IO RealTime peek Ptr RealTime p = Double -> RealTime RealTime forall b c a. (b -> c) -> (a -> b) -> a -> c . CDouble -> Double FFI.hs_double forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Storable a => Ptr a -> IO a Foreign.peek (forall a b. Ptr a -> Ptr b Foreign.castPtr Ptr RealTime p) instance C.CStorable RealTime where sizeOf :: RealTime -> Int sizeOf = forall a. Storable a => a -> Int Foreign.sizeOf alignment :: RealTime -> Int alignment = forall a. Storable a => a -> Int Foreign.alignment peek :: Ptr RealTime -> IO RealTime peek = forall a. Storable a => Ptr a -> IO a Foreign.peek poke :: Ptr RealTime -> RealTime -> IO () poke = forall a. Storable a => Ptr a -> a -> IO () Foreign.poke instance Show RealTime where show :: RealTime -> String show (RealTime Double t) = forall a. Show a => a -> String show Double t instance Read.Read RealTime where readPrec :: ReadPrec RealTime readPrec = Double -> RealTime RealTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Read a => ReadPrec a Read.readPrec instance ShowVal.ShowVal RealTime where show_val :: RealTime -> Text show_val = (Text -> Char -> Text `Text.snoc` Char suffix) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. RealFloat a => Int -> a -> Text Num.showFloat Int 3 forall b c a. (b -> c) -> (a -> b) -> a -> c . RealTime -> Double to_seconds instance Pretty RealTime where pretty :: RealTime -> Text pretty RealTime t -- Display 'large' specially, to avoid confusing giant numbers. | RealTime t forall a. Ord a => a -> a -> Bool Prelude.>= RealTime large = Text "large" | RealTime t forall a. Ord a => a -> a -> Bool Prelude.<= -RealTime large = Text "-large" | Bool otherwise = forall a. RealFloat a => Bool -> Int -> a -> Text Num.showFloatP Bool False Int 2 (RealTime -> Double to_seconds RealTime t) forall a. Semigroup a => a -> a -> a <> Char -> Text Text.singleton Char suffix div :: RealTime -> Double -> RealTime div :: RealTime -> Double -> RealTime div RealTime a Double b = Double -> RealTime seconds (RealTime -> Double to_seconds RealTime a forall a. Fractional a => a -> a -> a / Double b) infixl 7 `div` mul :: RealTime -> Double -> RealTime mul :: RealTime -> Double -> RealTime mul RealTime a Double b = Double -> RealTime seconds (RealTime -> Double to_seconds RealTime a forall a. Num a => a -> a -> a * Double b) infixl 7 `mul` -- | A large RealTime as a stand-in for "forever" in signals. -- -- I tried Infinity, but a constant signal starting at -Infinity will have -- an integral ending at (Infinity, Infinity) (or (Infinity, NaN) in practice), -- at which point I lost the slope. -- -- 1e10 is recognizable in debugging output as a special value, and still quite -- far away from 2^53 (9e15), which is where integers can no longer be -- represented exactly in a 64 bit Double. This means I can take the integral -- at a steep slope and I should still be in the realm of exact integers, which -- means the slope should stay accurate. large :: RealTime large :: RealTime large = RealTime 1e10 -- | Comfortably bigger than 'large', so it won't cross large given normal -- amounts of time shift. larger :: RealTime larger :: RealTime larger = RealTime 1e11 suffix :: Char suffix :: Char suffix = Char 's' -- | Show RealTime as hours, minutes, seconds. show_units :: RealTime -> Text show_units :: RealTime -> Text show_units = NominalDiffTime -> Text Pretty.duration forall b c a. (b -> c) -> (a -> b) -> a -> c . RealTime -> NominalDiffTime to_diff -- * convert from seconds :: Double -> RealTime seconds :: Double -> RealTime seconds = Double -> RealTime RealTime milliseconds :: Integer -> RealTime milliseconds :: Integer -> RealTime milliseconds = Double -> RealTime seconds forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall a. Fractional a => a -> a -> a /Double 1000) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Integral a, Num b) => a -> b fromIntegral microseconds :: Integer -> RealTime microseconds :: Integer -> RealTime microseconds = Double -> RealTime seconds forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall a. Fractional a => a -> a -> a /Double 1000000) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Integral a, Num b) => a -> b fromIntegral from_score :: ScoreTime.ScoreTime -> RealTime from_score :: ScoreTime -> RealTime from_score = Double -> RealTime seconds forall b c a. (b -> c) -> (a -> b) -> a -> c . ScoreTime -> Double ScoreTime.to_double -- * convert to to_diff :: RealTime -> Time.NominalDiffTime to_diff :: RealTime -> NominalDiffTime to_diff = forall a b. (Real a, Fractional b) => a -> b realToFrac to_seconds :: RealTime -> Double to_seconds :: RealTime -> Double to_seconds (RealTime Double s) = Double s to_milliseconds :: RealTime -> Integer to_milliseconds :: RealTime -> Integer to_milliseconds = forall a b. (RealFrac a, Integral b) => a -> b round forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall a. Num a => a -> a -> a *Double 1000) forall b c a. (b -> c) -> (a -> b) -> a -> c . RealTime -> Double to_seconds to_microseconds :: RealTime -> Integer to_microseconds :: RealTime -> Integer to_microseconds = forall a b. (RealFrac a, Integral b) => a -> b round forall b c a. (b -> c) -> (a -> b) -> a -> c . (forall a. Num a => a -> a -> a *Double 1000000) forall b c a. (b -> c) -> (a -> b) -> a -> c . RealTime -> Double to_seconds to_score :: RealTime -> ScoreTime.ScoreTime to_score :: RealTime -> ScoreTime to_score = Double -> ScoreTime ScoreTime.from_double forall b c a. (b -> c) -> (a -> b) -> a -> c . RealTime -> Double to_seconds -- | Eta for comparison. Since RealTimes are seconds, this amount of time is -- definitely unnoticeable. eta :: RealTime eta :: RealTime eta = RealTime 0.0000000000004 -- | RealTimes are imprecise, so compare them with this instead of (==). (==) :: RealTime -> RealTime -> Bool == :: RealTime -> RealTime -> Bool (==) = forall a. ApproxEq a => Double -> a -> a -> Bool ApproxEq.eq (RealTime -> Double to_seconds RealTime eta) infix 4 == (>), (<=) :: RealTime -> RealTime -> Bool RealTime a > :: RealTime -> RealTime -> Bool > RealTime b = RealTime a forall a. Num a => a -> a -> a - RealTime eta forall a. Ord a => a -> a -> Bool Prelude.> RealTime b RealTime a <= :: RealTime -> RealTime -> Bool <= RealTime b = Bool -> Bool not (RealTime a RealTime -> RealTime -> Bool > RealTime b) infix 4 > infix 4 <=