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