-- 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 -> ()
(RealTime -> ()) -> NFData RealTime
forall a. (a -> ()) -> NFData a
rnf :: RealTime -> ()
$crnf :: RealTime -> ()
DeepSeq.NFData, Integer -> RealTime
RealTime -> RealTime
RealTime -> RealTime -> RealTime
(RealTime -> RealTime -> RealTime)
-> (RealTime -> RealTime -> RealTime)
-> (RealTime -> RealTime -> RealTime)
-> (RealTime -> RealTime)
-> (RealTime -> RealTime)
-> (RealTime -> RealTime)
-> (Integer -> RealTime)
-> Num 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
Num RealTime
-> (RealTime -> RealTime -> RealTime)
-> (RealTime -> RealTime)
-> (Rational -> RealTime)
-> Fractional 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
Num RealTime
-> Ord RealTime -> (RealTime -> Rational) -> Real RealTime
RealTime -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: RealTime -> Rational
$ctoRational :: RealTime -> Rational
Real, Fractional RealTime
Real RealTime
Real RealTime
-> Fractional RealTime
-> (forall b. Integral b => RealTime -> (b, RealTime))
-> (forall b. Integral b => RealTime -> b)
-> (forall b. Integral b => RealTime -> b)
-> (forall b. Integral b => RealTime -> b)
-> (forall b. Integral b => RealTime -> b)
-> RealFrac 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
(RealTime -> RealTime -> Bool)
-> (RealTime -> RealTime -> Bool) -> Eq RealTime
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
Eq RealTime
-> (RealTime -> RealTime -> Ordering)
-> (RealTime -> RealTime -> Bool)
-> (RealTime -> RealTime -> Bool)
-> (RealTime -> RealTime -> Bool)
-> (RealTime -> RealTime -> Bool)
-> (RealTime -> RealTime -> RealTime)
-> (RealTime -> RealTime -> RealTime)
-> Ord 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
Putter RealTime -> Get RealTime -> Serialize 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
(Double -> RealTime -> RealTime -> Bool) -> ApproxEq RealTime
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
(RealTime -> Value)
-> (RealTime -> Encoding)
-> ([RealTime] -> Value)
-> ([RealTime] -> Encoding)
-> ToJSON RealTime
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
(Value -> Parser RealTime)
-> (Value -> Parser [RealTime]) -> FromJSON 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
_ = CDouble -> Int
forall a. Storable a => a -> Int
Foreign.sizeOf (CDouble
0 :: C.CDouble)
    alignment :: RealTime -> Int
alignment RealTime
_ = CDouble -> Int
forall a. Storable a => a -> Int
Foreign.alignment (CDouble
0 :: C.CDouble)
    poke :: Ptr RealTime -> RealTime -> IO ()
poke Ptr RealTime
p (RealTime Double
d) = Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
Foreign.poke (Ptr RealTime -> Ptr CDouble
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 (Double -> RealTime) -> (CDouble -> Double) -> CDouble -> RealTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
FFI.hs_double (CDouble -> RealTime) -> IO CDouble -> IO RealTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
Foreign.peek (Ptr RealTime -> Ptr CDouble
forall a b. Ptr a -> Ptr b
Foreign.castPtr Ptr RealTime
p)

instance C.CStorable RealTime where
    sizeOf :: RealTime -> Int
sizeOf = RealTime -> Int
forall a. Storable a => a -> Int
Foreign.sizeOf
    alignment :: RealTime -> Int
alignment = RealTime -> Int
forall a. Storable a => a -> Int
Foreign.alignment
    peek :: Ptr RealTime -> IO RealTime
peek = Ptr RealTime -> IO RealTime
forall a. Storable a => Ptr a -> IO a
Foreign.peek
    poke :: Ptr RealTime -> RealTime -> IO ()
poke = Ptr RealTime -> RealTime -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
Foreign.poke

instance Show RealTime where show :: RealTime -> String
show (RealTime Double
t) = Double -> String
forall a. Show a => a -> String
show Double
t
instance Read.Read RealTime where readPrec :: ReadPrec RealTime
readPrec = Double -> RealTime
RealTime (Double -> RealTime) -> ReadPrec Double -> ReadPrec RealTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Double
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) (Text -> Text) -> (RealTime -> Text) -> RealTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> Text
forall a. RealFloat a => Int -> a -> Text
Num.showFloat Int
3 (Double -> Text) -> (RealTime -> Double) -> RealTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealTime -> Double
to_seconds

instance Pretty RealTime where
    pretty :: RealTime -> Text
pretty RealTime
t = Bool -> Int -> Double -> Text
forall a. RealFloat a => Bool -> Int -> a -> Text
Num.showFloatP Bool
False Int
2 (RealTime -> Double
to_seconds RealTime
t) Text -> Text -> Text
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 Double -> Double -> Double
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 Double -> Double -> Double
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
-- amonuts 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 (NominalDiffTime -> Text)
-> (RealTime -> NominalDiffTime) -> RealTime -> Text
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 (Double -> RealTime) -> (Integer -> Double) -> Integer -> RealTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1000) (Double -> Double) -> (Integer -> Double) -> Integer -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

microseconds :: Integer -> RealTime
microseconds :: Integer -> RealTime
microseconds = Double -> RealTime
seconds (Double -> RealTime) -> (Integer -> Double) -> Integer -> RealTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1000000) (Double -> Double) -> (Integer -> Double) -> Integer -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

from_score :: ScoreTime.ScoreTime -> RealTime
from_score :: ScoreTime -> RealTime
from_score = Double -> RealTime
seconds (Double -> RealTime)
-> (ScoreTime -> Double) -> ScoreTime -> RealTime
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 = RealTime -> NominalDiffTime
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 = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Integer) -> (RealTime -> Double) -> RealTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
1000) (Double -> Double) -> (RealTime -> Double) -> RealTime -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealTime -> Double
to_seconds

to_microseconds :: RealTime -> Integer
to_microseconds :: RealTime -> Integer
to_microseconds = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Integer) -> (RealTime -> Double) -> RealTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
1000000) (Double -> Double) -> (RealTime -> Double) -> RealTime -> Double
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 (Double -> ScoreTime)
-> (RealTime -> Double) -> RealTime -> ScoreTime
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
(==) = Double -> RealTime -> RealTime -> Bool
forall a. ApproxEq a => Double -> a -> a -> Bool
ApproxEq.eq (RealTime -> Double
to_seconds RealTime
eta)

(>), (<=) :: RealTime -> RealTime -> Bool
RealTime
a > :: RealTime -> RealTime -> Bool
> RealTime
b = RealTime
a RealTime -> RealTime -> RealTime
forall a. Num a => a -> a -> a
- RealTime
eta RealTime -> RealTime -> Bool
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)