-- 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 <=