module Reactive.Banana.ALSA.Time where
import qualified Sound.ALSA.Sequencer.Event as Event
import qualified Sound.ALSA.Sequencer.RealTime as RealTime
import qualified Sound.ALSA.Sequencer.Time as ATime
import qualified Numeric.NonNegative.Class as NonNeg
import qualified Data.Monoid as Mn
import Data.Ratio ((%), )
import Prelude hiding (div, )
type Abs = Rational
newtype T = Cons {decons :: Rational}
deriving (Show, Eq, Ord)
cons :: String -> Rational -> T
cons msg x =
if x>=0
then Cons x
else error $ msg ++ ": negative number"
inc :: T -> Abs -> Abs
inc dt t = t + decons dt
subSat :: Abs -> Abs -> T
subSat t1 t0 = cons "Time.sub" $ max 0 $ t1 t0
scale :: Double -> T -> T
scale k (Cons t) =
cons "Time.scale" $ round (toRational k * t * nano) % nano
scaleCeiling :: Double -> T -> T
scaleCeiling k (Cons t) =
cons "Time.scaleCeiling" $ ceiling (toRational k * t * nano) % nano
scaleInt :: Integral i => i -> T -> T
scaleInt k (Cons t) =
cons "Time.scaleInt" $ t * fromIntegral k
div :: T -> T -> Double
div dt1 dt0 =
fromRational (decons dt1 / decons dt0)
nano :: Num a => a
nano = 1000^(3::Int)
instance Mn.Monoid T where
mempty = Cons 0
mappend (Cons x) (Cons y) = Cons (x+y)
instance NonNeg.C T where
split = NonNeg.splitDefault decons Cons
fromStamp :: ATime.Stamp -> Abs
fromStamp t =
case t of
ATime.Real rt ->
RealTime.toInteger rt % nano
_ -> error "unsupported time stamp type"
toStamp :: Abs -> ATime.Stamp
toStamp t =
ATime.Real (RealTime.fromInteger (round (t*nano)))
fromEvent :: Event.T -> Abs
fromEvent ev =
case Event.time ev of
ATime.Cons ATime.Absolute stamp -> fromStamp stamp
_ -> error "timeFromEvent: we can only handle absolute time stamps"