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

module Ui.ScoreTime (
    ScoreTime, TrackTime, round, to_double, to_cdouble, from_double, suffix
    , eta, (==), (>), (<=)
    , is_negative
) where
import qualified Prelude
import           Prelude hiding ((==), (>), (<=), round)
import qualified Control.DeepSeq as DeepSeq
import qualified Data.Text as Text
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.Seed as Seed
import qualified Util.Serialize as Serialize
import qualified Util.Test.ApproxEq as ApproxEq

import qualified Derive.ShowVal as ShowVal

import           Global


-- | Score time is the abstract unit of time, and its mapping to real time
-- is dependent on the score context.  ScoreTime units can be negative, but
-- blocks only display events at >=0 ScoreTime.
newtype ScoreTime = ScoreTime Double deriving
    ( ScoreTime -> ()
forall a. (a -> ()) -> NFData a
rnf :: ScoreTime -> ()
$crnf :: ScoreTime -> ()
DeepSeq.NFData, Integer -> ScoreTime
ScoreTime -> ScoreTime
ScoreTime -> ScoreTime -> ScoreTime
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ScoreTime
$cfromInteger :: Integer -> ScoreTime
signum :: ScoreTime -> ScoreTime
$csignum :: ScoreTime -> ScoreTime
abs :: ScoreTime -> ScoreTime
$cabs :: ScoreTime -> ScoreTime
negate :: ScoreTime -> ScoreTime
$cnegate :: ScoreTime -> ScoreTime
* :: ScoreTime -> ScoreTime -> ScoreTime
$c* :: ScoreTime -> ScoreTime -> ScoreTime
- :: ScoreTime -> ScoreTime -> ScoreTime
$c- :: ScoreTime -> ScoreTime -> ScoreTime
+ :: ScoreTime -> ScoreTime -> ScoreTime
$c+ :: ScoreTime -> ScoreTime -> ScoreTime
Num, Num ScoreTime
Rational -> ScoreTime
ScoreTime -> ScoreTime
ScoreTime -> ScoreTime -> ScoreTime
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> ScoreTime
$cfromRational :: Rational -> ScoreTime
recip :: ScoreTime -> ScoreTime
$crecip :: ScoreTime -> ScoreTime
/ :: ScoreTime -> ScoreTime -> ScoreTime
$c/ :: ScoreTime -> ScoreTime -> ScoreTime
Fractional, Num ScoreTime
Ord ScoreTime
ScoreTime -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: ScoreTime -> Rational
$ctoRational :: ScoreTime -> Rational
Real, Fractional ScoreTime
Real ScoreTime
forall b. Integral b => ScoreTime -> b
forall b. Integral b => ScoreTime -> (b, ScoreTime)
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 => ScoreTime -> b
$cfloor :: forall b. Integral b => ScoreTime -> b
ceiling :: forall b. Integral b => ScoreTime -> b
$cceiling :: forall b. Integral b => ScoreTime -> b
round :: forall b. Integral b => ScoreTime -> b
$cround :: forall b. Integral b => ScoreTime -> b
truncate :: forall b. Integral b => ScoreTime -> b
$ctruncate :: forall b. Integral b => ScoreTime -> b
properFraction :: forall b. Integral b => ScoreTime -> (b, ScoreTime)
$cproperFraction :: forall b. Integral b => ScoreTime -> (b, ScoreTime)
RealFrac, ScoreTime -> ScoreTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScoreTime -> ScoreTime -> Bool
$c/= :: ScoreTime -> ScoreTime -> Bool
== :: ScoreTime -> ScoreTime -> Bool
$c== :: ScoreTime -> ScoreTime -> Bool
Eq, Eq ScoreTime
ScoreTime -> ScoreTime -> Bool
ScoreTime -> ScoreTime -> Ordering
ScoreTime -> ScoreTime -> ScoreTime
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 :: ScoreTime -> ScoreTime -> ScoreTime
$cmin :: ScoreTime -> ScoreTime -> ScoreTime
max :: ScoreTime -> ScoreTime -> ScoreTime
$cmax :: ScoreTime -> ScoreTime -> ScoreTime
>= :: ScoreTime -> ScoreTime -> Bool
$c>= :: ScoreTime -> ScoreTime -> Bool
> :: ScoreTime -> ScoreTime -> Bool
$c> :: ScoreTime -> ScoreTime -> Bool
<= :: ScoreTime -> ScoreTime -> Bool
$c<= :: ScoreTime -> ScoreTime -> Bool
< :: ScoreTime -> ScoreTime -> Bool
$c< :: ScoreTime -> ScoreTime -> Bool
compare :: ScoreTime -> ScoreTime -> Ordering
$ccompare :: ScoreTime -> ScoreTime -> Ordering
Ord
    , Get ScoreTime
Putter ScoreTime
forall a. Putter a -> Get a -> Serialize a
get :: Get ScoreTime
$cget :: Get ScoreTime
put :: Putter ScoreTime
$cput :: Putter ScoreTime
Serialize.Serialize, Double -> ScoreTime -> ScoreTime -> Bool
forall a. (Double -> a -> a -> Bool) -> ApproxEq a
eq :: Double -> ScoreTime -> ScoreTime -> Bool
$ceq :: Double -> ScoreTime -> ScoreTime -> Bool
ApproxEq.ApproxEq, Int -> ScoreTime -> Int
forall a. (Int -> a -> Int) -> Seed a
to_seed :: Int -> ScoreTime -> Int
$cto_seed :: Int -> ScoreTime -> Int
Seed.Seed
    )

instance ShowVal.ShowVal ScoreTime where
    show_val :: ScoreTime -> 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
. ScoreTime -> Double
to_double

{- | This is also ScoreTime, but it's relative to the beginning of the track.
    I.e., UI events are all in track time, but when they get shifted and
    stretched as by note slicing they're no longer in TrackTime, but not yet in
    RealTime.

    I'd like to make a type-level distinction because it's easy to get confused
    about whether a time has or hasn't been transformed, but when I tried it
    seemed like a big hassle since I'd really like for TrackTime to be
    a subtype of ScoreTime.  I could do it with a phantom type, but it would
    change about a million type declarations.  And since Events start in
    TrackTime but are then ScoreTime if transformed, they would also need
    a type parameter, along with probably a few other basic data types.

    Unless I work up the courage to do that someday, the least I can do is
    document the difference with a type synonym.
-}
type TrackTime = ScoreTime

{- | Traditionally, time would be an integral type with a highly composite
    number as the unit.  This is so that common musical durations such as 1/3,
    1/6, or 1/64 can be represented exactly.  However, while this is good
    enough for the score, it's insufficiently accurate for derivation, which
    uses ScoreTime to shift and stretch events.

    A principled solution would probably be to use an integral type for UI
    events in "Events.Events" and convert to floating point on derivation.
    However, that seems like a hassle and simply rounding the event's start and
    durations when they go into the track should achieve the same effect.
-}
round :: ScoreTime -> ScoreTime
round :: ScoreTime -> ScoreTime
round ScoreTime
t
    | forall a. RealFloat a => a -> Bool
isNegativeZero (ScoreTime -> Double
to_double ScoreTime
t) = ScoreTime
t
    | Bool
otherwise = Double -> ScoreTime
from_double forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/Double
divisor) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScoreTime -> Integer
to_int forall a b. (a -> b) -> a -> b
$ ScoreTime
t
    where
    to_int :: ScoreTime -> Integer
    to_int :: ScoreTime -> Integer
to_int = forall a b. (RealFrac a, Integral b) => a -> b
Prelude.round forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
*Double
divisor) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScoreTime -> Double
to_double

divisor :: Double
divisor :: Double
divisor = Double
2forall a b. (Num a, Integral b) => a -> b -> a
^Integer
7 forall a. Num a => a -> a -> a
* Double
3forall a b. (Num a, Integral b) => a -> b -> a
^Integer
3 forall a. Num a => a -> a -> a
* Double
5forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2 forall a. Num a => a -> a -> a
* Double
7

-- I could derive Storable, but technically speaking Double is not necessarily
-- the same as CDouble.
instance C.CStorable ScoreTime where
    sizeOf :: ScoreTime -> Int
sizeOf ScoreTime
_ = forall a. CStorable a => a -> Int
C.sizeOf (CDouble
0 :: C.CDouble)
    alignment :: ScoreTime -> Int
alignment ScoreTime
_ = forall a. CStorable a => a -> Int
C.alignment (CDouble
0 :: C.CDouble)
    poke :: Ptr ScoreTime -> ScoreTime -> IO ()
poke Ptr ScoreTime
p (ScoreTime Double
d) = forall a. CStorable a => Ptr a -> a -> IO ()
C.poke (forall a b. Ptr a -> Ptr b
C.castPtr Ptr ScoreTime
p) (Double -> CDouble
FFI.c_double Double
d)
    peek :: Ptr ScoreTime -> IO ScoreTime
peek Ptr ScoreTime
p = Double -> ScoreTime
ScoreTime 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. CStorable a => Ptr a -> IO a
C.peek (forall a b. Ptr a -> Ptr b
C.castPtr Ptr ScoreTime
p)

instance Show ScoreTime where show :: ScoreTime -> String
show (ScoreTime Double
n) = forall a. Show a => a -> String
show Double
n
instance Read.Read ScoreTime where readPrec :: ReadPrec ScoreTime
readPrec = Double -> ScoreTime
ScoreTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => ReadPrec a
Read.readPrec

instance Pretty ScoreTime where
    pretty :: ScoreTime -> Text
pretty (ScoreTime Double
p) = forall a. RealFloat a => Bool -> Int -> a -> Text
Num.showFloatP Bool
False Int
3 Double
p forall a. Semigroup a => a -> a -> a
<> Char -> Text
Text.singleton Char
suffix

to_double :: ScoreTime -> Double
to_double :: ScoreTime -> Double
to_double (ScoreTime Double
p) = Double
p

to_cdouble :: ScoreTime -> C.CDouble
to_cdouble :: ScoreTime -> CDouble
to_cdouble = Double -> CDouble
C.CDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScoreTime -> Double
to_double

from_double :: Double -> ScoreTime
from_double :: Double -> ScoreTime
from_double = Double -> ScoreTime
ScoreTime

-- | t is for time, since RealTime uses s for seconds
suffix :: Char
suffix :: Char
suffix = Char
't'

-- | Eta for comparison.  ScoreTimes are all relative, but there's no reason to
-- use such tiny ones.
eta :: ScoreTime
eta :: ScoreTime
eta = ScoreTime
0.00000000000004

-- | ScoreTimes are imprecise, so compare them with this instead of (==).
(==) :: ScoreTime -> ScoreTime -> Bool
== :: ScoreTime -> ScoreTime -> Bool
(==) = forall a. ApproxEq a => Double -> a -> a -> Bool
ApproxEq.eq (ScoreTime -> Double
to_double ScoreTime
eta)

-- | True if the second is greater than the first - eta.  This can be used to
-- determine if the start of an event has passed, while giving a little bit of
-- extra allowance if its close enough.
(>), (<=) :: ScoreTime -> ScoreTime -> Bool
ScoreTime
a > :: ScoreTime -> ScoreTime -> Bool
> ScoreTime
b = ScoreTime
a forall a. Num a => a -> a -> a
- ScoreTime
eta forall a. Ord a => a -> a -> Bool
Prelude.> ScoreTime
b
ScoreTime
a <= :: ScoreTime -> ScoreTime -> Bool
<= ScoreTime
b = Bool -> Bool
not (ScoreTime
a ScoreTime -> ScoreTime -> Bool
> ScoreTime
b)

-- | Unlike <0, this counts -0 as negative.
is_negative :: ScoreTime -> Bool
is_negative :: ScoreTime -> Bool
is_negative (ScoreTime Double
t) = Double
t forall a. Ord a => a -> a -> Bool
< Double
0 Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNegativeZero Double
t