{-# OPTIONS_GHC -threaded #-}
{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses #-}
module DobutokO.Sound.Effects.Silence 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)
import DobutokO.Sound.ToRange
import DobutokO.Sound.Effects.Timespec (TimeSpec(..),NextTSpec)
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif
data LeftIntact = L | Nl deriving Eq
instance Show LeftIntact where
show L = "-l "
show _ = ""
data Threshold a = T1 a | D1 a | P1 a deriving Eq
instance Show (Threshold Float) where
show (T1 x) = mconcat [show (truncate . abs $ x), " "]
show (P1 x) = showFFloat Nothing (toRange 100.0 . abs $ x) "% "
show (D1 x) = showFFloat Nothing (if x == 0.0 then -0.01 else -abs x) "d "
type Threshold1 = Threshold Float
thresholdC :: Threshold a -> String
thresholdC (T1 _) = "T1"
thresholdC (D1 _) = "D1"
thresholdC _ = "P1"
threshold1 :: Threshold a -> a
threshold1 (T1 x) = x
threshold1 (D1 x) = x
threshold1 (P1 x) = x
thresholdSet1 :: a -> Threshold a -> Threshold a
thresholdSet1 x (T1 _) = T1 x
thresholdSet1 x (D1 _) = D1 x
thresholdSet1 x (P1 _) = P1 x
data Duration a b = B a | T2 b | M a b deriving Eq
instance Show (Duration Int Float) where
show (B n) = mconcat [show (abs n), " "]
show (T2 x) = showFFloat Nothing (abs x) "t "
show (M n x) = mconcat [show (abs n), ":", showFFloat Nothing (abs x) " "]
type Duration2 = Duration Int Float
durationC :: Duration a b -> String
durationC (B _) = "B"
durationC (T2 _) = "T2"
durationC _ = "M"
duration1 :: Duration a b -> Maybe a
duration1 (B x) = Just x
duration1 (M x _) = Just x
duration1 _ = Nothing
duration2 :: Duration a b -> Maybe b
duration2 (T2 y) = Just y
duration2 (M _ y) = Just y
duration2 _ = Nothing
durationSet :: a -> b -> Int -> Duration a b
durationSet x y n
| n == 1 = B x
| n == 2 = T2 y
| otherwise = M x y
durationSet1d :: a -> Duration a b -> Duration a b
durationSet1d x (B _) = B x
durationSet1d x (T2 y) = M x y
durationSet1d x (M _ y) = M x y
durationSet2d :: b -> Duration a b -> Duration a b
durationSet2d y (B x) = M x y
durationSet2d y (T2 _) = T2 y
durationSet2d y (M x _) = M x y
data STSpec a b = STs b | STm a b | STh a a b | SS a deriving Eq
instance Show (STSpec Int Float) where
show (STs y) = showFFloat Nothing (abs y) "t"
show (STm y z) = mconcat [show (abs y),":",showFFloat Nothing (abs z) "t"]
show (STh y1 y2 z) = mconcat [show (abs y1),":",show (abs y2),":",showFFloat Nothing (abs z) "t"]
show (SS y) = mconcat [show (abs y),"s"]
type Above1TSpec = STSpec Int Float
instance Show (TimeSpec Above1TSpec NextTSpec) where
show (TS1 x) = mconcat [show x, " "]
show (TS2 x ys) = mconcat [show x,mconcat . map show $ ys, " "]
type STSpecification1 = TimeSpec Above1TSpec NextTSpec
data STSpec2 a b = STs2 b | STm2 a b | STh2 a a b | SS2 a deriving Eq
instance Show (STSpec2 Int Float) where
show (STs2 y) = showFFloat Nothing y "t"
show (STm2 y z) = mconcat [show y,":",showFFloat Nothing (abs z) "t"]
show (STh2 y1 y2 z) = mconcat [show y1,":",show (abs y2),":",showFFloat Nothing (abs z) "t"]
show (SS2 y) = mconcat [show y,"s"]
type BelowTSpec = STSpec2 Int Float
instance Show (TimeSpec BelowTSpec NextTSpec) where
show (TS1 x) = mconcat [show x, " "]
show (TS2 x ys) = mconcat [show x,mconcat . map show $ ys, " "]
type STSpecification2 = TimeSpec BelowTSpec NextTSpec
data AboveTSpec1 a b c = Z | A a b c deriving Eq
instance Show (AboveTSpec1 STSpecification1 Duration2 Threshold1) where
show (A x y z) = mconcat [show x, show y, show z]
show _ = "0 "
type ATSpec = AboveTSpec1 STSpecification1 Duration2 Threshold1
aboveTSpec1 :: AboveTSpec1 a b c -> Maybe a
aboveTSpec1 (A x _ _) = Just x
aboveTSpec1 _ = Nothing
aboveTSpec2 :: AboveTSpec1 a b c -> Maybe b
aboveTSpec2 (A _ y _) = Just y
aboveTSpec2 _ = Nothing
aboveTSpec3 :: AboveTSpec1 a b c -> Maybe c
aboveTSpec3 (A _ _ z) = Just z
aboveTSpec3 _ = Nothing
aboveTSpecSet1 :: a -> b -> c -> AboveTSpec1 a b c
aboveTSpecSet1 = A
aboveTSpecSet1a :: a -> AboveTSpec1 a b c -> AboveTSpec1 a b c
aboveTSpecSet1a x (A _ y z) = A x y z
aboveTSpecSet1a _ _ = Z
aboveTSpecSet2a :: b -> AboveTSpec1 a b c -> AboveTSpec1 a b c
aboveTSpecSet2a y (A x _ z) = A x y z
aboveTSpecSet2a _ _ = Z
aboveTSpecSet3a :: c -> AboveTSpec1 a b c -> AboveTSpec1 a b c
aboveTSpecSet3a z (A x y _) = A x y z
aboveTSpecSet3a _ _ = Z
data BelowTSpec1 a b c = Z2 | BL a b c deriving Eq
instance Show (BelowTSpec1 STSpecification2 Duration2 Threshold1) where
show (BL x y z) = mconcat [show x, show y, show z]
show _ = ""
type BTSpec = BelowTSpec1 STSpecification2 Duration2 Threshold1
belowTSpec1 :: BelowTSpec1 a b c -> Maybe a
belowTSpec1 (BL x _ _) = Just x
belowTSpec1 _ = Nothing
belowTSpec2 :: BelowTSpec1 a b c -> Maybe b
belowTSpec2 (BL _ y _) = Just y
belowTSpec2 _ = Nothing
belowTSpec3 :: BelowTSpec1 a b c -> Maybe c
belowTSpec3 (BL _ _ z) = Just z
belowTSpec3 _ = Nothing
belowTSpecSet1 :: a -> b -> c -> BelowTSpec1 a b c
belowTSpecSet1 = BL
belowTSpecSet1b :: a -> BelowTSpec1 a b c -> BelowTSpec1 a b c
belowTSpecSet1b x (BL _ y z) = BL x y z
belowTSpecSet1b _ _ = Z2
belowTSpecSet2b :: b -> BelowTSpec1 a b c -> BelowTSpec1 a b c
belowTSpecSet2b y (BL x _ z) = BL x y z
belowTSpecSet2b _ _ = Z2
belowTSpecSet3b :: c -> BelowTSpec1 a b c -> BelowTSpec1 a b c
belowTSpecSet3b z (BL x y _) = BL x y z
belowTSpecSet3b _ _ = Z2
data Silence a b c = SL2 a b | SL3 a b c deriving Eq
instance Show (Silence LeftIntact ATSpec BTSpec) where
show (SL2 x y) = mconcat ["silence ", show x, show y]
show (SL3 x y z) = mconcat ["silence ", show x, show y, show z]
type Silence3 = Silence LeftIntact ATSpec BTSpec
silenceC :: Silence a b c -> String
silenceC (SL2 _ _) = "SL2"
silenceC (SL3 _ _ _) = "SL3"
silence1 :: Silence a b c -> a
silence1 (SL2 x _) = x
silence1 (SL3 x _ _) = x
silence2 :: Silence a b c -> b
silence2 (SL2 _ y) = y
silence2 (SL3 _ y _) = y
silence3 :: Silence a b c -> Maybe c
silence3 (SL3 _ _ z) = Just z
silence3 _ = Nothing
silenceSet1 :: a -> Silence a b c -> Silence a b c
silenceSet1 x (SL2 _ y) = SL2 x y
silenceSet1 x (SL3 _ y z) = SL3 x y z
silenceSet2 :: b -> Silence a b c -> Silence a b c
silenceSet2 y (SL2 x _) = SL2 x y
silenceSet2 y (SL3 x _ z) = SL3 x y z
silenceSet3 :: c -> Silence a b c -> Silence a b c
silenceSet3 z (SL2 x y) = SL3 x y z
silenceSet3 z (SL3 x y _) = SL3 x y z
showSLQ :: Silence3 -> [String]
showSLQ = words . show