{-# OPTIONS_GHC -threaded #-}
{-# LANGUAGE CPP, FlexibleInstances #-}
module DobutokO.Sound.Effects.Timespec where
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import GHC.Base (mconcat)
#endif
#endif
import Numeric (showFFloat)
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif
data Position = P | M | E deriving Eq
instance Show Position where
show P = "+"
show M = "-"
show E = "="
data TSpec a b c = Ts a c | Tm a b c | Th a b b c | S a b deriving Eq
instance Show (TSpec Position Int Float) where
show (Ts x y) = mconcat [show x,showFFloat Nothing (abs y) "t"]
show (Tm x y z) = mconcat [show x,show (abs y),":",showFFloat Nothing (abs z) "t"]
show (Th x y1 y2 z) = mconcat [show x,show (abs y1),":",show (abs y2),":",showFFloat Nothing (abs z) "t"]
show (S x y) = mconcat [show x,show (abs y),"s"]
type FirstTSpec = TSpec Position Int Float
isTime :: TSpec a b c -> Bool
isTime (S _ _) = False
isTime _ = True
isSamples :: TSpec a b c -> Bool
isSamples (S _ _) = True
isSamples _ = False
tSpecC :: FirstTSpec -> String
tSpecC (Ts _ _) = "Ts"
tSpecC (Tm _ _ _) = "Tm"
tSpecC (Th _ _ _ _) = "Th"
tSpecC (S _ _) = "S"
tSpecPos :: FirstTSpec -> Position
tSpecPos (Ts x _) = x
tSpecPos (Tm x _ _) = x
tSpecPos (Th x _ _ _) = x
tSpecPos (S x _) = x
seconds :: FirstTSpec -> Maybe Float
seconds (Ts _ x) = Just (abs x)
seconds (Tm _ x y) = Just (abs y + fromIntegral (60 * abs x))
seconds (Th _ x y z) = Just (abs z + fromIntegral (3600 * abs x + 60 * abs y))
seconds _ = Nothing
minutes :: FirstTSpec -> Maybe Int
minutes (Ts _ x) = Just (truncate $ abs x / 60.0)
minutes (Tm _ x y) = Just (abs x + truncate (abs y / 60.0))
minutes (Th _ x y z) = Just (abs y + truncate (abs z / 60.0) + 60 * abs x)
minutes _ = Nothing
hours :: FirstTSpec -> Maybe Int
hours (Ts _ x) = Just (truncate $ abs x / 3600.0)
hours (Tm _ x y) = Just (truncate (fromIntegral (abs x) / 60.0 + abs y / 3600.0))
hours (Th _ x y z) = Just (abs x + truncate (abs z / 3600.0 + fromIntegral (abs y) / 60.0))
hours _ = Nothing
samples :: FirstTSpec -> Maybe Int
samples (S _ x) = Just x
samples _ = Nothing
seconds2FstTSpec :: Position -> Float -> FirstTSpec
seconds2FstTSpec x y = Ts x y
samples2FstTSpec :: Position -> Int -> FirstTSpec
samples2FstTSpec x y = S x (abs y)
data Position2 = P2 | M2 deriving Eq
instance Show Position2 where
show P2 = "+"
show M2 = "-"
instance Show (TSpec Position2 Int Float) where
show (Ts u x) = mconcat [show u,showFFloat Nothing (abs x) "t"]
show (Tm u x y) = mconcat [show u,show (abs x),":",showFFloat Nothing (abs y) "t"]
show (Th u x0 x y) = mconcat [show u,show (abs x0),":",show (abs x),":",showFFloat Nothing (abs y) "t"]
show (S u x) = mconcat [show u,show (abs x),"s"]
type NextTSpec = TSpec Position2 Int Float
tSpecC2 :: NextTSpec -> String
tSpecC2 (Ts _ _) = "Ts"
tSpecC2 (Tm _ _ _) = "Tm"
tSpecC2 (Th _ _ _ _) = "Th"
tSpecC2 (S _ _) = "S"
tSpecPos2 :: NextTSpec -> Position2
tSpecPos2 (Ts x _) = x
tSpecPos2 (Tm x _ _) = x
tSpecPos2 (Th x _ _ _) = x
tSpecPos2 (S x _) = x
seconds2 :: NextTSpec -> Maybe Float
seconds2 (Ts _ x) = Just (abs x)
seconds2 (Tm _ x y) = Just (abs y + fromIntegral (60 * abs x))
seconds2 (Th _ x y z) = Just (abs z + fromIntegral (3600 * abs x + 60 * abs y))
seconds2 _ = Nothing
minutes2 :: NextTSpec -> Maybe Int
minutes2 (Ts _ x) = Just (truncate $ abs x / 60.0)
minutes2 (Tm _ x y) = Just (abs x + truncate (abs y / 60.0))
minutes2 (Th _ x y z) = Just (abs y + truncate (abs z / 60.0) + 60 * abs x)
minutes2 _ = Nothing
hours2 :: NextTSpec -> Maybe Int
hours2 (Ts _ x) = Just (truncate $ abs x / 3600.0)
hours2 (Tm _ x y) = Just (truncate (fromIntegral (abs x) / 60.0 + abs y / 3600.0))
hours2 (Th _ x y z) = Just (abs x + truncate (abs z / 3600.0 + fromIntegral (abs y) / 60.0))
hours2 _ = Nothing
samples2 :: NextTSpec -> Maybe Int
samples2 (S _ x) = Just x
samples2 _ = Nothing
seconds2NextTSpec :: Position2 -> Float -> NextTSpec
seconds2NextTSpec x y = Ts x y
samples2NextTSpec :: Position2 -> Int -> NextTSpec
samples2NextTSpec x y = S x (abs y)
data TimeSpec a b = TS1 a | TS2 a [b] deriving Eq
isFirstTS :: TimeSpec a b -> Bool
isFirstTS (TS1 _) = True
isFirstTS _ = False
isExtTS :: TimeSpec a b -> Bool
isExtTS (TS2 _ _) = True
isExtTS _ = False
timeSpecC :: TimeSpec a b -> String
timeSpecC (TS1 _) = "TS1"
timeSpecC (TS2 _ _) = "TS2"
timeSpec1 :: TimeSpec a b -> a
timeSpec1 (TS1 x) = x
timeSpec1 (TS2 x _) = x
timeSpec2 :: TimeSpec a b -> Maybe [b]
timeSpec2 (TS2 _ ys) = Just ys
timeSpec2 _ = Nothing
timeSpecSet1 :: a -> TimeSpec a b -> TimeSpec a b
timeSpecSet1 x (TS1 _) = TS1 x
timeSpecSet1 x (TS2 _ ys) = TS2 x ys
timeSpecSet2 :: [b] -> TimeSpec a b -> TimeSpec a b
timeSpecSet2 xs (TS1 y) = TS2 y xs
timeSpecSet2 xs (TS2 y _) = TS2 y xs
instance Show (TimeSpec FirstTSpec NextTSpec) where
show (TS1 x) = show x
show (TS2 x ys) = mconcat [show x,mconcat . map show $ ys]
type TSpecification = TimeSpec FirstTSpec NextTSpec