{-# OPTIONS_GHC -threaded #-}
{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses #-}
module DobutokO.Sound.Effects.Sinc 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.Specs (Freq1)
import DobutokO.Sound.One
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif
data PhaseR a = P a | M | I | L deriving Eq
instance Show (PhaseR Float) where
show (P x) = mconcat ["-p ", showFFloat Nothing (toRange 100.0 (abs x)) " "]
show M = "-M "
show I = "-I "
show _ = "-L "
type Phase1 = PhaseR Float
phaseRC :: PhaseR a -> String
phaseRC M = "M"
phaseRC I = "I"
phaseRC L = "L"
phaseRC _ = "P"
phaseR1 :: PhaseR a -> Maybe a
phaseR1 (P x) = Just x
phaseR1 _ = Nothing
phaseRSet1 :: a -> PhaseR a
phaseRSet1 = P
data SincAB a = N1 | A a | B a deriving Eq
instance Show (SincAB Float) where
show (A x) = mconcat ["-a ", if compare (toRange 180.0 . abs $ x) 40.0 == LT then "40 " else showFFloat Nothing (toRange 180.0 . abs $ x) " "]
show (B x) = mconcat ["-b ", showFFloat Nothing (toRange 256.0 . abs $ x) " "]
show _ = ""
type Sinc1 = SincAB Float
sincABC :: SincAB a -> String
sincABC (A _) = "A"
sincABC (B _) = "B"
sincABC _ = "N1"
sincAB1 :: SincAB a -> Maybe a
sincAB1 (A x) = Just x
sincAB1 (B x) = Just x
sincAB1 _ = Nothing
sincABSet1 :: Bool -> a -> SincAB a
sincABSet1 True x = A x
sincABSet1 False x = B x
data SincTN a = N2 | T a | N a deriving Eq
instance Show (SincTN Float) where
show (T x) = mconcat ["-t ", if compare (abs x) 1.0 == LT then "1 " else showFFloat Nothing (abs x) " "]
show (N x) = mconcat ["-n ", if compare (toRange 32767.0 . abs $ x) 11.0 == LT then "11 " else showFFloat Nothing (toRange 32767.0 . abs $ x) " "]
show _ = ""
type Sinc2 = SincTN Float
sincTNC :: SincTN a -> String
sincTNC (T _) = "T"
sincTNC (N _) = "N"
sincTNC _ = "N2"
sincTN1 :: SincTN a -> Maybe a
sincTN1 (T x) = Just x
sincTN1 (N x) = Just x
sincTN1 _ = Nothing
sincTNSet1 :: Bool -> a -> SincTN a
sincTNSet1 True x = T x
sincTNSet1 False x = N x
data FreqL a = LF a deriving Eq
instance Show (FreqL Freq1) where
show (LF x) = mconcat ["-", show x]
type FreqFL = FreqL Freq1
freqL1 :: FreqL a -> a
freqL1 (LF x) = x
freqLSet1 :: a -> FreqL a
freqLSet1 = LF
data FreqH a = HF a deriving Eq
instance Show (FreqH Freq1) where
show (HF x) = show x
type FreqFH = FreqH Freq1
freqH1 :: FreqH a -> a
freqH1 (HF x) = x
freqHSet1 :: a -> FreqH a
freqHSet1 = HF
data FrequencyS a b = F11 a | F12 b | F2 a b deriving Eq
instance Show (FrequencyS FreqFH FreqFL) where
show (F11 x) = mconcat [show x, " "]
show (F12 y) = mconcat [show y, " "]
show (F2 x y) = mconcat [show x, show y, " "]
type FrequencyS2 = FrequencyS FreqFH FreqFL
data Sinc a b c d = SC1 a b c d | SC2 a b d c | SC a b c d c deriving Eq
instance Show (Sinc Sinc1 Phase1 Sinc2 FrequencyS2) where
show (SC1 x y z t) = mconcat ["sinc ", show x, show y, show z, show t]
show (SC2 x y t z) = mconcat ["sinc ", show x, show y, show t, show z]
show (SC x y z1 t z2) = mconcat ["sinc ", show x, show y, show z1, show t, show z2]
type Sinc4 = Sinc Sinc1 Phase1 Sinc2 FrequencyS2
sincC :: Sinc a b c d -> String
sincC (SC1 _ _ _ _) = "SC1"
sincC (SC2 _ _ _ _) = "SC2"
sincC (SC _ _ _ _ _) = "SC"
sinc1 :: Sinc a b c d -> a
sinc1 (SC1 x _ _ _) = x
sinc1 (SC2 x _ _ _) = x
sinc1 (SC x _ _ _ _) = x
sinc2 :: Sinc a b c d -> b
sinc2 (SC1 _ y _ _) = y
sinc2 (SC2 _ y _ _) = y
sinc2 (SC _ y _ _ _) = y
sinc3 :: Sinc a b c d -> One2 c
sinc3 (SC1 _ _ z _) = O21 z
sinc3 (SC2 _ _ _ z) = O21 z
sinc3 (SC _ _ z1 _ z2) = O22 z1 z2
sinc4 :: Sinc a b c d -> d
sinc4 (SC1 _ _ _ t) = t
sinc4 (SC2 _ _ t _) = t
sinc4 (SC _ _ _ t _) = t
sincSet1 :: a -> Sinc a b c d -> Sinc a b c d
sincSet1 x (SC1 _ y z t) = SC1 x y z t
sincSet1 x (SC2 _ y t z) = SC2 x y t z
sincSet1 x (SC _ y z1 t z2) = SC x y z1 t z2
sincSet2 :: b -> Sinc a b c d -> Sinc a b c d
sincSet2 y (SC1 x _ z t) = SC1 x y z t
sincSet2 y (SC2 x _ z t) = SC2 x y z t
sincSet2 y (SC x _ z1 t z2) = SC x y z1 t z2
sincSet3 :: One2 c -> Sinc a b c d -> Sinc a b c d
sincSet3 (O21 z) (SC1 x y _ t) = SC1 x y z t
sincSet3 (O22 z1 z2) (SC1 x y _ t) = SC x y z1 t z2
sincSet3 (O21 z) (SC2 x y t _) = SC2 x y t z
sincSet3 (O22 z1 z2) (SC2 x y t _) = SC x y z1 t z2
sincSet3 (O21 z) (SC x y _ t z2) = SC x y z t z2
sincSet3 (O22 z1 z2) (SC x y _ t _) = SC x y z1 t z2
sincSet4 :: d -> Sinc a b c d -> Sinc a b c d
sincSet4 t (SC1 x y z _) = SC1 x y z t
sincSet4 t (SC2 x y _ z) = SC2 x y t z
sincSet4 t (SC x y z1 _ z2) = SC x y z1 t z2
showSCQ :: Sinc4 -> [String]
showSCQ = words . show