-- 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 -> () (ScoreTime -> ()) -> NFData ScoreTime forall a. (a -> ()) -> NFData a rnf :: ScoreTime -> () $crnf :: ScoreTime -> () DeepSeq.NFData, Integer -> ScoreTime ScoreTime -> ScoreTime ScoreTime -> ScoreTime -> ScoreTime (ScoreTime -> ScoreTime -> ScoreTime) -> (ScoreTime -> ScoreTime -> ScoreTime) -> (ScoreTime -> ScoreTime -> ScoreTime) -> (ScoreTime -> ScoreTime) -> (ScoreTime -> ScoreTime) -> (ScoreTime -> ScoreTime) -> (Integer -> ScoreTime) -> Num 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 Num ScoreTime -> (ScoreTime -> ScoreTime -> ScoreTime) -> (ScoreTime -> ScoreTime) -> (Rational -> ScoreTime) -> Fractional 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 Num ScoreTime -> Ord ScoreTime -> (ScoreTime -> Rational) -> Real ScoreTime ScoreTime -> Rational forall a. Num a -> Ord a -> (a -> Rational) -> Real a toRational :: ScoreTime -> Rational $ctoRational :: ScoreTime -> Rational Real, Fractional ScoreTime Real ScoreTime Real ScoreTime -> Fractional ScoreTime -> (forall b. Integral b => ScoreTime -> (b, ScoreTime)) -> (forall b. Integral b => ScoreTime -> b) -> (forall b. Integral b => ScoreTime -> b) -> (forall b. Integral b => ScoreTime -> b) -> (forall b. Integral b => ScoreTime -> b) -> RealFrac 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 (ScoreTime -> ScoreTime -> Bool) -> (ScoreTime -> ScoreTime -> Bool) -> Eq ScoreTime 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 Eq ScoreTime -> (ScoreTime -> ScoreTime -> Ordering) -> (ScoreTime -> ScoreTime -> Bool) -> (ScoreTime -> ScoreTime -> Bool) -> (ScoreTime -> ScoreTime -> Bool) -> (ScoreTime -> ScoreTime -> Bool) -> (ScoreTime -> ScoreTime -> ScoreTime) -> (ScoreTime -> ScoreTime -> ScoreTime) -> Ord 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 Putter ScoreTime -> Get ScoreTime -> Serialize 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 (Double -> ScoreTime -> ScoreTime -> Bool) -> ApproxEq ScoreTime forall a. (Double -> a -> a -> Bool) -> ApproxEq a eq :: Double -> ScoreTime -> ScoreTime -> Bool $ceq :: Double -> ScoreTime -> ScoreTime -> Bool ApproxEq.ApproxEq, Int -> ScoreTime -> Int (Int -> ScoreTime -> Int) -> Seed ScoreTime 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) (Text -> Text) -> (ScoreTime -> Text) -> ScoreTime -> 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) -> (ScoreTime -> Double) -> ScoreTime -> Text 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 | Double -> Bool forall a. RealFloat a => a -> Bool isNegativeZero (ScoreTime -> Double to_double ScoreTime t) = ScoreTime t | Bool otherwise = Double -> ScoreTime from_double (Double -> ScoreTime) -> (ScoreTime -> Double) -> ScoreTime -> ScoreTime forall b c a. (b -> c) -> (a -> b) -> a -> c . (Double -> Double -> Double forall a. Fractional a => a -> a -> a /Double divisor) (Double -> Double) -> (ScoreTime -> Double) -> ScoreTime -> Double forall b c a. (b -> c) -> (a -> b) -> a -> c . Integer -> Double forall a b. (Integral a, Num b) => a -> b fromIntegral (Integer -> Double) -> (ScoreTime -> Integer) -> ScoreTime -> Double forall b c a. (b -> c) -> (a -> b) -> a -> c . ScoreTime -> Integer to_int (ScoreTime -> ScoreTime) -> ScoreTime -> ScoreTime forall a b. (a -> b) -> a -> b $ ScoreTime t where to_int :: ScoreTime -> Integer to_int :: ScoreTime -> Integer to_int = Double -> Integer forall a b. (RealFrac a, Integral b) => a -> b Prelude.round (Double -> Integer) -> (ScoreTime -> Double) -> ScoreTime -> Integer forall b c a. (b -> c) -> (a -> b) -> a -> c . (Double -> Double -> Double forall a. Num a => a -> a -> a *Double divisor) (Double -> Double) -> (ScoreTime -> Double) -> ScoreTime -> Double forall b c a. (b -> c) -> (a -> b) -> a -> c . ScoreTime -> Double to_double divisor :: Double divisor :: Double divisor = Double 2Double -> Integer -> Double forall a b. (Num a, Integral b) => a -> b -> a ^Integer 7 Double -> Double -> Double forall a. Num a => a -> a -> a * Double 3Double -> Integer -> Double forall a b. (Num a, Integral b) => a -> b -> a ^Integer 3 Double -> Double -> Double forall a. Num a => a -> a -> a * Double 5Double -> Integer -> Double forall a b. (Num a, Integral b) => a -> b -> a ^Integer 2 Double -> Double -> Double 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 _ = CDouble -> Int forall a. CStorable a => a -> Int C.sizeOf (CDouble 0 :: C.CDouble) alignment :: ScoreTime -> Int alignment ScoreTime _ = CDouble -> Int forall a. CStorable a => a -> Int C.alignment (CDouble 0 :: C.CDouble) poke :: Ptr ScoreTime -> ScoreTime -> IO () poke Ptr ScoreTime p (ScoreTime Double d) = Ptr CDouble -> CDouble -> IO () forall a. CStorable a => Ptr a -> a -> IO () C.poke (Ptr ScoreTime -> Ptr CDouble 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 (Double -> ScoreTime) -> (CDouble -> Double) -> CDouble -> ScoreTime forall b c a. (b -> c) -> (a -> b) -> a -> c . CDouble -> Double FFI.hs_double (CDouble -> ScoreTime) -> IO CDouble -> IO ScoreTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Ptr CDouble -> IO CDouble forall a. CStorable a => Ptr a -> IO a C.peek (Ptr ScoreTime -> Ptr CDouble forall a b. Ptr a -> Ptr b C.castPtr Ptr ScoreTime p) instance Show ScoreTime where show :: ScoreTime -> String show (ScoreTime Double n) = Double -> String forall a. Show a => a -> String show Double n instance Read.Read ScoreTime where readPrec :: ReadPrec ScoreTime readPrec = Double -> ScoreTime ScoreTime (Double -> ScoreTime) -> ReadPrec Double -> ReadPrec ScoreTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ReadPrec Double forall a. Read a => ReadPrec a Read.readPrec instance Pretty ScoreTime where pretty :: ScoreTime -> Text pretty (ScoreTime Double p) = Bool -> Int -> Double -> Text forall a. RealFloat a => Bool -> Int -> a -> Text Num.showFloatP Bool False Int 3 Double p Text -> Text -> Text 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 (Double -> CDouble) -> (ScoreTime -> Double) -> ScoreTime -> 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 (==) = Double -> 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 ScoreTime -> ScoreTime -> ScoreTime forall a. Num a => a -> a -> a - ScoreTime eta ScoreTime -> ScoreTime -> Bool 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 Double -> Double -> Bool forall a. Ord a => a -> a -> Bool < Double 0 Bool -> Bool -> Bool || Double -> Bool forall a. RealFloat a => a -> Bool isNegativeZero Double t