{-# OPTIONS_GHC -threaded #-}
{-# LANGUAGE CPP, FlexibleInstances #-}
module DobutokO.Sound.Effects.MCompand 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 Data.List (intersperse)
import DobutokO.Sound.One
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif
data FloatE a = InfP | InfM | Float1 a deriving Eq
instance Show (FloatE Float) where
show InfP = "inf "
show InfM = "-inf "
show (Float1 x) = showFFloat Nothing x " "
type Float3 = FloatE Float
floatE1 :: FloatE a -> Maybe a
floatE1 (Float1 x) = Just x
floatE1 _ = Nothing
floatESet1 :: a -> FloatE a
floatESet1 = Float1
isInfS :: FloatE a -> Bool
isInfS (Float1 _) = False
isInfS _ = True
isInfP :: FloatE a -> Bool
isInfP InfP = True
isInfP _ = False
isInfM :: FloatE a -> Bool
isInfM InfM = True
isInfM _ = False
isFloatE1 :: FloatE a -> Bool
isFloatE1 (Float1 _) = True
isFloatE1 _ = False
absEP :: Float3 -> Float3
absEP (Float1 x) = Float1 (abs x)
absEP _ = InfP
absEN :: Float3 -> Float3
absEN (Float1 x) = Float1 (-abs x)
absEN _ = InfM
data CompandTail a b = N | CT1 a | CT2 a a | CT3 a a b deriving Eq
instance Show (CompandTail Float3 Float) where
show N = " "
show (CT1 x) = mconcat [show x, " "]
show (CT2 x y) = mconcat [show x, " ", show (absEN y), " "]
show (CT3 x y z) = mconcat [show x, " ", show (absEN y), " ", showFFloat Nothing (abs z) " "]
type CompTail = CompandTail Float3 Float
compandTail1 :: CompandTail a b -> Maybe (One2 a)
compandTail1 (CT1 x) = Just (O21 x)
compandTail1 (CT2 x y) = Just (O22 x y)
compandTail1 (CT3 x y _) = Just (O22 x y)
compandTail1 _ = Nothing
compandTail2 :: CompandTail a b -> Maybe b
compandTail2 (CT3 _ _ y) = Just y
compandTail2 _ = Nothing
compandTailSet1 :: One2 a -> CompandTail a b -> CompandTail a b
compandTailSet1 (O21 x) (CT2 _ y) = CT2 x y
compandTailSet1 (O21 x) (CT3 _ y z) = CT3 x y z
compandTailSet1 (O22 x y) (CT2 _ _) = CT2 x y
compandTailSet1 (O22 x y) (CT3 _ _ z) = CT3 x y z
compandTailSet1 (O21 x) _ = CT1 x
compandTailSet1 (O22 x y) _ = CT2 x y
compandTailSet2 :: b -> CompandTail a b -> Maybe (CompandTail a b)
compandTailSet2 z (CT2 x y) = Just (CT3 x y z)
compandTailSet2 z (CT3 x y _) = Just (CT3 x y z)
compandTailSet2 _ _ = Nothing
showCTQ :: CompTail -> [String]
showCTQ = words . show
data Pair a = AD a a deriving Eq
instance Show (Pair Float) where
show (AD x y) = mconcat [showFFloat Nothing (abs x) ",",showFFloat Nothing (abs y) ""]
type Pr = Pair Float
pair1 :: Pair a -> a
pair1 (AD x _) = x
pair2 :: Pair a -> a
pair2 (AD _ y) = y
pairSet1 :: a -> Pair a -> Pair a
pairSet1 x (AD _ y) = AD x y
pairSet2 :: a -> Pair a -> Pair a
pairSet2 y (AD x _) = AD x y
data AtDe a = ADM a [a] deriving Eq
instance Show (AtDe Pr) where
show (ADM (AD x y) zs)
| null zs = mconcat [show (AD x y), " "]
| otherwise = mconcat [show (AD x y), ",", mconcat . intersperse "," . map show $ zs, " "]
type AtD2 = AtDe Pr
atDe1 :: AtDe a -> a
atDe1 (ADM x _) = x
atDe2 :: AtDe a -> [a]
atDe2 (ADM _ xs) = xs
atDeSet1 :: a -> AtDe a -> AtDe a
atDeSet1 x (ADM _ xs) = ADM x xs
atDeSet2 :: [a] -> AtDe a -> AtDe a
atDeSet2 xs (ADM x _) = ADM x xs
showADQ :: AtD2 -> [String]
showADQ = words . show
data Neg a = NG a deriving Eq
instance Show (Neg Float) where
show (NG x) = showFFloat Nothing (-abs x) " "
type Ng1 = Neg Float
neg1 :: Neg a -> a
neg1 (NG x) = x
negSet1 :: a -> Neg a
negSet1 = NG
type AtDeNF = AtDe (Neg Float)
instance Show AtDeNF where
show (ADM (NG x) zs)
| null zs = mconcat [show (NG x), " "]
| otherwise = mconcat [show (NG x), ",", mconcat . intersperse "," . map show $ zs, " "]
data SoftKnee a = NK | SK a deriving Eq
instance Show (SoftKnee Float) where
show (SK x) = showFFloat Nothing x ":"
show _ = ""
type SoftK1 = SoftKnee Float
softKneeC :: SoftKnee a -> String
softKneeC NK = "NK"
softKneeC _ = "SK"
softKnee1 :: SoftKnee a -> Maybe a
softKnee1 (SK x) = Just x
softKnee1 _ = Nothing
softKneeSet1 :: a -> SoftKnee a
softKneeSet1 = SK
data Compand a b c d = CP3 a b c | CP4 a b c d deriving Eq
instance Show (Compand AtD2 SoftK1 AtDeNF CompTail) where
show (CP3 x y z) = mconcat ["compand ", show x, show y, show z]
show (CP4 x y z t) = mconcat ["compand ", show x, show y, show z, show t]
type Compand4 = Compand AtD2 SoftK1 AtDeNF CompTail
compand1 :: Compand a b c d -> a
compand1 (CP3 x _ _) = x
compand1 (CP4 x _ _ _) = x
compand2 :: Compand a b c d -> b
compand2 (CP3 _ y _) = y
compand2 (CP4 _ y _ _) = y
compand3 :: Compand a b c d -> c
compand3 (CP3 _ _ z) = z
compand3 (CP4 _ _ z _) = z
compand4 :: Compand a b c d -> Maybe d
compand4 (CP4 _ _ _ t) = Just t
compand4 _ = Nothing
compandSet1 :: a -> Compand a b c d -> Compand a b c d
compandSet1 x (CP3 _ y z) = CP3 x y z
compandSet1 x (CP4 _ y z t) = CP4 x y z t
compandSet2 :: b -> Compand a b c d -> Compand a b c d
compandSet2 y (CP3 x _ z) = CP3 x y z
compandSet2 y (CP4 x _ z t) = CP4 x y z t
compandSet3 :: c -> Compand a b c d -> Compand a b c d
compandSet3 z (CP3 x y _) = CP3 x y z
compandSet3 z (CP4 x y _ t) = CP4 x y z t
compandSet4 :: d -> Compand a b c d -> Compand a b c d
compandSet4 t (CP3 x y z) = CP4 x y z t
compandSet4 t (CP4 x y z _) = CP4 x y z t
showCMPDQ :: Compand4 -> [String]
showCMPDQ = words . show
data KFreq a = Fr a | KFr a deriving Eq
instance Show (KFreq Int) where
show (Fr n) = mconcat [show (abs n), " "]
show (KFr n) = mconcat [show (abs n), "k "]
instance Show (KFreq Float) where
show (Fr x) = mconcat [showFFloat Nothing (abs x) " "]
show (KFr x) = mconcat [showFFloat Nothing (abs x) "k "]
type KFQ = KFreq Int
kFreqC :: KFQ -> String
kFreqC (Fr _) = "Fr"
kFreqC _ = "KFr"
kFreq1 :: KFQ -> Int
kFreq1 (Fr n) = n
kFreq1 (KFr n) = fromIntegral 1000 * n
kFreqSet1 :: Int -> KFQ -> KFreq Float
kFreqSet1 n (Fr _) = Fr (fromIntegral n)
kFreqSet1 n _ = KFr (fromIntegral n / 1000.0)
data FreqComp a b = FrCmp a b deriving Eq
instance Show (FreqComp KFQ String) where
show (FrCmp x ys) = mconcat [show x, show ys, " "]
type FrCmpnd2 = FreqComp KFQ String
freqComp1 :: FreqComp a b -> a
freqComp1 (FrCmp x _) = x
freqComp2 :: FreqComp a b -> b
freqComp2 (FrCmp _ y) = y
freqCompSet1 :: a -> FreqComp a b -> FreqComp a b
freqCompSet1 x (FrCmp _ y) = FrCmp x y
freqCompSet2 :: b -> FreqComp a b -> FreqComp a b
freqCompSet2 y (FrCmp x _) = FrCmp x y
showFC :: FrCmpnd2 -> [String]
showFC = words . show
data MCompand a b = MCN1 a | MCNM a [b] deriving Eq
instance Show (MCompand String FrCmpnd2) where
show (MCN1 xs) = mconcat ["mcompand ", show xs, " "]
show (MCNM xs ys) = mconcat ["mcompand ", show xs, " ", mconcat . map show $ ys]
type MComPand2 = MCompand String FrCmpnd2
mCompandC :: MCompand a b -> String
mCompandC (MCN1 _) = "MCN1"
mCompandC (MCNM _ _) = "MCNM"
mCompand1 :: MCompand a b -> a
mCompand1 (MCN1 x) = x
mCompand1 (MCNM x _) = x
mCompand2 :: MCompand a b -> Maybe [b]
mCompand2 (MCNM _ ys) = Just ys
mCompand2 _ = Nothing
mCompandSet1 :: a -> MCompand a b -> MCompand a b
mCompandSet1 x (MCN1 _) = MCN1 x
mCompandSet1 x (MCNM _ ys) = MCNM x ys
mCompandSet2 :: [b] -> MCompand a b -> MCompand a b
mCompandSet2 ys (MCN1 x) = MCNM x ys
mCompandSet2 ys (MCNM x _) = MCNM x ys