diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 index 0000000..067e649 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,81 @@ +# Revision history for dobutokO-effects + +## 0.1.0.0 -- 2020-06-27 + +* First version. Released on an unsuspecting world. + +## 0.2.0.0 -- 2020-06-29 + +* Second version. Added a new module DobutokO.Sound.Effects.Remix to deal with the SoX "remix" effect. + +## 0.3.0.0 -- 2020-06-30 + +* Third version. Added new modules DobutokO.Sound.Effects.Timespec and DobutokO.Sound.Effects.Delay. Some minor documentation improvements. + +## 0.3.1.0 -- 2020-06-30 + +* Third version revised A. Fixed issue for GHC 7.8* series with ambiguous mconcat usage. + +## 0.4.0.0 -- 2020-07-02 + +* Fourth version. Added new modules DobutokO.Sound.Effects.Specs, DobutokO.Sound.Effects.PassReject, DobutokO.Sound.Effects.BassTreble. + +## 0.5.0.0 -- 2020-07-04 + +* Fifth version. Added new modules DobutokO.Sound.Effects.Trim, DobutokO.Sound.Effects.Repeat, DobutokO.Sound.Effects.Phaser, +DobutokO.Sound.Effects.Chorus, DobutokO.Sound.Effects.Modulation2, DobutokO.Sound.Effects.Echo, DobutokO.Sound.Effects.Misc, +DobutokO.Sound.Effects.Channels, DobutokO.Sound.Effects.Bend,Segment, DobutokO.Sound.Effects.Pitch, DobutokO.Sound.Effects.Tempo, +DobutokO.Sound.Effects.Speed. + +## 0.6.0.0 -- 2020-07-06 + +* Sixth version. Added new modules DobutokO.Sound.ToRange, DobutokO.Sound.Effects.Biquad, DobutokO.Sound.Effects.Contrast, +DobutokO.Sound.Effects.DCShift, DobutokO.Sound.Effects.Downsample, DobutokO.Sound.Effects.Upsample, DobutokO.Sound.Effects.Hilbert, +DobutokO.Sound.Effects.Loudness, DobutokO.Sound.Effects.Overdrive, DobutokO.Sound.Effects.Tremolo. + +## 0.7.0.0 -- 2020-07-09 + +* Seventh version. Fixed issue with DobutokO.Sound.Effects.Timespec module with timeSpecC function. Added DobutokO.Sound.One, DobutokO.Sound.Effects.Noise, +DobutokO.Sound.Effects.Pad, DobutokO.Sound.Effects.MCompand modules. Some minor code improvements. + +## 0.7.1.0 -- 2020-07-09 + +* Seventh version revised A. Fixed issue with DobutokO.Sound.Effects.Pad module with double (ambiguous) import of mconcat. + +## 0.8.0.0 -- 2020-07-11 + +* Eighth version. Added new modules DobutokO.Sound.Effects.Dither, DobutokO.Sound.Effects.FIR, DobutokO.Sound.Effects.Flanger, DobutokO.Sound.Effects.Gain, +DobutokO.Sound.Effects.LADSPA, DobutokO.Sound.Effects.Rate, DobutokO.Sound.Effects.Vol. Some minor code improvements. + +## 0.9.0.0 -- 2020-07-13 + +* Ninth version. Fixed issue with being wrongly defined Show instance in the DobutokO.Sound.Effects.Rate module. Added new modules +DobutokO.Sound.Effects.Silence, DobutokO.Sound.Effects.Sinc, DobutokO.Sound.Effects.Stretch. + +## 0.10.0.0 -- 2020-07-15 + +* Tenth version. Fixed issue with being out of range application of the toRange function in the modules: DobutokO.Sound.Effects.Dither, +DobutokO.Sound.Effects.Flanger, DobutokO.Sound.Effects.Rate, DobutokO.Sound.Effects.Reverb, DobutokO.Sound.Effects.Sinc, DobutokO.Sound.Effects.Remix. +Fixed issue with the empty list in the MscS data in the DobutokO.Sound.Effects.Misc module. Added new modules DobutokO.Sound.Effects.Spectrogram, +DobutokO.Sound.Effects.Splice, DobutokO.Sound.Effects.Stat, DobutokO.Sound.Effects.Stats, DobutokO.Sound.Effects.Vad. + +## 0.10.1.0 -- 2020-07-15 + +* Tenth version revised. Fixed issue with being not properly defined usage of mconcat for GHC 7.8* series. + +## 0.11.0.0 -- 2020-07-18 + +* Eleventh version. Added a new module DobutokO.Sound.Effects.Classes with classes for the data types in other modules. Some code improvements. + +## 0.12.0.0 -- 2020-07-21 + +* Twelfth version. Splitted the module DobutokO.Sound.Effects.Classes into four modules DobutokO.Sound.Effects.Classes.FstParam, +DobutokO.Sound.Effects.Classes.SndParam, DobutokO.Sound.Effects.Classes.ThdParam, DobutokO.Sound.Effects.Classes.FourthParam. +Added new modules DobutokO.Sound.Effects.Classes.FstParamSet, DobutokO.Sound.Effects.Classes.SndParamSet, DobutokO.Sound.Effects.Classes.ThdParamSet, +DobutokO.Sound.Effects.Classes.FourthParamSet and DobutokO.Sound.Effects.Classes.ComplexParamSet. Some code changes and improvements to make +it more usable with classes. + +## 0.13.0.0 -- 2020-07-25 + +* Thirteenth version. Added README.markdown file. Extended the Set classes (where appropriate) with setG methods to provide unambiguous usage for the instances. +Added functions for conversion to the list of the One2 data. Some code improvements. diff --git a/DobutokO/Sound/Combine.hs b/DobutokO/Sound/Combine.hs new file mode 100644 index 0000000..5217e62 --- /dev/null +++ b/DobutokO/Sound/Combine.hs @@ -0,0 +1,27 @@ +-- | +-- Module : DobutokO.Sound.Combine +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used to represent SoX combining types. +-- + +{-# OPTIONS_GHC -threaded #-} + +module DobutokO.Sound.Combine where + +data Combine = C | S | MX | MP | MG | ML deriving Eq + +instance Show Combine where + show C = "--combine concatenate" + show S = "--combine sequence" + show MX = "--combine mix" + show MP = "--combine mix-power" + show MG = "--combine merge" + show ML = "--combine multiply" + +showC1 :: Combine -> [String] +showC1 = words . show diff --git a/DobutokO/Sound/Effects/BassTreble.hs b/DobutokO/Sound/Effects/BassTreble.hs new file mode 100644 index 0000000..4e7a81c --- /dev/null +++ b/DobutokO/Sound/Effects/BassTreble.hs @@ -0,0 +1,113 @@ +-- | +-- Module : DobutokO.Sound.Effects.BassTreble +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"bass\" or \"treble\" effects with the needed specifications. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.BassTreble 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.Effects.Specs hiding (Width(..),Width1) +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data WidthS a = H a | K a | O a | Q a | S a deriving Eq + +instance Show (WidthS Float) where + show (H x) = showFFloat Nothing x "h" + show (K x) = showFFloat Nothing x "k" + show (O x) = showFFloat Nothing x "o" + show (Q x) = showFFloat Nothing x "q" + show (S x) = showFFloat Nothing x "s" + +type WidthS1 = WidthS Float + +data FreqWidthS a b = FrS1 a | FrWS2 a b deriving Eq + +instance Show (FreqWidthS Freq1 WidthS1) where + show (FrS1 x) = show x + show (FrWS2 x y) = mconcat [show x," ",show y] + +type FreqWS2 = FreqWidthS Freq1 WidthS1 + +freqWidthSC :: FreqWidthS a b -> String +freqWidthSC (FrS1 _) = "FrS1" +freqWidthSC (FrWS2 _ _) = "FrWS2" + +freqWidthS1 :: FreqWidthS a b -> a +freqWidthS1 (FrS1 x) = x +freqWidthS1 (FrWS2 x _) = x + +freqWidthS2 :: FreqWidthS a b -> Maybe b +freqWidthS2 (FrS1 _) = Nothing +freqWidthS2 (FrWS2 _ y) = Just y + +freqWidthSSet1 :: a -> FreqWidthS a b -> FreqWidthS a b +freqWidthSSet1 x (FrS1 _) = FrS1 x +freqWidthSSet1 x (FrWS2 _ y) = FrWS2 x y + +freqWidthSSet2 :: b -> FreqWidthS a b -> FreqWidthS a b +freqWidthSSet2 y (FrS1 x) = FrWS2 x y +freqWidthSSet2 y (FrWS2 x _) = FrWS2 x y + +data Bass a b = Bs a b deriving Eq + +instance Show (Bass Float FreqWS2) where + show (Bs x y) = mconcat ["bass ",showFFloat Nothing x " ",show y," "] + +type Bass1 = Bass Float FreqWS2 + +bass1 :: Bass a b -> a +bass1 (Bs x _) = x + +bass2 :: Bass a b -> b +bass2 (Bs _ y) = y + +bassSet1 :: a -> Bass a b -> Bass a b +bassSet1 x (Bs _ y) = Bs x y + +bassSet2 :: b -> Bass a b -> Bass a b +bassSet2 y (Bs x _) = Bs x y + +showBsQ :: Bass1 -> [String] +showBsQ = words . show + +data Treble a b = Tr a b deriving Eq + +instance Show (Treble Float FreqWS2) where + show (Tr x y) = mconcat ["treble ",showFFloat Nothing x " ",show y," "] + +type Treble1 = Treble Float FreqWS2 + +treble1 :: Treble a b -> a +treble1 (Tr x _) = x + +treble2 :: Treble a b -> b +treble2 (Tr _ y) = y + +trebleSet1 :: a -> Treble a b -> Treble a b +trebleSet1 x (Tr _ y) = Tr x y + +trebleSet2 :: b -> Treble a b -> Treble a b +trebleSet2 y (Tr x _) = Tr x y + +showTrQ :: Treble1 -> [String] +showTrQ = words . show diff --git a/DobutokO/Sound/Effects/Bend.hs b/DobutokO/Sound/Effects/Bend.hs new file mode 100644 index 0000000..77b8eee --- /dev/null +++ b/DobutokO/Sound/Effects/Bend.hs @@ -0,0 +1,130 @@ +-- | +-- Module : DobutokO.Sound.Effects.Bend +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the \"bend\" SoX effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances #-} + +module DobutokO.Sound.Effects.Bend where + +import Numeric (showFFloat) +import DobutokO.Sound.Effects.Timespec + +data BendTrio a b = Bend3 a b a deriving Eq + +instance Show (BendTrio FirstTSpec Float) where + show (Bend3 x y z) = mconcat [show x, ",", showFFloat Nothing y ",", show z] + +type BendTr3 = BendTrio FirstTSpec Float + +bendTrio1 :: BendTrio a b -> a +bendTrio1 (Bend3 x _ _) = x + +bendTrio2 :: BendTrio a b -> b +bendTrio2 (Bend3 _ y _) = y + +bendTrio3 :: BendTrio a b -> a +bendTrio3 (Bend3 _ _ z) = z + +bendTrioSet1 :: a -> BendTrio a b -> BendTrio a b +bendTrioSet1 x (Bend3 _ y z) = Bend3 x y z + +bendTrioSet2 :: b -> BendTrio a b -> BendTrio a b +bendTrioSet2 y (Bend3 x _ z) = Bend3 x y z + +bendTrioSet3 :: a -> BendTrio a b -> BendTrio a b +bendTrioSet3 z (Bend3 x y _) = Bend3 x y z + +data FrameRate a = FR a deriving Eq + +instance Show (FrameRate Float) where + show (FR x) + | compare x 10.0 /= LT && compare x 80.0 /= GT = "-f " ++ showFFloat Nothing x " " + | otherwise = "" + +type FrRate = FrameRate Float + +frameRate1 :: FrameRate a -> a +frameRate1 (FR x) = x + +frameRateSet1 :: a -> FrameRate a +frameRateSet1 = FR + +data OverSample a = OS a deriving Eq + +instance Show (OverSample Float) where + show (OS x) + | compare x 4.0 /= LT && compare x 32.0 /= GT = "-o " ++ showFFloat Nothing x " " + | otherwise = "" + +type OvSample = OverSample Float + +overSample1 :: OverSample a -> a +overSample1 (OS x) = x + +overSampleSet1 :: a -> OverSample a +overSampleSet1 = OS + +data Bend a b c = Bnd c | Bnd1 a c | Bnd2 b c | Bnd12 a b c deriving Eq + +instance Show (Bend FrRate OvSample BendTr3) where + show (Bnd z) = mconcat ["bend ",show z] + show (Bnd1 x z) = mconcat ["bend ",show x,show z] + show (Bnd2 y z) = mconcat ["bend ",show y,show z] + show (Bnd12 x y z) = mconcat ["bend ", show x, show y, show z] + +type BendE = Bend FrRate OvSample BendTr3 + +bend1 :: Bend a b c -> Maybe a +bend1 (Bnd1 x _) = Just x +bend1 (Bnd12 x _ _) = Just x +bend1 _ = Nothing + +bend2 :: Bend a b c -> Maybe b +bend2 (Bnd2 y _) = Just y +bend2 (Bnd12 _ y _) = Just y +bend2 _ = Nothing + +bendE1 :: BendE -> FrRate +bendE1 (Bnd1 x _) = x +bendE1 (Bnd12 x _ _) = x +bendE1 _ = FR 25.0 + +bendE2 :: BendE -> OvSample +bendE2 (Bnd2 y _) = y +bendE2 (Bnd12 _ y _) = y +bendE2 _ = OS 16.0 + +bend3 :: Bend a b c -> c +bend3 (Bnd z) = z +bend3 (Bnd1 _ z) = z +bend3 (Bnd2 _ z) = z +bend3 (Bnd12 _ _ z) = z + +bendSet1 :: a -> Bend a b c -> Bend a b c +bendSet1 _ (Bnd z) = Bnd z +bendSet1 x (Bnd1 _ z) = Bnd1 x z +bendSet1 x (Bnd2 y z) = Bnd12 x y z +bendSet1 x (Bnd12 _ y z) = Bnd12 x y z + +bendSet2 :: b -> Bend a b c -> Bend a b c +bendSet2 y (Bnd z) = Bnd2 y z +bendSet2 y (Bnd1 x z) = Bnd12 x y z +bendSet2 y (Bnd2 _ z) = Bnd2 y z +bendSet2 y (Bnd12 x _ z) = Bnd12 x y z + +bendSet3 :: c -> Bend a b c -> Bend a b c +bendSet3 z (Bnd _) = Bnd z +bendSet3 z (Bnd1 x _) = Bnd1 x z +bendSet3 z (Bnd2 y _) = Bnd2 y z +bendSet3 z (Bnd12 x y _) = Bnd12 x y z + +showBndQ :: BendE -> [String] +showBndQ = words . show diff --git a/DobutokO/Sound/Effects/Biquad.hs b/DobutokO/Sound/Effects/Biquad.hs new file mode 100644 index 0000000..b494db2 --- /dev/null +++ b/DobutokO/Sound/Effects/Biquad.hs @@ -0,0 +1,78 @@ +-- | +-- Module : DobutokO.Sound.Effects.Biquad +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"biquad\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Biquad 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 Coeffs a = BQ3 a a a deriving Eq + +instance Show (Coeffs Float) where + show (BQ3 x0 x1 x2) = mconcat [showFFloat Nothing x0 " ", showFFloat Nothing x1 " ", showFFloat Nothing x2 " "] + +type BiQuad3 = Coeffs Float + +coeffs1 :: Int -> Coeffs a -> Maybe a +coeffs1 n (BQ3 x0 x1 x2) + | compare n 0 == GT && compare n 4 == LT = + case n of + 1 -> Just x0 + 2 -> Just x1 + _ -> Just x2 + | otherwise = Nothing + +coeffsSet1 :: a -> Coeffs a -> Coeffs a +coeffsSet1 x0 (BQ3 _ x1 x2) = BQ3 x0 x1 x2 + +coeffsSet2 :: a -> Coeffs a -> Coeffs a +coeffsSet2 x1 (BQ3 x0 _ x2) = BQ3 x0 x1 x2 + +coeffsSet3 :: a -> Coeffs a -> Coeffs a +coeffsSet3 x2 (BQ3 x0 x1 _) = BQ3 x0 x1 x2 + +data Biquad a = BQ (Coeffs a) (Coeffs a) deriving Eq + +instance Show (Biquad Float) where + show (BQ x y) = mconcat ["biquad ",show x, show y] + +type BiQuad6 = Biquad Float + +biquad1 :: Biquad a -> Coeffs a +biquad1 (BQ x _) = x + +biquad2 :: Biquad a -> Coeffs a +biquad2 (BQ _ y) = y + +biquadSet1 :: Coeffs a -> Biquad a -> Biquad a +biquadSet1 x (BQ _ y) = BQ x y + +biquadSet2 :: Coeffs a -> Biquad a -> Biquad a +biquadSet2 y (BQ x _) = BQ x y + +showBQ6Q :: BiQuad6 -> [String] +showBQ6Q = words . show diff --git a/DobutokO/Sound/Effects/Channels.hs b/DobutokO/Sound/Effects/Channels.hs new file mode 100644 index 0000000..8fe38ab --- /dev/null +++ b/DobutokO/Sound/Effects/Channels.hs @@ -0,0 +1,33 @@ +-- | +-- Module : DobutokO.Sound.Effects.Channels +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the \"channels\" SoX effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances #-} + +module DobutokO.Sound.Effects.Channels where + +data Chans a = Chans a deriving Eq + +instance Show (Chans Int) where + show (Chans n) + | compare n 0 == GT = "channels " ++ show n + | otherwise = "" + +type ChansI = Chans Int + +channels1 :: Chans a -> a +channels1 (Chans x) = x + +channelsSet1 :: a -> Chans a +channelsSet1 = Chans + +showChnQ :: ChansI -> [String] +showChnQ = words . show diff --git a/DobutokO/Sound/Effects/Chorus.hs b/DobutokO/Sound/Effects/Chorus.hs new file mode 100644 index 0000000..c779968 --- /dev/null +++ b/DobutokO/Sound/Effects/Chorus.hs @@ -0,0 +1,93 @@ +-- | +-- Module : DobutokO.Sound.Effects.Chorus +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"chorus\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Chorus 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.Effects.Modulation2 +import Data.List (intersperse) + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data ChorusTail a b = ChT a a a a b deriving Eq + +instance Show (ChorusTail Float Modulation) where + show (ChT delay decay speed depth mod1) = mconcat [showFFloat Nothing (abs delay) " ", showFFloat Nothing (abs decay) " ", showFFloat Nothing (abs speed) " ", + showFFloat Nothing (abs depth) " ", show mod1] + +type ChorusTail1 = ChorusTail Float Modulation + +data Chorus a b = Ch a a [b] deriving Eq + +instance Show (Chorus Float ChorusTail1) where + show (Ch gin gout ys) + | null ys = "" + | otherwise = mconcat ["chorus ", showFFloat Nothing (abs gin) " ", showFFloat Nothing (abs gout) " ", mconcat . intersperse " " . map show $ ys] + +type Chorus1 = Chorus Float ChorusTail1 + +chorusTail1 :: Int -> ChorusTail a b -> a +chorusTail1 n (ChT x0 x1 x2 x3 _) + | n == 1 = x0 + | n == 2 = x1 + | n == 3 = x2 + | n == 4 = x3 + | otherwise = error "DobutokO.Sound.Effects.Chorus.chorusTail1: Not defined parameter. " + +chorusTail2 :: ChorusTail a b -> b +chorusTail2 (ChT _ _ _ _ y) = y + +chorusTailSet1 :: Int -> a -> ChorusTail a b -> ChorusTail a b +chorusTailSet1 n x (ChT x0 x1 x2 x3 y) + | n == 1 = ChT x x1 x2 x3 y + | n == 2 = ChT x0 x x2 x3 y + | n == 3 = ChT x0 x1 x x3 y + | n == 4 = ChT x0 x1 x2 x y + | otherwise = error "DobutokO.Sound.Effects.Chorus.chorusTailSet1: Not defined parameter. " + +chorusTailSet2 :: b -> ChorusTail a b -> ChorusTail a b +chorusTailSet2 y (ChT x0 x1 x2 x3 _) = ChT x0 x1 x2 x3 y + +chorus1 :: Int -> Chorus a b -> a +chorus1 n (Ch x0 x1 _) + | n == 1 = x0 + | n == 2 = x1 + | otherwise = error "DobutokO.Sound.Effects.Chorus.chorus1: Not defined parameter. " + +chorus2 :: Chorus a b -> [b] +chorus2 (Ch _ _ ys) = ys + +chorusSet1 :: Int -> a -> Chorus a b -> Chorus a b +chorusSet1 n x (Ch x0 x1 y) + | n == 1 = Ch x x1 y + | n == 2 = Ch x0 x y + | otherwise = error "DobutokO.Sound.Effects.Chorus.chorusSet1: Not defined parameter. " + +chorusSet2 :: [b] -> Chorus a b -> Chorus a b +chorusSet2 ys (Ch x0 x1 _) = Ch x0 x1 ys + +showChQ :: Chorus1 -> [String] +showChQ = words . show diff --git a/DobutokO/Sound/Effects/Classes/ComplexParamSet.hs b/DobutokO/Sound/Effects/Classes/ComplexParamSet.hs new file mode 100644 index 0000000..fbd96db --- /dev/null +++ b/DobutokO/Sound/Effects/Classes/ComplexParamSet.hs @@ -0,0 +1,69 @@ +-- | +-- Module : DobutokO.Sound.Effects.Classes.ComplexParamSet +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX effects. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +module DobutokO.Sound.Effects.Classes.ComplexParamSet where + +import DobutokO.Sound.Effects.Segment +import DobutokO.Sound.Effects.Silence +import DobutokO.Sound.Effects.Sinc +import DobutokO.Sound.Effects.Timespec + +class Complex2ParamSet a b c where + set21c :: a -> b -> c + +instance Complex2ParamSet a b (Duration a b) where + set21c x y = durationSet x y 3 + +instance Complex2ParamSet Position Float FirstTSpec where + set21c = seconds2FstTSpec + +instance Complex2ParamSet Position Int FirstTSpec where + set21c = samples2FstTSpec + +instance Complex2ParamSet Position2 Float NextTSpec where + set21c = seconds2NextTSpec + +instance Complex2ParamSet Position2 Int NextTSpec where + set21c = samples2NextTSpec + +class Complex3ParamSet a b c d where + set31c :: a -> b -> c -> d + +instance Complex3ParamSet STSpecification1 Duration2 Threshold1 ATSpec where + set31c = aboveTSpecSet1 + +instance Complex3ParamSet STSpecification2 Duration2 Threshold1 BTSpec where + set31c = belowTSpecSet1 + +class BoolParamSet1 a b where + set1B :: Bool -> a -> b + +instance BoolParamSet1 a (SincAB a) where + set1B = sincABSet1 + +instance BoolParamSet1 a (SincTN a) where + set1B = sincTNSet1 + +class ComplexParamSet2 a b where + set2c :: a -> a -> b -> b + +instance ComplexParamSet2 a (Segment a) where + set2c = segmentSet2 + +class ComplexParamSet3 a b where + set3c :: a -> a -> a -> b + +instance ComplexParamSet3 a (Segment a) where + set3c = segmentSet3 + diff --git a/DobutokO/Sound/Effects/Classes/FourthParam.hs b/DobutokO/Sound/Effects/Classes/FourthParam.hs new file mode 100644 index 0000000..7d74c2b --- /dev/null +++ b/DobutokO/Sound/Effects/Classes/FourthParam.hs @@ -0,0 +1,109 @@ +-- | +-- Module : DobutokO.Sound.Effects.Classes.FourthParam +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX effects. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +module DobutokO.Sound.Effects.Classes.FourthParam where + +import DobutokO.Sound.Effects.Chorus +import DobutokO.Sound.Effects.Gain +import DobutokO.Sound.Effects.MCompand +import DobutokO.Sound.Effects.Phaser +import DobutokO.Sound.Effects.Rate +import DobutokO.Sound.Effects.Reverb +import DobutokO.Sound.Effects.Sinc +import DobutokO.Sound.Effects.Spectrogram +import DobutokO.Sound.Effects.Tempo + +class FourthParam a b where + get4 :: a -> b + +class FourthParamL a b where + get4L :: a -> [b] + +class FourthParamM a b where + get4m :: a -> Maybe b + +instance FourthParam (ChorusTail a b) a where + get4 = chorusTail1 4 + +instance FourthParam (Gain1 a b c d) d where + get4 = gain4 + +instance FourthParamM (Compand a b c d) d where + get4m = compand4 + +instance FourthParam (Phaser a b) a where + get4 = phaser1 4 + +instance FourthParam (RateH a b1 b2 b3 b4 b5 c) b3 where + get4 = rateH23 + +instance FourthParam (Reverb a b c d) d where + get4 = reverb4 + +instance FourthParam ReverbE Float where + get4 = reverb3E 4 + +instance FourthParam (Sinc a b c d) d where + get4 = sinc4 + +instance FourthParamL (Spectrogram3 a b c d e) d where + get4L = spectrogram34 + +instance FourthParamM (Tempo a b c d) d where + get4m = tempo4 + +------------------------------------------------------------------------------------------ + +class FifthParam a b where + get5 :: a -> b + +class FifthParamL a b where + get5L :: a -> [b] + +instance FifthParam (Phaser a b) a where + get5 = phaser1 5 + +instance FifthParam (RateH a b1 b2 b3 b4 b5 c) b4 where + get5 = rateH24 + +instance FifthParam ReverbE Float where + get5 = reverb3E 5 + +instance FifthParamL (Spectrogram3 a b c d e) e where + get5L = spectrogram35 + +------------------------------------------------------------------------------------------ + +class SixthParam a b where + get6 :: a -> b + +instance SixthParam (Phaser a b) b where + get6 = phaser2 + +instance SixthParam (RateH a b1 b2 b3 b4 b5 c) b5 where + get6 = rateH25 + +instance SixthParam ReverbE Float where + get6 = reverb3E 6 + +------------------------------------------------------------------------------------------ + +class SeventhParam a b where + get7 :: a -> b + +instance SeventhParam (RateH a b1 b2 b3 b4 b5 c) c where + get7 = rateH3 + +-- ======================================================================================== + diff --git a/DobutokO/Sound/Effects/Classes/FourthParamSet.hs b/DobutokO/Sound/Effects/Classes/FourthParamSet.hs new file mode 100644 index 0000000..a2a3d56 --- /dev/null +++ b/DobutokO/Sound/Effects/Classes/FourthParamSet.hs @@ -0,0 +1,106 @@ +-- | +-- Module : DobutokO.Sound.Effects.Classes.FourthParamSet +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX effects. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +module DobutokO.Sound.Effects.Classes.FourthParamSet where + +import DobutokO.Sound.Effects.Chorus +import DobutokO.Sound.Effects.Gain +import DobutokO.Sound.Effects.MCompand +import DobutokO.Sound.Effects.Phaser +import DobutokO.Sound.Effects.Rate +import DobutokO.Sound.Effects.Reverb +import DobutokO.Sound.Effects.Sinc +import DobutokO.Sound.Effects.Spectrogram +import DobutokO.Sound.Effects.Tempo + +class FourthParamSet3 a b where + set43 :: a -> b -> b + +class FourthParamSetL3 a b where + set43L :: [a] -> b -> b + +instance FourthParamSet3 a (ChorusTail a b) where + set43 = chorusTailSet1 4 + +instance FourthParamSet3 d (Gain1 a b c d) where + set43 = gainSet4 + +instance FourthParamSet3 d (Compand a b c d) where + set43 = compandSet4 + +instance FourthParamSet3 a (Phaser a b) where + set43 = phaserSet1 4 + +instance FourthParamSet3 b3 (RateH a b1 b2 b3 b4 b5 c) where + set43 = rateHSet23 + +instance FourthParamSet3 d (Reverb a b c d) where + set43 = reverbSet4 + +instance FourthParamSet3 Float ReverbE where + set43 = reverbSet3E 4 + +instance FourthParamSet3 d (Sinc a b c d) where + set43 = sincSet4 + +instance FourthParamSetL3 d (Spectrogram3 a b c d e) where + set43L = spectrogramSet34 + +instance FourthParamSet3 d (Tempo a b c d) where + set43 = tempoSet4 + +------------------------------------------------------------------------------------------ + +class FifthParamSet3 a b where + set53 :: a -> b -> b + +class FifthParamSetL3 a b where + set53L :: [a] -> b -> b + +instance FifthParamSet3 a (Phaser a b) where + set53 = phaserSet1 5 + +instance FifthParamSet3 b4 (RateH a b1 b2 b3 b4 b5 c) where + set53 = rateHSet24 + +instance FifthParamSet3 Float ReverbE where + set53 = reverbSet3E 5 + +instance FifthParamSetL3 e (Spectrogram3 a b c d e) where + set53L = spectrogramSet35 + +------------------------------------------------------------------------------------------ + +class SixthParamSet3 a b where + set63 :: a -> b -> b + +instance SixthParamSet3 b (Phaser a b) where + set63 = phaserSet2 + +instance SixthParamSet3 b5 (RateH a b1 b2 b3 b4 b5 c) where + set63 = rateHSet25 + +instance SixthParamSet3 Float ReverbE where + set63 = reverbSet3E 6 + +------------------------------------------------------------------------------------------ + +class SeventhParamSet3 a b where + set73 :: a -> b -> b + +instance SeventhParamSet3 c (RateH a b1 b2 b3 b4 b5 c) where + set73 = rateHSet3 + +-- ======================================================================================== + diff --git a/DobutokO/Sound/Effects/Classes/FstParam.hs b/DobutokO/Sound/Effects/Classes/FstParam.hs new file mode 100644 index 0000000..af472fe --- /dev/null +++ b/DobutokO/Sound/Effects/Classes/FstParam.hs @@ -0,0 +1,427 @@ +-- | +-- Module : DobutokO.Sound.Effects.Classes.FstParam +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX effects. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +module DobutokO.Sound.Effects.Classes.FstParam where + +import DobutokO.Sound.Effects.Splice +import DobutokO.Sound.Effects.Vad +import DobutokO.Sound.Effects.BassTreble +import DobutokO.Sound.Effects.Bend +import DobutokO.Sound.Effects.Biquad +import DobutokO.Sound.Effects.Channels +import DobutokO.Sound.Effects.Chorus +import DobutokO.Sound.Effects.Contrast +import DobutokO.Sound.Effects.DCShift +import DobutokO.Sound.Effects.Delay +import DobutokO.Sound.Effects.Dither +import DobutokO.Sound.Effects.Downsample +import DobutokO.Sound.Effects.Echo +import DobutokO.Sound.Effects.Fade +import DobutokO.Sound.Effects.FIR +import DobutokO.Sound.Effects.Flanger +import DobutokO.Sound.Effects.Gain +import DobutokO.Sound.Effects.Hilbert +import DobutokO.Sound.Effects.LADSPA +import DobutokO.Sound.Effects.Loudness +import DobutokO.Sound.Effects.MCompand +import DobutokO.Sound.Effects.Misc +import DobutokO.Sound.Effects.Noise +import DobutokO.Sound.Effects.Overdrive +import DobutokO.Sound.Effects.Pad +import DobutokO.Sound.Effects.PassReject +import DobutokO.Sound.Effects.Phaser +import DobutokO.Sound.Effects.Pitch +import DobutokO.Sound.Effects.Rate +import DobutokO.Sound.Effects.Remix +import DobutokO.Sound.Effects.Repeat +import DobutokO.Sound.Effects.Reverb +import DobutokO.Sound.Effects.Segment +import DobutokO.Sound.Effects.Silence +import DobutokO.Sound.Effects.Sinc +import DobutokO.Sound.Effects.Specs +import DobutokO.Sound.Effects.Spectrogram +import DobutokO.Sound.Effects.Speed +import DobutokO.Sound.Effects.Stat +import DobutokO.Sound.Effects.Stats +import DobutokO.Sound.Effects.Stretch +import DobutokO.Sound.Effects.Tempo +import DobutokO.Sound.Effects.Timespec +import DobutokO.Sound.Effects.Tremolo +import DobutokO.Sound.Effects.Trim +import DobutokO.Sound.Effects.Upsample +import DobutokO.Sound.Effects.Vol +import DobutokO.Sound.One + + +class FstParam a b where + get1 :: a -> b + +class FstParamL a b where + get1L :: a -> [b] + +class FstParamM a b where + get1m :: a -> Maybe b + +instance FstParam (FreqWidthS a b) a where + get1 = freqWidthS1 + +instance FstParam (Bass a b) a where + get1 = bass1 + +instance FstParam (Treble a b) a where + get1 = treble1 + +instance FstParam (BendTrio a b) a where + get1 = bendTrio1 + +instance FstParam (FrameRate a) a where + get1 = frameRate1 + +instance FstParam (OverSample a) a where + get1 = overSample1 + +instance FstParamM (Bend a b c) a where + get1m = bend1 + +instance FstParamM (Coeffs a) a where + get1m = coeffs1 1 + +instance FstParam (Biquad a) (Coeffs a) where + get1 = biquad1 + +instance FstParam (Chans a) a where + get1 = channels1 + +instance FstParam (ChorusTail a b) a where + get1 = chorusTail1 1 + +instance FstParam (Chorus a b) a where + get1 = chorus1 1 + +instance FstParamM (Contrast a) a where + get1m = contrast1 + +instance FstParam Cntrst Float where + get1 = contrastE1 + +instance FstParam (DCShift a b) a where + get1 = dcShift1 + +instance FstParamL Dlay TSpecification where + get1L = delay1 + +instance FstParamM (Filter a) a where + get1m = filter1 + +instance FstParamM FilterN NoiseType where + get1m = filterN1 + +instance FstParamM (PrecisionD a) a where + get1m = precisionD1 + +instance FstParamM (Dither a b c) a where + get1m = dither1 + +instance FstParamM (Downsample a) a where + get1m = downSample1 + +instance FstParam DSample Int where + get1 = downSampleE1 + +instance FstParam (EchoTail a) a where + get1 = echoTail1 1 + +instance FstParam (Echo a b) a where + get1 = echo1 1 + +instance FstParam (Echos a b) a where + get1 = echos1 1 + +instance FstParam (Fade2 a b) a where + get1 = fade1 + +instance FstParam Fade String where + get1 = fade2E 1 + +instance FstParamM (Fir a b) a where + get1m = fir1 + +instance FstParamL (Flanger a b) a where + get1L = flanger1 + +instance FstParamL Flanger2 Float where + get1L = flanger1E + +instance FstParam (Gain1 a b c d) a where + get1 = gain1 + +instance FstParamM (Hilbert a) a where + get1m = hilbert1 + +instance FstParam (Ladspa1 a b c) a where + get1 = ladspa1 + +instance FstParamM (Loudness a) a where + get1m = loudness1 + +instance FstParamM (FloatE a) a where + get1m = floatE1 + +instance FstParamM (CompandTail a b) (One2 a) where + get1m = compandTail1 + +instance FstParam (Pair a) a where + get1 = pair1 + +instance FstParam (AtDe a) a where + get1 = atDe1 + +instance FstParam (Neg a) a where + get1 = neg1 + +instance FstParamM (SoftKnee a) a where + get1m = softKnee1 + +instance FstParam (Compand a b c d) a where + get1 = compand1 + +instance FstParam KFQ Int where + get1 = kFreq1 + +instance FstParam (FreqComp a b) a where + get1 = freqComp1 + +instance FstParam (MCompand a b) a where + get1 = mCompand1 + +instance FstParamL (MscS a) a where + get1L = mscS1 + +instance FstParamM (Noiseprof a) a where + get1m = noiseprof1 + +instance FstParamM (Noisered a b) a where + get1m = noisered1 + +instance FstParamM (Overdrive a) a where + get1m = overdrive1 + +instance FstParam (PadSpec a) a where + get1 = padSpec1 + +instance FstParamL (Pad a b) a where + get1L = pad1 + +instance FstParam (FreqWidth a b) a where + get1 = freqWidth1 + +instance FstParam (Freq a) a where + get1 = freq1 + +instance FstParam (AllPass a) a where + get1 = allPass1 + +instance FstParam (BandReject a) a where + get1 = bandReject1 + +instance FstParam (BandPass a b) a where + get1 = bandPass1 + +instance FstParam (Band a b) a where + get1 = band1 + +instance FstParam (HighPass a b) a where + get1 = highPass1 + +instance FstParam (LowPass a b) a where + get1 = lowPass1 + +instance FstParam (Equalizer a b) a where + get1 = equalizer1 + +instance FstParam (Phaser a b) a where + get1 = phaser1 1 + +instance FstParam (Pitch a b c) a where + get1 = pitch1 + +instance FstParamM (Ropt4 a) a where + get1m = rOpt41 + +instance FstParamM (Ropt5 a) a where + get1m = rOpt51 + +instance FstParam (RateL a b) a where + get1 = rateL1 + +instance FstParam (RateH a b1 b2 b3 b4 b5 c) a where + get1 = rateH1 + +instance FstParamM (Rate2 a b) a where + get1m = rate21 + +instance FstParam (Vol3 Float) Float where + get1 = vol31 + +instance FstParam (IChannel a b) a where + get1 = ichannel1 + +instance FstParam (IChannel a Float) Float where + get1 = ichannel21 + +instance FstParamL (OChannel a) a where + get1L = ochannel1 + +instance FstParamM (Remix a b) a where + get1m = remix1 + +instance FstParam (Repeat a) a where + get1 = repeat1 + +instance FstParam (Reverb a b c d) a where + get1 = reverb1 + +instance FstParam ReverbE Float where + get1 = reverb3E 1 + +instance FstParamM (Segment a) a where + get1m = segment1 + +instance FstParam (Threshold a) a where + get1 = threshold1 + +instance FstParamM (Duration a b) a where + get1m = duration1 + +instance FstParamM (AboveTSpec1 a b c) a where + get1m = aboveTSpec1 + +instance FstParamM (BelowTSpec1 a b c) a where + get1m = belowTSpec1 + +instance FstParam (Silence a b c) a where + get1 = silence1 + +instance FstParamM (PhaseR a) a where + get1m = phaseR1 + +instance FstParamM (SincAB a) a where + get1m = sincAB1 + +instance FstParamM (SincTN a) a where + get1m = sincTN1 + +instance FstParam (FreqL a) a where + get1 = freqL1 + +instance FstParam (FreqH a) a where + get1 = freqH1 + +instance FstParam (Sinc a b c d) a where + get1 = sinc1 + +instance FstParam Freq1 Float where + get1 = frequency1 + +instance FstParam (Width a) a where + get1 = width1 + +instance FstParam (SFloat1 a) a where + get1 = sFloat11 + +instance FstParam (SString1 a) a where + get1 = sString11 + +instance FstParam (Advanced1 a) a where + get1 = advanced11 + +instance FstParamM FirstDTSpec Float where + get1m = secondsD + +instance FstParamM FirstDTSpec Int where + get1m = samplesD + +instance FstParamL (Spectrogram3 a b c d e) a where + get1L = spectrogram31 + +instance FstParam (Speed a b) a where + get1 = speed1 + +instance FstParam (Splice2 a b) a where + get1 = splice21 + +instance FstParamM (StatP a) a where + get1m = statP1 + +instance FstParamL (Stat1 a) a where + get1L = stat11 + +instance FstParamM (StatsP a) a where + get1m = statsP1 + +instance FstParamM (Window1 a) a where + get1m = window11 + +instance FstParamL (Stats2 a b) a where + get1L = stats21 + +instance FstParam (StretchP a) a where + get1 = stretch1 + +instance FstParam (Stretch2 a b) a where + get1 = stretch21 + +instance FstParam (Tempo a b c d) a where + get1 = tempo1 + +instance FstParamM FirstTSpec Float where + get1m = seconds + +instance FstParamM FirstTSpec Int where + get1m = samples + +instance FstParamM NextTSpec Float where + get1m = seconds2 + +instance FstParamM NextTSpec Int where + get1m = samples2 + +instance FstParam (TimeSpec a b) a where + get1 = timeSpec1 + +instance FstParam (Tremolo a) a where + get1 = tremolo1 + +instance FstParam (Trim a) a where + get1 = trim1 + +instance FstParamM (Upsample a) a where + get1m = upSample1 + +instance FstParam (VadP a) a where + get1 = vadP1 + +instance FstParamL (Vad1 a) a where + get1L = vad11 + +instance FstParam (Vol2 a b) a where + get1 = vol1 + +instance FstParamL (One2 a) a where + get1L = one21 + +instance FstParamL (One3 a) a where + get1L = one31 + +------------------------------------------------------------------------------------------ diff --git a/DobutokO/Sound/Effects/Classes/FstParamSet.hs b/DobutokO/Sound/Effects/Classes/FstParamSet.hs new file mode 100644 index 0000000..379fa12 --- /dev/null +++ b/DobutokO/Sound/Effects/Classes/FstParamSet.hs @@ -0,0 +1,402 @@ +-- | +-- Module : DobutokO.Sound.Effects.Classes.FstParamSet +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX effects. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +module DobutokO.Sound.Effects.Classes.FstParamSet where + +-- inspired with: https://wiki.haskell.org/Scoped_type_variables +import GHC.Base (asTypeOf) +import DobutokO.Sound.Effects.BassTreble +import DobutokO.Sound.Effects.Bend +import DobutokO.Sound.Effects.Biquad +import DobutokO.Sound.Effects.Channels +import DobutokO.Sound.Effects.Chorus +import DobutokO.Sound.Effects.Contrast +import DobutokO.Sound.Effects.DCShift +import DobutokO.Sound.Effects.Delay +import DobutokO.Sound.Effects.Dither +import DobutokO.Sound.Effects.Downsample +import DobutokO.Sound.Effects.Echo +import DobutokO.Sound.Effects.Fade +import DobutokO.Sound.Effects.FIR +import DobutokO.Sound.Effects.Flanger +import DobutokO.Sound.Effects.Gain +import DobutokO.Sound.Effects.Hilbert +import DobutokO.Sound.Effects.LADSPA +import DobutokO.Sound.Effects.Loudness +import DobutokO.Sound.Effects.MCompand +import DobutokO.Sound.Effects.Misc +import DobutokO.Sound.Effects.Noise +import DobutokO.Sound.Effects.Overdrive +import DobutokO.Sound.Effects.Pad +import DobutokO.Sound.Effects.PassReject +import DobutokO.Sound.Effects.Phaser +import DobutokO.Sound.Effects.Pitch +import DobutokO.Sound.Effects.Rate +import DobutokO.Sound.Effects.Remix +import DobutokO.Sound.Effects.Repeat +import DobutokO.Sound.Effects.Reverb +import DobutokO.Sound.Effects.Segment +import DobutokO.Sound.Effects.Silence +import DobutokO.Sound.Effects.Sinc +import DobutokO.Sound.Effects.Specs +import DobutokO.Sound.Effects.Spectrogram +import DobutokO.Sound.Effects.Speed +import DobutokO.Sound.Effects.Splice +import DobutokO.Sound.Effects.Stat +import DobutokO.Sound.Effects.Stats +import DobutokO.Sound.Effects.Stretch +import DobutokO.Sound.Effects.Tempo +import DobutokO.Sound.Effects.Timespec +import DobutokO.Sound.Effects.Tremolo +import DobutokO.Sound.Effects.Trim +import DobutokO.Sound.Effects.Upsample +import DobutokO.Sound.Effects.Vad +import DobutokO.Sound.Effects.Vol +import DobutokO.Sound.One + +class FstParamSet a b where + set1 :: a -> b + set1G :: a -> b -> b + set1G x = asTypeOf (set1 x) + +class FstParamSet3 a b where + set13 :: a -> b -> b + +class FstParamSetL a b where + set1L :: [a] -> b + set1GL :: [a] -> b -> b + set1GL xs = asTypeOf (set1L xs) + +class FstParamSetL3 a b where + set13L :: [a] -> b -> b + +class FstParamSet3O a b where + set1o :: (One2 a) -> b -> b + +instance FstParamSet3 a (FreqWidthS a b) where + set13 = freqWidthSSet1 + +instance FstParamSet3 a (Bass a b) where + set13 = bassSet1 + +instance FstParamSet3 a (Treble a b) where + set13 = trebleSet1 + +instance FstParamSet3 a (BendTrio a b) where + set13 = bendTrioSet1 + +instance FstParamSet a (FrameRate a) where + set1 = frameRateSet1 + +instance FstParamSet a (OverSample a) where + set1 = overSampleSet1 + +instance FstParamSet3 a (Bend a b c) where + set13 = bendSet1 + +instance FstParamSet3 a (Coeffs a) where + set13 = coeffsSet1 + +instance FstParamSet3 (Coeffs a) (Biquad a) where + set13 = biquadSet1 + +instance FstParamSet a (Chans a) where + set1 = channelsSet1 + +instance FstParamSet3 a (ChorusTail a b) where + set13 = chorusTailSet1 1 + +instance FstParamSet3 a (Chorus a b) where + set13 = chorusSet1 1 + +instance FstParamSet3 a (Contrast a) where + set13 = contrastSet1 + +instance FstParamSet3 a (DCShift a b) where + set13 = dcShiftSet1 + +instance FstParamSetL TSpecification Dlay where + set1L = delaySet1 + +instance FstParamSet a (Filter a) where + set1 = filterSet1 + +instance FstParamSet Float Precision where + set1 = precisionSet1 + +instance FstParamSet3 a (Dither a b c) where + set13 = ditherSet1 + +instance FstParamSet a (Downsample a) where + set1 = downSampleSet1 + +instance FstParamSet3 a (EchoTail a) where + set13 = echoTailSet1 1 + +instance FstParamSet3 a (Echo a b) where + set13 = echoSet1 1 + +instance FstParamSet3 a (Echos a b) where + set13 = echosSet1 1 + +instance FstParamSet3 a (Fade2 a b) where + set13 = fadeSet1 + +instance FstParamSet3 String Fade where + set13 = fadeSet2E 1 + +instance FstParamSet a (Fir a b) where + set1 = firSet1 + +instance FstParamSetL3 a (Flanger a b) where + set13L = flangerSet1 + +instance FstParamSet3 a (Gain1 a b c d) where + set13 = gainSet1 + +instance FstParamSet a (Hilbert a) where + set1 = HI + +instance FstParamSet3 a (Ladspa1 a b c) where + set13 = ladspaSet1 + +instance FstParamSet3 a (Loudness a) where + set13 = loudnessSet1 + +instance FstParamSet a (FloatE a) where + set1 = floatESet1 + +instance FstParamSet3O a (CompandTail a b) where + set1o = compandTailSet1 + +instance FstParamSet3 a (Pair a) where + set13 = pairSet1 + +instance FstParamSet3 a (AtDe a) where + set13 = atDeSet1 + +instance FstParamSet a (Neg a) where + set1 = NG + +instance FstParamSet a (SoftKnee a) where + set1 = SK + +instance FstParamSet3 a (Compand a b c d) where + set13 = compandSet1 + +instance FstParamSet3 a (FreqComp a b) where + set13 = freqCompSet1 + +instance FstParamSet3 a (MCompand a b) where + set13 = mCompandSet1 + +instance FstParamSetL a (MscS a) where + set1L = mscSSet1 + +instance FstParamSet a (Noiseprof a) where + set1 = noiseprofSet1 + +instance FstParamSet3 a (Noisered a b) where + set13 = noiseredSet1 + +instance FstParamSet3 a (Overdrive a) where + set13 = overdriveSet1 + +instance FstParamSet3 a (PadSpec a) where + set13 = padSpecSet1 + +instance FstParamSet3O a (Pad a b) where + set1o = padSet1 + +instance FstParamSet3 a (FreqWidth a b) where + set13 = freqWidthSet1 + +instance FstParamSet3 a (Freq a) where + set13 = freqSet1 + +instance FstParamSet3 a (AllPass a) where + set13 = allPassSet1 + +instance FstParamSet3 a (BandReject a) where + set13 = bandRejectSet1 + +instance FstParamSet3 a (BandPass a b) where + set13 = bandPassSet1 + +instance FstParamSet3 a (Band a b) where + set13 = bandSet1 + +instance FstParamSet3 a (HighPass a b) where + set13 = highPassSet1 + +instance FstParamSet3 a (LowPass a b) where + set13 = lowPassSet1 + +instance FstParamSet3 a (Equalizer a b) where + set13 = equalizerSet1 + +instance FstParamSet3 a (Phaser a b) where + set13 = phaserSet1 1 + +instance FstParamSet3 a (Pitch a b c) where + set13 = pitchSet1 + +instance FstParamSet a (Ropt4 a) where + set1 = rOpt4Set1 + +instance FstParamSet a (Ropt5 a) where + set1 = rOpt5Set1 + +instance FstParamSet3 a (RateL a b) where + set13 = rateLSet1 + +instance FstParamSet3 a (RateH a b1 b2 b3 b4 b5 c) where + set13 = rateHSet1 + +instance FstParamSet RateLow Rate where + set1 = rate2Set1 + +instance FstParamSet3 Float (Vol3 Float) where + set13 = vol3Set1 + +instance FstParamSet3 a (IChannel a b) where + set13 = ichannelSet1 + +instance FstParamSetL3 a (OChannel a) where + set13L = ochannelSet1 + +instance FstParamSet3 MixSpec ReMix where + set13 = remixSet1 + +instance FstParamSet a (Repeat a) where + set1 = Rpt + +instance FstParamSet3 a (Reverb a b c d) where + set13 = reverbSet1 + +instance FstParamSet3 Float ReverbE where + set13 = reverbSet3E 1 + +instance FstParamSet3 a (Segment a) where + set13 = segmentSet1 + +instance FstParamSet3 a (Threshold a) where + set13 = thresholdSet1 + +instance FstParamSet3 a (Duration a b) where + set13 = durationSet1d + +instance FstParamSet3 a (AboveTSpec1 a b c) where + set13 = aboveTSpecSet1a + +instance FstParamSet3 a (BelowTSpec1 a b c) where + set13 = belowTSpecSet1b + +instance FstParamSet3 a (Silence a b c) where + set13 = silenceSet1 + +instance FstParamSet a (PhaseR a) where + set1 = phaseRSet1 + +instance FstParamSet a (FreqL a) where + set1 = freqLSet1 + +instance FstParamSet a (FreqH a) where + set1 = freqHSet1 + +instance FstParamSet3 a (Sinc a b c d) where + set13 = sincSet1 + +instance FstParamSet3 Float Freq1 where + set13 = frequencySet1 + +instance FstParamSet3 a (Width a) where + set13 = widthSet1 + +instance FstParamSet3 a (SFloat1 a) where + set13 = sFloat1Set1 + +instance FstParamSet3 a (SString1 a) where + set13 = sString1Set1 + +instance FstParamSet a (Advanced1 a) where + set1 = advanced1Set1 + +instance FstParamSet Float FirstDTSpec where + set1 = seconds2FstDTSpec2 + +instance FstParamSet Int FirstDTSpec where + set1 = samples2FstDTSpec2 + +instance FstParamSetL3 a (Spectrogram3 a b c d e) where + set13L = spectrogramSet31 + +instance FstParamSet3 a (Speed a b) where + set13 = speedSet1 + +instance FstParamSet3 a (Splice2 a b) where + set13 = splice2Set1 + +instance FstParamSet a (StatP a) where + set1 = statPSet1 + +instance FstParamSetL a (Stat1 a) where + set1L = stat1Set1 + +instance FstParamSet3 a (StatsP a) where + set13 = statsPSet1 + +instance FstParamSet a (Window1 a) where + set1 = window1Set1 + +instance FstParamSetL3 a (Stats2 a b) where + set13L = stats2Set1 + +instance FstParamSet3 a (StretchP a) where + set13 = stretchSet1 + +instance FstParamSet3 a (Stretch2 a b) where + set13 = stretch2Set1 + +instance FstParamSet3 a (Tempo a b c d) where + set13 = tempoSet1 + +instance FstParamSet3 a (TimeSpec a b) where + set13 = timeSpecSet1 + +instance FstParamSet3 a (Tremolo a) where + set13 = tremoloSet1 + +instance FstParamSet a (Trim a) where + set1 = trimSet1 + +instance FstParamSet a (Upsample a) where + set1 = upSampleSet1 + +instance FstParamSet3 a (VadP a) where + set13 = vadPSet1 + +instance FstParamSetL3 a (Vad1 a) where + set13L = vad1Set1 + +instance FstParamSet3 a (Vol2 a b) where + set13 = volSet1 + +instance FstParamSet3 a (One2 a) where + set13 = one2Set1 + +instance FstParamSet3 a (One3 a) where + set13 = one3Set1 + +------------------------------------------------------------------------------------------ diff --git a/DobutokO/Sound/Effects/Classes/SndParam.hs b/DobutokO/Sound/Effects/Classes/SndParam.hs new file mode 100644 index 0000000..fbc22a5 --- /dev/null +++ b/DobutokO/Sound/Effects/Classes/SndParam.hs @@ -0,0 +1,255 @@ +-- | +-- Module : DobutokO.Sound.Effects.Classes.SndParam +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX effects. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +module DobutokO.Sound.Effects.Classes.SndParam where + +import DobutokO.Sound.Effects.Splice +import DobutokO.Sound.Effects.BassTreble +import DobutokO.Sound.Effects.Bend +import DobutokO.Sound.Effects.Biquad +import DobutokO.Sound.Effects.Chorus +import DobutokO.Sound.Effects.DCShift +import DobutokO.Sound.Effects.Dither +import DobutokO.Sound.Effects.Echo +import DobutokO.Sound.Effects.Fade +import DobutokO.Sound.Effects.FIR +import DobutokO.Sound.Effects.Flanger +import DobutokO.Sound.Effects.Gain +import DobutokO.Sound.Effects.LADSPA +import DobutokO.Sound.Effects.Loudness +import DobutokO.Sound.Effects.MCompand +import DobutokO.Sound.Effects.Noise +import DobutokO.Sound.Effects.Overdrive +import DobutokO.Sound.Effects.Pad +import DobutokO.Sound.Effects.PassReject +import DobutokO.Sound.Effects.Phaser +import DobutokO.Sound.Effects.Pitch +import DobutokO.Sound.Effects.Rate +import DobutokO.Sound.Effects.Remix +import DobutokO.Sound.Effects.Reverb +import DobutokO.Sound.Effects.Segment +import DobutokO.Sound.Effects.Silence +import DobutokO.Sound.Effects.Sinc +import DobutokO.Sound.Effects.Spectrogram +import DobutokO.Sound.Effects.Speed +import DobutokO.Sound.Effects.Stats +import DobutokO.Sound.Effects.Stretch +import DobutokO.Sound.Effects.Tempo +import DobutokO.Sound.Effects.Timespec +import DobutokO.Sound.Effects.Tremolo +import DobutokO.Sound.Effects.Vol +import DobutokO.Sound.One + +class SndParam a b where + get2 :: a -> b + +class SndParamL a b where + get2L :: a -> [b] + +class SndParamM a b where + get2m :: a -> Maybe b + +instance SndParamM (FreqWidthS a b) b where + get2m = freqWidthS2 + +instance SndParam (Bass a b) b where + get2 = bass2 + +instance SndParam (Treble a b) b where + get2 = treble2 + +instance SndParam (BendTrio a b) b where + get2 = bendTrio2 + +instance SndParamM (Bend a b c) b where + get2m = bend2 + +instance SndParamM (Coeffs a) a where + get2m = coeffs1 2 + +instance SndParam (Biquad a) (Coeffs a) where + get2 = biquad2 + +instance SndParam (ChorusTail a b) a where + get2 = chorusTail1 2 + +instance SndParam (Chorus a b) a where + get2 = chorus1 2 + +instance SndParamM (DCShift a b) b where + get2m = dcShift2 + +instance SndParamM (Dither a b c) b where + get2m = dither2 + +instance SndParam (EchoTail a) a where + get2 = echoTail1 2 + +instance SndParam (Echo a b) a where + get2 = echo1 2 + +instance SndParam (Echos a b) a where + get2 = echos1 2 + +instance SndParamL (Fade2 a b) b where + get2L = fade2 + +instance SndParam Fade String where + get2 = fade2E 2 + +instance SndParamM (Fir a b) [b] where + get2m = fir2 + +instance SndParam (Flanger a b) b where + get2 = flanger2 + +instance SndParam (Gain1 a b c d) b where + get2 = gain2 + +instance SndParam (Ladspa1 a b c) (One2 b) where + get2 = ladspa2 + +instance SndParamM (Loudness a) a where + get2m = loudness2 + +instance SndParamM (CompandTail a b) b where + get2m = compandTail2 + +instance SndParam (Pair a) a where + get2 = pair2 + +instance SndParamL (AtDe a) a where + get2L = atDe2 + +instance SndParam (Compand a b c d) b where + get2 = compand2 + +instance SndParam (FreqComp a b) b where + get2 = freqComp2 + +instance SndParamM (MCompand a b) [b] where + get2m = mCompand2 + +instance SndParamM (Noisered a b) b where + get2m = noisered2 + +instance SndParamM (Overdrive a) a where + get2m = overdrive2 + +instance SndParam (PadSpec a) a where + get2 = padSpec2 + +instance SndParamL (Pad a b) b where + get2L = pad2 + +instance SndParamM (FreqWidth a b) b where + get2m = freqWidth2 + +instance SndParam (BandPass a b) b where + get2 = bandPass2 + +instance SndParam (Band a b) b where + get2 = band2 + +instance SndParam (HighPass a b) b where + get2 = highPass2 + +instance SndParam (LowPass a b) b where + get2 = lowPass2 + +instance SndParam (Equalizer a b) b where + get2 = equalizer2 + +instance SndParam (Phaser a b) a where + get2 = phaser1 2 + +instance SndParam (Pitch a b c) b where + get2 = pitch2 + +instance SndParam (RateL a b) b where + get2 = rateL2 + +instance SndParam (RateH a b1 b2 b3 b4 b5 c) b1 where + get2 = rateH21 + +instance SndParamM (Rate2 a b) b where + get2m = rate22 + +instance SndParamL (Remix a b) b where + get2L = remix2 + +instance SndParam (Reverb a b c d) b where + get2 = reverb2 + +instance SndParam ReverbE Float where + get2 = reverb3E 2 + +instance SndParamM (Segment a) a where + get2m = segment2 + +instance SndParamM (Duration a b) b where + get2m = duration2 + +instance SndParamM (AboveTSpec1 a b c) b where + get2m = aboveTSpec2 + +instance SndParamM (BelowTSpec1 a b c) b where + get2m = belowTSpec2 + +instance SndParam (Silence a b c) b where + get2 = silence2 + +instance SndParam (Sinc a b c d) b where + get2 = sinc2 + +instance SndParamM FirstDTSpec Int where + get2m = minutesD + +instance SndParamL (Spectrogram3 a b c d e) b where + get2L = spectrogram32 + +instance SndParam (Speed a b) b where + get2 = speed2 + +instance SndParamL (Splice2 a b) (One3 b) where + get2L = splice22 + +instance SndParamL (Stats2 a b) b where + get2L = stats22 + +instance SndParam (StretchP a) a where + get2 = stretch2 + +instance SndParamM (Stretch2 a b) b where + get2m = stretch22 + +instance SndParam (Tempo a b c d) b where + get2 = tempo2 + +instance SndParamM FirstTSpec Int where + get2m = minutes + +instance SndParamM NextTSpec Int where + get2m = minutes2 + +instance SndParamM (TimeSpec a b) [b] where + get2m = timeSpec2 + +instance SndParamM (Tremolo a) a where + get2m = tremolo2 + +instance SndParamM (Vol2 a b) b where + get2m = vol2 + + diff --git a/DobutokO/Sound/Effects/Classes/SndParamSet.hs b/DobutokO/Sound/Effects/Classes/SndParamSet.hs new file mode 100644 index 0000000..ecec088 --- /dev/null +++ b/DobutokO/Sound/Effects/Classes/SndParamSet.hs @@ -0,0 +1,259 @@ +-- | +-- Module : DobutokO.Sound.Effects.Classes.SndParamSet +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX effects. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +module DobutokO.Sound.Effects.Classes.SndParamSet where + +-- inspired with: https://wiki.haskell.org/Scoped_type_variables +import GHC.Base (asTypeOf) +import DobutokO.Sound.Effects.BassTreble +import DobutokO.Sound.Effects.Bend +import DobutokO.Sound.Effects.Biquad +import DobutokO.Sound.Effects.Chorus +import DobutokO.Sound.Effects.DCShift +import DobutokO.Sound.Effects.Dither +import DobutokO.Sound.Effects.Echo +import DobutokO.Sound.Effects.Fade +import DobutokO.Sound.Effects.FIR +import DobutokO.Sound.Effects.Flanger +import DobutokO.Sound.Effects.Gain +import DobutokO.Sound.Effects.LADSPA +import DobutokO.Sound.Effects.Loudness +import DobutokO.Sound.Effects.MCompand +import DobutokO.Sound.Effects.Noise +import DobutokO.Sound.Effects.Overdrive +import DobutokO.Sound.Effects.Pad +import DobutokO.Sound.Effects.PassReject +import DobutokO.Sound.Effects.Phaser +import DobutokO.Sound.Effects.Pitch +import DobutokO.Sound.Effects.Rate +import DobutokO.Sound.Effects.Remix +import DobutokO.Sound.Effects.Reverb +import DobutokO.Sound.Effects.Silence +import DobutokO.Sound.Effects.Sinc +import DobutokO.Sound.Effects.Spectrogram +import DobutokO.Sound.Effects.Speed +import DobutokO.Sound.Effects.Splice +import DobutokO.Sound.Effects.Stats +import DobutokO.Sound.Effects.Stretch +import DobutokO.Sound.Effects.Tempo +import DobutokO.Sound.Effects.Timespec +import DobutokO.Sound.Effects.Tremolo +import DobutokO.Sound.Effects.Vol +import DobutokO.Sound.One + +class SndParamSet a b where + set2 :: a -> b + set2G :: a -> b -> b + set2G x = asTypeOf (set2 x) + +class SndParamSet3 a b where + set23 :: a -> b -> b + +class SndParamSet3M a b where + set23m :: a -> b -> Maybe b + +class SndParamSetL a b where + set2L :: [a] -> b + set2GL :: [a] -> b -> b + set2GL xs = asTypeOf (set2L xs) + +class SndParamSetL3 a b where + set23L :: [a] -> b -> b + +class SndParamSet3O a b where + set23o :: (One2 a) -> b -> b + +instance SndParamSet3 b (FreqWidthS a b) where + set23 = freqWidthSSet2 + +instance SndParamSet3 b (Bass a b) where + set23 = bassSet2 + +instance SndParamSet3 b (Treble a b) where + set23 = trebleSet2 + +instance SndParamSet3 b (BendTrio a b) where + set23 = bendTrioSet2 + +instance SndParamSet3 b (Bend a b c) where + set23 = bendSet2 + +instance SndParamSet3 a (Coeffs a) where + set23 = coeffsSet2 + +instance SndParamSet3 (Coeffs a) (Biquad a) where + set23 = biquadSet2 + +instance SndParamSet3 a (ChorusTail a b) where + set23 = chorusTailSet1 2 + +instance SndParamSet3 a (Chorus a b) where + set23 = chorusSet1 2 + +instance SndParamSet3 b (DCShift a b) where + set23 = dcShiftSet2 + +instance SndParamSet3 b (Dither a b c) where + set23 = ditherSet2 + +instance SndParamSet3 a (EchoTail a) where + set23 = echoTailSet1 2 + +instance SndParamSet3 a (Echo a b) where + set23 = echoSet1 2 + +instance SndParamSet3 a (Echos a b) where + set23 = echosSet1 2 + +instance SndParamSetL3 b (Fade2 a b) where + set23L = fadeSet2 + +instance SndParamSet3 String Fade where + set23 = fadeSet2E 2 + +instance SndParamSetL b (Fir a b) where + set2L = firSet2 + +instance SndParamSet3 b (Flanger a b) where + set23 = flangerSet2 + +instance SndParamSet3 b (Gain1 a b c d) where + set23 = gainSet2 + +instance SndParamSet3O b (Ladspa1 a b c) where + set23o = ladspaSet2 + +instance SndParamSet3 a (Loudness a) where + set23 = loudnessSet2 + +instance SndParamSet3M b (CompandTail a b) where + set23m = compandTailSet2 + +instance SndParamSet3 a (Pair a) where + set23 = pairSet2 + +instance SndParamSetL3 a (AtDe a) where + set23L = atDeSet2 + +instance SndParamSet3 b (Compand a b c d) where + set23 = compandSet2 + +instance SndParamSet3 b (FreqComp a b) where + set23 = freqCompSet2 + +instance SndParamSetL3 b (MCompand a b) where + set23L = mCompandSet2 + +instance SndParamSet3M b (Noisered a b) where + set23m = noiseredSet2 + +instance SndParamSet3M a (Overdrive a) where + set23m = overdriveSet2 + +instance SndParamSet3 a (PadSpec a) where + set23 = padSpecSet2 + +instance SndParamSetL3 b (Pad a b) where + set23L = padSet2 + +instance SndParamSet3 b (FreqWidth a b) where + set23 = freqWidthSet2 + +instance SndParamSet3 b (BandPass a b) where + set23 = bandPassSet2 + +instance SndParamSet3 b (Band a b) where + set23 = bandSet2 + +instance SndParamSet3 b (HighPass a b) where + set23 = highPassSet2 + +instance SndParamSet3 b (LowPass a b) where + set23 = lowPassSet2 + +instance SndParamSet3 b (Equalizer a b) where + set23 = equalizerSet2 + +instance SndParamSet3 a (Phaser a b) where + set23 = phaserSet1 2 + +instance SndParamSet3 b (Pitch a b c) where + set23 = pitchSet2 + +instance SndParamSet3 b (RateL a b) where + set23 = rateLSet2 + +instance SndParamSet3 b1 (RateH a b1 b2 b3 b4 b5 c) where + set23 = rateHSet21 + +instance SndParamSet RateHigh Rate where + set2 = rate2Set2 + +instance SndParamSet3 (Vol3 b) (IChannel a b) where + set23 = ichannelSet2 + +instance SndParamSetL3 OChanF ReMix where + set23L = remixSet2 + +instance SndParamSet3 b (Reverb a b c d) where + set23 = reverbSet2 + +instance SndParamSet3 Float ReverbE where + set23 = reverbSet3E 2 + +instance SndParamSet3 b (Duration a b) where + set23 = durationSet2d + +instance SndParamSet3 b (AboveTSpec1 a b c) where + set23 = aboveTSpecSet2a + +instance SndParamSet3 b (BelowTSpec1 a b c) where + set23 = belowTSpecSet2b + +instance SndParamSet3 b (Silence a b c) where + set23 = silenceSet2 + +instance SndParamSet3 b (Sinc a b c d) where + set23 = sincSet2 + +instance SndParamSetL3 b (Spectrogram3 a b c d e) where + set23L = spectrogramSet32 + +instance SndParamSet3 b (Speed a b) where + set23 = speedSet2 + +instance SndParamSetL3 (One3 b) (Splice2 a b) where + set23L = splice2Set2 + +instance SndParamSetL3 b (Stats2 a b) where + set23L = stats2Set2 + +instance SndParamSet3 a (StretchP a) where + set23 = stretchSet2 + +instance SndParamSet3 b (Stretch2 a b) where + set23 = stretch2Set2 + +instance SndParamSet3 b (Tempo a b c d) where + set23 = tempoSet2 + +instance SndParamSetL3 b (TimeSpec a b) where + set23L = timeSpecSet2 + +instance SndParamSet3 a (Tremolo a) where + set23 = tremoloSet2 + +instance SndParamSet3 b (Vol2 a b) where + set23 = volSet2 + diff --git a/DobutokO/Sound/Effects/Classes/ThdParam.hs b/DobutokO/Sound/Effects/Classes/ThdParam.hs new file mode 100644 index 0000000..b78de42 --- /dev/null +++ b/DobutokO/Sound/Effects/Classes/ThdParam.hs @@ -0,0 +1,135 @@ +-- | +-- Module : DobutokO.Sound.Effects.Classes.ThdParam +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX effects. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +module DobutokO.Sound.Effects.Classes.ThdParam where + +import DobutokO.Sound.Effects.Bend +import DobutokO.Sound.Effects.Biquad +import DobutokO.Sound.Effects.Chorus +import DobutokO.Sound.Effects.Dither +import DobutokO.Sound.Effects.Echo +import DobutokO.Sound.Effects.Fade +import DobutokO.Sound.Effects.Gain +import DobutokO.Sound.Effects.LADSPA +import DobutokO.Sound.Effects.MCompand +import DobutokO.Sound.Effects.Phaser +import DobutokO.Sound.Effects.Pitch +import DobutokO.Sound.Effects.Rate +import DobutokO.Sound.Effects.Reverb +import DobutokO.Sound.Effects.Segment +import DobutokO.Sound.Effects.Silence +import DobutokO.Sound.Effects.Sinc +import DobutokO.Sound.Effects.Spectrogram +import DobutokO.Sound.Effects.Stretch +import DobutokO.Sound.Effects.Tempo +import DobutokO.Sound.Effects.Timespec +import DobutokO.Sound.Effects.Vol +import DobutokO.Sound.One + +class ThdParam a b where + get3 :: a -> b + +class ThdParamL a b where + get3L :: a -> [b] + +class ThdParamM a b where + get3m :: a -> Maybe b + +instance ThdParam (BendTrio a b) a where + get3 = bendTrio3 + +instance ThdParam (Bend a b c) c where + get3 = bend3 + +instance ThdParamM (Coeffs a) a where + get3m = coeffs1 3 + +instance ThdParam (ChorusTail a b) a where + get3 = chorusTail1 3 + +instance ThdParamL (Chorus a b) b where + get3L = chorus2 + +instance ThdParamM (Dither a b c) c where + get3m = dither3 + +instance ThdParamL (Echo a b) b where + get3L = echo2 + +instance ThdParamL (Echos a b) b where + get3L = echos2 + +instance ThdParam Fade String where + get3 = fade2E 3 + +instance ThdParam (Gain1 a b c d) c where + get3 = gain3 + +instance ThdParamM (Ladspa1 a b c) c where + get3m = ladspa3 + +instance ThdParam (Compand a b c d) c where + get3 = compand3 + +instance ThdParam (Phaser a b) a where + get3 = phaser1 3 + +instance ThdParamM (Pitch a b c) c where + get3m = pitch3 + +instance ThdParam (RateH a b1 b2 b3 b4 b5 c) b2 where + get3 = rateH22 + +instance ThdParamL (Reverb a b c d) c where + get3L = reverb3 + +instance ThdParam ReverbE Float where + get3 = reverb3E 3 + +instance ThdParamM (Segment a) a where + get3m = segment3 + +instance ThdParamM (AboveTSpec1 a b c) c where + get3m = aboveTSpec3 + +instance ThdParamM (BelowTSpec1 a b c) c where + get3m = belowTSpec3 + +instance ThdParamM (Silence a b c) c where + get3m = silence3 + +instance ThdParam (Sinc a b c d) (One2 c) where + get3 = sinc3 + +instance ThdParamM FirstDTSpec Int where + get3m = hoursD + +instance ThdParamL (Spectrogram3 a b c d e) c where + get3L = spectrogram33 + +instance ThdParam (StretchP a) a where + get3 = stretch3 + +instance ThdParam (Tempo a b c d) c where + get3 = tempo3 + +instance ThdParamM FirstTSpec Int where + get3m = hours + +instance ThdParamM NextTSpec Int where + get3m = hours2 + +instance ThdParamM (Vol2 a b) a where + get3m = vol3 + diff --git a/DobutokO/Sound/Effects/Classes/ThdParamSet.hs b/DobutokO/Sound/Effects/Classes/ThdParamSet.hs new file mode 100644 index 0000000..5a55230 --- /dev/null +++ b/DobutokO/Sound/Effects/Classes/ThdParamSet.hs @@ -0,0 +1,122 @@ +-- | +-- Module : DobutokO.Sound.Effects.Classes.ThdParamSet +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX effects. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +module DobutokO.Sound.Effects.Classes.ThdParamSet where + +-- inspired with: https://wiki.haskell.org/Scoped_type_variables +import GHC.Base (asTypeOf) +import DobutokO.Sound.Effects.Bend +import DobutokO.Sound.Effects.Biquad +import DobutokO.Sound.Effects.Chorus +import DobutokO.Sound.Effects.Dither +import DobutokO.Sound.Effects.Echo +import DobutokO.Sound.Effects.Fade +import DobutokO.Sound.Effects.Gain +import DobutokO.Sound.Effects.LADSPA +import DobutokO.Sound.Effects.MCompand +import DobutokO.Sound.Effects.Phaser +import DobutokO.Sound.Effects.Pitch +import DobutokO.Sound.Effects.Rate +import DobutokO.Sound.Effects.Reverb +import DobutokO.Sound.Effects.Silence +import DobutokO.Sound.Effects.Sinc +import DobutokO.Sound.Effects.Spectrogram +import DobutokO.Sound.Effects.Stretch +import DobutokO.Sound.Effects.Tempo +import DobutokO.Sound.Effects.Vol +import DobutokO.Sound.One + +class ThdParamSet3 a b where + set33 :: a -> b -> b + +class ThdParamSetL3 a b where + set33L :: [a] -> b -> b + +class ThdParamSet3O a b where + set33o :: (One2 a) -> b -> b + +instance ThdParamSet3 a (BendTrio a b) where + set33 = bendTrioSet3 + +instance ThdParamSet3 c (Bend a b c) where + set33 = bendSet3 + +instance ThdParamSet3 a (Coeffs a) where + set33 = coeffsSet3 + +instance ThdParamSet3 a (ChorusTail a b) where + set33 = chorusTailSet1 3 + +instance ThdParamSetL3 b (Chorus a b) where + set33L = chorusSet2 + +instance ThdParamSet3 c (Dither a b c) where + set33 = ditherSet3 + +instance ThdParamSetL3 b (Echo a b) where + set33L = echoSet2 + +instance ThdParamSetL3 b (Echos a b) where + set33L = echosSet2 + +instance ThdParamSet3 String Fade where + set33 = fadeSet2E 3 + +instance ThdParamSet3 c (Gain1 a b c d) where + set33 = gainSet3 + +instance (Show c) => ThdParamSet3 c (Ladspa1 a b c) where + set33 = ladspaSet3 + +instance ThdParamSet3 c (Compand a b c d) where + set33 = compandSet3 + +instance ThdParamSet3 a (Phaser a b) where + set33 = phaserSet1 3 + +instance ThdParamSet3 c (Pitch a b c) where + set33 = pitchSet3 + +instance ThdParamSet3 b2 (RateH a b1 b2 b3 b4 b5 c) where + set33 = rateHSet22 + +instance ThdParamSetL3 c (Reverb a b c d) where + set33L = reverbSet3 + +instance ThdParamSet3 Float ReverbE where + set33 = reverbSet3E 3 + +instance ThdParamSet3 c (AboveTSpec1 a b c) where + set33 = aboveTSpecSet3a + +instance ThdParamSet3 c (BelowTSpec1 a b c) where + set33 = belowTSpecSet3b + +instance ThdParamSet3 c (Silence a b c) where + set33 = silenceSet3 + +instance ThdParamSet3O c (Sinc a b c d) where + set33o = sincSet3 + +instance ThdParamSetL3 c (Spectrogram3 a b c d e) where + set33L = spectrogramSet33 + +instance ThdParamSet3 a (StretchP a) where + set33 = stretchSet3 + +instance ThdParamSet3 c (Tempo a b c d) where + set33 = tempoSet3 + +instance ThdParamSet3 Float Vol where + set33 = volSet3 diff --git a/DobutokO/Sound/Effects/Contrast.hs b/DobutokO/Sound/Effects/Contrast.hs new file mode 100644 index 0000000..0bf1824 --- /dev/null +++ b/DobutokO/Sound/Effects/Contrast.hs @@ -0,0 +1,58 @@ +-- | +-- Module : DobutokO.Sound.Effects.Contrast +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"contrast\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Contrast 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 DobutokO.Sound.ToRange +import Numeric (showFFloat) + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data Contrast a = E | Ct a deriving Eq + +instance Show (Contrast Float) where + show E = "contrast 75" + show (Ct x) = mconcat ["contrast ", showFFloat Nothing (toRange 100.0 . abs $ x) " "] + +type Cntrst = Contrast Float + +contrastC :: Contrast a -> String +contrastC E = "E" +contrastC _ = "Ct" + +contrast1 :: Contrast a -> Maybe a +contrast1 (Ct x) = Just x +contrast1 _ = Nothing + +contrastE1 :: Cntrst -> Float +contrastE1 (Ct x) = x +contrastE1 E = 75.0 + +contrastSet1 :: a -> Contrast a -> Contrast a +contrastSet1 x _ = Ct x + +showCtQ :: Cntrst -> [String] +showCtQ = words . show diff --git a/DobutokO/Sound/Effects/DCShift.hs b/DobutokO/Sound/Effects/DCShift.hs new file mode 100644 index 0000000..0a3e3b3 --- /dev/null +++ b/DobutokO/Sound/Effects/DCShift.hs @@ -0,0 +1,63 @@ +-- | +-- Module : DobutokO.Sound.Effects.DCShift +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"dcshift\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.DCShift 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 DobutokO.Sound.ToRange +import Numeric (showFFloat) + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data DCShift a b = DC1 a | DC2 a b deriving Eq + +instance Show (DCShift Float Float) where + show (DC1 x) = mconcat ["dcshift ", showFFloat Nothing (toRange 2.0 x) " "] + show (DC2 x y) = mconcat ["dcshift ", showFFloat Nothing (toRange 2.0 x) " ", showFFloat Nothing (toRange 0.1 (abs y)) " "] + +type DCSh = DCShift Float Float + +dcShiftC :: DCShift a b -> String +dcShiftC (DC1 _) = "DC1" +dcShiftC _ = "DC2" + +dcShift1 :: DCShift a b -> a +dcShift1 (DC1 x) = x +dcShift1 (DC2 x _) = x + +dcShift2 :: DCShift a b -> Maybe b +dcShift2 (DC2 _ y) = Just y +dcShift2 _ = Nothing + +dcShiftSet1 :: a -> DCShift a b -> DCShift a b +dcShiftSet1 x (DC1 _) = DC1 x +dcShiftSet1 x (DC2 _ y) = DC2 x y + +dcShiftSet2 :: b -> DCShift a b -> DCShift a b +dcShiftSet2 y (DC1 x) = DC2 x y +dcShiftSet2 y (DC2 x _) = DC2 x y + +showDCQ :: DCSh -> [String] +showDCQ = words . show diff --git a/DobutokO/Sound/Effects/Delay.hs b/DobutokO/Sound/Effects/Delay.hs new file mode 100644 index 0000000..2b12522 --- /dev/null +++ b/DobutokO/Sound/Effects/Delay.hs @@ -0,0 +1,36 @@ +-- | +-- Module : DobutokO.Sound.Effects.Delay +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"delay\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances #-} + +module DobutokO.Sound.Effects.Delay where + +import Data.List (intersperse) +import DobutokO.Sound.Effects.Timespec + +data Delay a = D [a] deriving Eq + +instance Show (Delay TSpecification) where + show (D xs) + | null xs = [] + | otherwise = mconcat ["delay ",mconcat . intersperse " " . map show $ xs] + +type Dlay = Delay TSpecification + +delay1 :: Dlay -> [TSpecification] +delay1 (D xs) = xs + +delaySet1 :: [TSpecification] -> Dlay +delaySet1 = D + +showDlQ :: Dlay -> [String] +showDlQ = words . show diff --git a/DobutokO/Sound/Effects/Dither.hs b/DobutokO/Sound/Effects/Dither.hs new file mode 100644 index 0000000..4c4f22a --- /dev/null +++ b/DobutokO/Sound/Effects/Dither.hs @@ -0,0 +1,176 @@ +-- | +-- Module : DobutokO.Sound.Effects.Dither +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"dither\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Dither 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 + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data NoiseType = Lipshitz | FWeighted | ModifiedEWeighted | ImprovedEWeighted | Gesemann | Shibata | LowShibata | HighShibata + deriving Eq + +instance Show NoiseType where + show Lipshitz = "lipshitz " + show FWeighted = "f-weighted " + show ModifiedEWeighted = "modified-e-weighted " + show ImprovedEWeighted = "improved-e-weighted " + show Gesemann = "gesemann " + show Shibata = "shibata " + show LowShibata = "low-shibata " + show HighShibata = "high-shibata " + +data Filter a = N | Ss | S | F a deriving Eq + +instance Show (Filter NoiseType) where + show N = "" + show S = "-S " + show (F x) = mconcat ["-f ", show x] + show _ = "-s " + +type FilterN = Filter NoiseType + +filterC :: Filter a -> String +filterC N = "N" +filterC S = "S" +filterC Ss = "Ss" +filterC _ = "F" + +filter1 :: Filter a -> Maybe a +filter1 (F x) = Just x +filter1 _ = Nothing + +filterN1 :: FilterN -> Maybe NoiseType +filterN1 (F x) = Just x +filterN1 Ss = Just Shibata +filterN1 _ = Nothing + +filterSet1 :: a -> Filter a +filterSet1 = F + +data AutoD = A | N0 deriving Eq + +instance Show AutoD where + show A = "-a " + show _ = "" + +autoDC :: AutoD -> String +autoDC A = "A" +autoDC _ ="N0" + +data PrecisionD a = P a | N2 deriving Eq + +instance Show (PrecisionD Float) where + show N2 = "" + show (P x) = mconcat ["-p ", showFFloat Nothing (if compare (toRange 24.0 . abs $ x) 1.0 == LT then 1.0 else (toRange 24.0 . abs $ x)) " "] + +type Precision = PrecisionD Float + +precisionDC :: PrecisionD a -> String +precisionDC (P _) = "P" +precisionDC _ = "N2" + +precisionD1 :: PrecisionD a -> Maybe a +precisionD1 (P x) = Just x +precisionD1 _ = Nothing + +precisionSet1 :: Float -> Precision +precisionSet1 x = if compare (toRange 24.0 . abs $ x) 1.0 == LT then P 1.0 else P (toRange 24.0 . abs $ x) + +data Dither a b c = DT0 | DT100 a | DT010 b | DT001 c | DT011 b c | DT110 a b | DT101 a c | DT a b c deriving Eq + +instance Show (Dither FilterN AutoD Precision) where + show DT0 = "dither " + show (DT100 x) = mconcat ["dither ", show x] + show (DT010 y) = mconcat ["dither ", show y] + show (DT001 z) = mconcat ["dither ", show z] + show (DT011 y z) = mconcat ["dither ", show y, show z] + show (DT110 x y) = mconcat ["dither ", show x, show y] + show (DT101 x z) = mconcat ["dither ", show x, show z] + show (DT x y z) = mconcat ["dither ", show x, show y, show z] + +type Dith = Dither FilterN AutoD Precision + +ditherC :: Dither a b c -> String +ditherC DT0 = "DT0" +ditherC (DT100 _) = "DT100" +ditherC (DT010 _) = "DT010" +ditherC (DT001 _) = "DT001" +ditherC (DT011 _ _) = "DT011" +ditherC (DT110 _ _) = "DT110" +ditherC (DT101 _ _) = "DT101" +ditherC _ = "DT" + +dither1 :: Dither a b c -> Maybe a +dither1 (DT100 x) = Just x +dither1 (DT101 x _) = Just x +dither1 (DT110 x _) = Just x +dither1 (DT x _ _) = Just x +dither1 _ = Nothing + +dither2 :: Dither a b c -> Maybe b +dither2 (DT010 y) = Just y +dither2 (DT011 y _) = Just y +dither2 (DT110 _ y) = Just y +dither2 (DT _ y _) = Just y +dither2 _ = Nothing + +dither3 :: Dither a b c -> Maybe c +dither3 (DT001 z) = Just z +dither3 (DT101 _ z) = Just z +dither3 (DT011 _ z) = Just z +dither3 (DT _ _ z) = Just z +dither3 _ = Nothing + +ditherSet1 :: a -> Dither a b c -> Dither a b c +ditherSet1 x (DT010 y) = DT110 x y +ditherSet1 x (DT001 z) = DT101 x z +ditherSet1 x (DT011 y z) = DT x y z +ditherSet1 x (DT110 _ y) = DT110 x y +ditherSet1 x (DT101 _ z) = DT101 x z +ditherSet1 x (DT _ y z) = DT x y z +ditherSet1 x _ = DT100 x + +ditherSet2 :: b -> Dither a b c -> Dither a b c +ditherSet2 y (DT100 x) = DT110 x y +ditherSet2 y (DT001 z) = DT011 y z +ditherSet2 y (DT011 _ z) = DT011 y z +ditherSet2 y (DT110 x _) = DT110 x y +ditherSet2 y (DT101 x z) = DT x y z +ditherSet2 y (DT x _ z) = DT x y z +ditherSet2 y _ = DT010 y + +ditherSet3 :: c -> Dither a b c -> Dither a b c +ditherSet3 z (DT100 x) = DT101 x z +ditherSet3 z (DT010 y) = DT011 y z +ditherSet3 z (DT011 y _) = DT011 y z +ditherSet3 z (DT101 x _) = DT101 x z +ditherSet3 z (DT110 x y) = DT x y z +ditherSet3 z (DT x y _) = DT x y z +ditherSet3 z _ = DT001 z + +showDQ :: Dith -> [String] +showDQ = words . show diff --git a/DobutokO/Sound/Effects/Downsample.hs b/DobutokO/Sound/Effects/Downsample.hs new file mode 100644 index 0000000..640cb82 --- /dev/null +++ b/DobutokO/Sound/Effects/Downsample.hs @@ -0,0 +1,55 @@ +-- | +-- Module : DobutokO.Sound.Effects.Downsample +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"downsample\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Downsample 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 + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data Downsample a = D | DS1 a deriving Eq + +instance Show (Downsample Int) where + show (DS1 x) = mconcat ["downsample ", if compare (abs x) 2 == LT then "2 " else show (abs x) ++ " "] + show _ = "downsample 2 " + +type DSample = Downsample Int + +downsampleC :: Downsample a -> String +downsampleC D = "D" +downsampleC _ = "DS1" + +downSample1 :: Downsample a -> Maybe a +downSample1 (DS1 x) = Just x +downSample1 _ = Nothing + +downSampleE1 :: DSample -> Int +downSampleE1 (DS1 x) = x +downSampleE1 _ = 2 + +downSampleSet1 :: a -> Downsample a +downSampleSet1 = DS1 + +showDSQ :: DSample -> [String] +showDSQ = words . show diff --git a/DobutokO/Sound/Effects/Echo.hs b/DobutokO/Sound/Effects/Echo.hs new file mode 100644 index 0000000..2c22117 --- /dev/null +++ b/DobutokO/Sound/Effects/Echo.hs @@ -0,0 +1,111 @@ +-- | +-- Module : DobutokO.Sound.Effects.Echo +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"echo\" or \"echos\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Echo 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) + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data EchoTail a = ET a a deriving Eq + +instance Show (EchoTail Float) where + show (ET delay decay) = mconcat [showFFloat Nothing (abs delay) " ", showFFloat Nothing (abs decay) " "] + +type EchoTail1 = EchoTail Float + +data Echo a b = E1 a a [b] deriving Eq + +instance Show (Echo Float EchoTail1) where + show (E1 gin gout ys) + | null ys = "" + | otherwise = mconcat ["echo ", showFFloat Nothing (abs gin) " ", showFFloat Nothing (abs gout) " ", mconcat . intersperse " " . map show $ ys] + +type Echo1 = Echo Float EchoTail1 + +echoTail1 :: Int -> EchoTail a -> a +echoTail1 n (ET x0 x1) + | n == 1 = x0 + | n == 2 = x1 + | otherwise = error "DobutokO.Sound.Effects.Echo.echoTail1: Not defined parameter. " + +echoTailSet1 :: Int -> a -> EchoTail a -> EchoTail a +echoTailSet1 n x (ET x0 x1) + | n == 1 = ET x x1 + | n == 2 = ET x0 x + | otherwise = error "DobutokO.Sound.Effects.Echo.echoTailSet1: Not defined parameter. " + +echo1 :: Int -> Echo a b -> a +echo1 n (E1 x0 x1 _) + | n == 1 = x0 + | n == 2 = x1 + | otherwise = error "DobutokO.Sound.Effects.Echo.echo1: Not defined parameter. " + +echo2 :: Echo a b -> [b] +echo2 (E1 _ _ ys) = ys + +echoSet1 :: Int -> a -> Echo a b -> Echo a b +echoSet1 n x (E1 x0 x1 y) + | n == 1 = E1 x x1 y + | n == 2 = E1 x0 x y + | otherwise = error "DobutokO.Sound.Effects.Echo.echoSet1: Not defined parameter. " + +echoSet2 :: [b] -> Echo a b -> Echo a b +echoSet2 ys (E1 x0 x1 _) = E1 x0 x1 ys + +showEchQ :: Echo1 -> [String] +showEchQ = words . show + +data Echos a b = ES a a [b] deriving Eq + +instance Show (Echos Float EchoTail1) where + show (ES gin gout ys) + | null ys = "" + | otherwise = mconcat ["echos ", showFFloat Nothing (abs gin) " ", showFFloat Nothing (abs gout) " ", mconcat . intersperse " " . map show $ ys] + +type Echos1 = Echos Float EchoTail1 + +echos1 :: Int -> Echos a b -> a +echos1 n (ES x0 x1 _) + | n == 1 = x0 + | n == 2 = x1 + | otherwise = error "DobutokO.Sound.Effects.Echo.echos1: Not defined parameter. " + +echos2 :: Echos a b -> [b] +echos2 (ES _ _ ys) = ys + +echosSet1 :: Int -> a -> Echos a b -> Echos a b +echosSet1 n x (ES x0 x1 y) + | n == 1 = ES x x1 y + | n == 2 = ES x0 x y + | otherwise = error "DobutokO.Sound.Effects.Echo.echosSet1: Not defined parameter. " + +echosSet2 :: [b] -> Echos a b -> Echos a b +echosSet2 ys (ES x0 x1 _) = ES x0 x1 ys + +showEchsQ :: Echos1 -> [String] +showEchsQ = words . show diff --git a/DobutokO/Sound/Effects/FIR.hs b/DobutokO/Sound/Effects/FIR.hs new file mode 100644 index 0000000..2227da1 --- /dev/null +++ b/DobutokO/Sound/Effects/FIR.hs @@ -0,0 +1,62 @@ +-- | +-- Module : DobutokO.Sound.Effects.FIR +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"fir\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.FIR 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) + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data Fir a b = CF a | Cs [b] | EF deriving Eq + +instance Show (Fir FilePath Float) where + show (CF file) = mconcat ["fir ", file, " "] + show (Cs xs) = mconcat ["fir ", mconcat . intersperse " " . map (\x -> showFFloat Nothing x " ") $ xs] + show _ = "" -- the shell command will expect input from stdin. If it is not prepared, planned and available, do not use at all. + +type FIR = Fir FilePath Float + +firC :: Fir a b -> String +firC (CF _) = "CF" +firC (Cs _) = "Cs" +firC _ ="EF" + +fir1 :: Fir a b -> Maybe a +fir1 (CF x) = Just x +fir1 _ = Nothing + +fir2 :: Fir a b -> Maybe [b] +fir2 (Cs xs) = Just xs +fir2 _ = Nothing + +firSet1 :: a -> Fir a b +firSet1 = CF + +firSet2 :: [b] -> Fir a b +firSet2 = Cs + +showFIRQ :: FIR -> [String] +showFIRQ = words . show diff --git a/DobutokO/Sound/Effects/Fade.hs b/DobutokO/Sound/Effects/Fade.hs new file mode 100644 index 0000000..ad9d66e --- /dev/null +++ b/DobutokO/Sound/Effects/Fade.hs @@ -0,0 +1,77 @@ +-- | +-- Module : DobutokO.Sound.Effects.Fade +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"fade\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Fade 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 Data.List (intersperse) + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data FadeType = Q | HFt | TFt | L | P deriving Eq + +instance Show FadeType where + show Q = "q" + show HFt = "h" + show TFt = "t" + show L = "l" + show P = "p" + +data Fade2 a b = Fd a [b] deriving Eq + +instance Show (Fade2 FadeType String) where + show (Fd fdtype xss) + | null xss = [] + | otherwise = mconcat ["fade ", show fdtype, " ", mconcat . intersperse " " . take 3 $ xss] + +fade1 :: Fade2 a b -> a +fade1 (Fd y _) = y + +fade2 :: Fade2 a b -> [b] +fade2 (Fd _ xs) = take 3 xs + +fadeSet1 :: a -> Fade2 a b -> Fade2 a b +fadeSet1 x (Fd _ ys) = Fd x ys + +fadeSet2 :: [b] -> Fade2 a b -> Fade2 a b +fadeSet2 ys (Fd x _) = Fd x (take 3 ys) + +type Fade = Fade2 FadeType String + +fade2E :: Int -> Fade -> String +fade2E n (Fd _ xss) + | n == 1 = if null xss then " " else head xss + | n == 2 = if null . drop 1 $ xss then " " else xss !! 1 + | n == 3 = if null . drop 2 $ xss then " " else xss !! 2 + | otherwise = error "DobutokO.Sound.Effects.Fade.fade2E: The first argument is out of possible range [1..3]. " + +fadeSet2E :: Int -> String -> Fade -> Fade +fadeSet2E n x (Fd y xss) + | compare n 0 == GT && compare n 4 == LT && compare (length xss) n /= LT = Fd y (mconcat [take (n - 1) xss,[x],drop n xss]) + | otherwise = error "DobutokO.Sound.Effects.Fade.fadeSet2E: The first argument is out of possible defined ranges. " + +showQFade :: Fade -> [String] +showQFade = words . show + diff --git a/DobutokO/Sound/Effects/Flanger.hs b/DobutokO/Sound/Effects/Flanger.hs new file mode 100644 index 0000000..cc8c7f3 --- /dev/null +++ b/DobutokO/Sound/Effects/Flanger.hs @@ -0,0 +1,99 @@ +-- | +-- Module : DobutokO.Sound.Effects.Flanger +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"flanger\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Flanger 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.One + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data ShapeInterp = S | T | L | Q deriving Eq + +instance Show ShapeInterp where + show S = "s " + show T = "t " + show L = "l " + show Q = "q " + +data Flanger a b = FL [a] b deriving Eq + +defaultList :: [Float] +defaultList = [0.0, 2.0, 0.0, 71.0, 0.5, 25.0] + +flElem1 :: Int -> Float -> Float +flElem1 n x + | n == 1 = if x == 0.0 then 0.0 else toRange 30.0 (abs x) + | n == 2 = if x == 0.0 then 0.0 else toRange 10.0 (abs x) + | n == 3 = if x == 0.0 then 0.0 else toRange 95.0 x + | n == 4 = if x == 0.0 then 0.0 else toRange 100.0 (abs x) + | n == 5 = if compare (toRange 10.0 . abs $ x) 0.1 == LT then 0.1 else toRange 10.0 (abs x) + | n == 6 = if x == 0.0 then 0.0 else toRange 100.0 (abs x) + | otherwise = error "DobutokO.Sound.Effects.Flanger.flElem1: the Int parameter must be in the range [1..6]. " + +listFlanger1 :: [Float] -> [Float] +listFlanger1 xs + | compare (length xs) 6 == GT = map (\i -> flElem1 i (xs !! (i - 1))) [1..6] + | otherwise = mconcat [map (\i -> flElem1 i (xs !! (i - 1))) [1..length xs], drop (length xs) defaultList] + +listFlanger15 :: [Float] -> [Float] +listFlanger15 xs = take 5 . listFlanger1 $ xs + +listFlanger16 :: [Float] -> Float +listFlanger16 xs = (listFlanger1 xs) !! 5 + +instance Show (Flanger Float (One2 ShapeInterp)) where + show (FL xs (O21 T)) = mconcat ["flanger ", mconcat . map (\t -> showFFloat Nothing t " ") . listFlanger15 $ xs, show T, showFFloat Nothing (listFlanger16 xs) " "] + show (FL xs (O21 y)) = mconcat ["flanger ", mconcat . map (\t -> showFFloat Nothing t " ") . listFlanger15 $ xs, show S, showFFloat Nothing (listFlanger16 xs) " ", + if y == S then "" else show y] + show (FL xs (O22 L x)) = show (FL xs (O21 x)) + show (FL xs (O22 S x)) = show (FL xs (O21 x)) + show (FL xs (O22 x L)) = show (FL xs (O21 x)) + show (FL xs (O22 x S)) = show (FL xs (O21 x)) + show (FL xs ~(O22 x y)) + | x == y = show (FL xs (O21 x)) + | otherwise = mconcat ["flanger ", mconcat . map (\t -> showFFloat Nothing t " ") . listFlanger15 $ xs, show T, showFFloat Nothing (listFlanger16 xs) " ", + show Q] + +type Flanger2 = Flanger Float (One2 ShapeInterp) + +flanger1 :: Flanger a b -> [a] +flanger1 (FL xs _) = xs + +flanger2 :: Flanger a b -> b +flanger2 (FL _ y) = y + +flanger1E :: Flanger2 -> [Float] +flanger1E (FL xs _) = listFlanger1 xs + +flangerSet1 :: [a] -> Flanger a b -> Flanger a b +flangerSet1 xs (FL _ y) = FL xs y + +flangerSet2 :: b -> Flanger a b -> Flanger a b +flangerSet2 y (FL xs _) = FL xs y + +showFLQ :: Flanger2 -> [String] +showFLQ = words . show diff --git a/DobutokO/Sound/Effects/Gain.hs b/DobutokO/Sound/Effects/Gain.hs new file mode 100644 index 0000000..ad1cb16 --- /dev/null +++ b/DobutokO/Sound/Effects/Gain.hs @@ -0,0 +1,92 @@ +-- | +-- Module : DobutokO.Sound.Effects.Gain +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"gain\" and \"norm\" effects. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Gain 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 FirstO = N1 | E | B | Bc | R deriving Eq + +instance Show FirstO where + show E = "-e " + show B = "-B " + show Bc = "-b " + show R = "-r " + show _ = "" + +data SecondO = N2 | E0 deriving Eq + +instance Show SecondO where + show N2 = "-n " + show _ = "" + +data ThirdO = L | H | N3 deriving Eq + +instance Show ThirdO where + show L = "-l " + show H = "-h " + show _ = "" + +data Gain1 a b c d = G a b c d deriving Eq + +instance Show (Gain1 FirstO SecondO ThirdO Float) where + show (G x y z t) = mconcat ["gain ", show x, show y, show z, showFFloat Nothing t " "] + +type Gain = Gain1 FirstO SecondO ThirdO Float + +gain1 :: Gain1 a b c d -> a +gain1 (G x _ _ _) = x + +gain2 :: Gain1 a b c d -> b +gain2 (G _ y _ _) = y + +gain3 :: Gain1 a b c d -> c +gain3 (G _ _ z _) = z + +gain4 :: Gain1 a b c d -> d +gain4 (G _ _ _ t) = t + +gainSet1 :: a -> Gain1 a b c d -> Gain1 a b c d +gainSet1 x (G _ y z t) = G x y z t + +gainSet2 :: b -> Gain1 a b c d -> Gain1 a b c d +gainSet2 y (G x _ z t) = G x y z t + +gainSet3 :: c -> Gain1 a b c d -> Gain1 a b c d +gainSet3 z (G x y _ t) = G x y z t + +gainSet4 :: d -> Gain1 a b c d -> Gain1 a b c d +gainSet4 t (G x y z _) = G x y z t + +showGQ :: Gain -> [String] +showGQ = words . show + +data Norm = Norm | N4 deriving Eq + +instance Show Norm where + show Norm = "norm " + show _ = "" diff --git a/DobutokO/Sound/Effects/Hilbert.hs b/DobutokO/Sound/Effects/Hilbert.hs new file mode 100644 index 0000000..a3a7afa --- /dev/null +++ b/DobutokO/Sound/Effects/Hilbert.hs @@ -0,0 +1,53 @@ +-- | +-- Module : DobutokO.Sound.Effects.Hilbert +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"hilbert\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Hilbert 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 + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data Hilbert a = H | HI a deriving Eq + +instance Show (Hilbert Int) where + show (HI n) + | compare n 2 == GT && compare n 32768 == LT = mconcat ["hilbert -n ",show n] + | otherwise = "" + show _ = "hilbert " + +type Hlbrt = Hilbert Int + +hilbertC :: Hilbert a -> String +hilbertC H = "H" +hilbertC _ = "HI" + +hilbert1 :: Hilbert a -> Maybe a +hilbert1 (HI x) = Just x +hilbert1 _ = Nothing + +hilbertSet1 :: a -> Hilbert a +hilbertSet1 = HI + +showHIQ :: Hlbrt -> [String] +showHIQ = words . show diff --git a/DobutokO/Sound/Effects/LADSPA.hs b/DobutokO/Sound/Effects/LADSPA.hs new file mode 100644 index 0000000..41d22d3 --- /dev/null +++ b/DobutokO/Sound/Effects/LADSPA.hs @@ -0,0 +1,96 @@ +-- | +-- Module : DobutokO.Sound.Effects.LADSPA +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"ladspa\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.LADSPA 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 DobutokO.Sound.One + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data LADSPAS1 = L | R | N0 deriving Eq + +instance Show LADSPAS1 where + show L = "-l " + show R = "-r " + show _ = "" + +data Ladspa1 a b c = LPA2 a b | LPA3 a b b | LP3 a b c | LP4 a b b c deriving Eq + +instance (Show c) => Show (Ladspa1 LADSPAS1 String c) where + show (LPA2 x ys) = mconcat ["ladspa ", show x, ys, " "] + show (LPA3 x ys zs) = mconcat ["ladspa ", show x, ys, " ", zs, " "] + show (LP3 x ys z) = mconcat ["ladspa ", show x, ys, " ", show z, " "] + show (LP4 x ys zs t) = mconcat ["ladspa ", show x, ys, " ", zs, " ", show t, " "] + +type Ladspa c = Ladspa1 LADSPAS1 String c + +ladspaC :: Ladspa1 a b c -> String +ladspaC (LPA2 _ _) = "LPA2" +ladspaC (LPA3 _ _ _) = "LPA3" +ladspaC (LP3 _ _ _) = "LP3" +ladspaC (LP4 _ _ _ _) = "LP4" + +ladspa1 :: Ladspa1 a b c -> a +ladspa1 (LPA2 x _) = x +ladspa1 (LPA3 x _ _) = x +ladspa1 (LP3 x _ _) = x +ladspa1 (LP4 x _ _ _) = x + +ladspa2 :: Ladspa1 a b c -> One2 b +ladspa2 (LPA2 _ y) = O21 y +ladspa2 (LPA3 _ y z) = O22 y z +ladspa2 (LP3 _ y _) = O21 y +ladspa2 (LP4 _ y1 y2 _) = O22 y1 y2 + +ladspa3 :: Ladspa1 a b c -> Maybe c +ladspa3 (LP3 _ _ z) = Just z +ladspa3 (LP4 _ _ _ z) = Just z +ladspa3 _ = Nothing + +ladspaSet1 :: a -> Ladspa1 a b c -> Ladspa1 a b c +ladspaSet1 x (LPA2 _ y) = LPA2 x y +ladspaSet1 x (LPA3 _ y1 y2) = LPA3 x y1 y2 +ladspaSet1 x (LP3 _ y z) = LP3 x y z +ladspaSet1 x (LP4 _ y1 y2 z) = LP4 x y1 y2 z + +ladspaSet2 :: One2 b -> Ladspa1 a b c -> Ladspa1 a b c +ladspaSet2 (O21 y) (LPA2 x _) = LPA2 x y +ladspaSet2 (O21 y) (LPA3 x _ y2) = LPA3 x y y2 +ladspaSet2 (O21 y) (LP3 x _ z) = LP3 x y z +ladspaSet2 (O21 y) (LP4 x _ y2 z) = LP4 x y y2 z +ladspaSet2 (O22 y1 y2) (LPA2 x _) = LPA3 x y1 y2 +ladspaSet2 (O22 y1 y2) (LPA3 x _ _) = LPA3 x y1 y2 +ladspaSet2 (O22 y1 y2) (LP3 x _ z) = LP4 x y1 y2 z +ladspaSet2 (O22 y1 y2) (LP4 x _ _ z) = LP4 x y1 y2 z + +ladspaSet3 :: (Show c) => c -> Ladspa1 a b c -> Ladspa1 a b c +ladspaSet3 z (LPA2 x y) = LP3 x y z +ladspaSet3 z (LPA3 x y1 y2) = LP4 x y1 y2 z +ladspaSet3 z (LP3 x y _) = LP3 x y z +ladspaSet3 z (LP4 x y1 y2 _) = LP4 x y1 y2 z + +showLPQ :: (Show c) => Ladspa c -> [String] +showLPQ = words . show diff --git a/DobutokO/Sound/Effects/Loudness.hs b/DobutokO/Sound/Effects/Loudness.hs new file mode 100644 index 0000000..cc8a1c8 --- /dev/null +++ b/DobutokO/Sound/Effects/Loudness.hs @@ -0,0 +1,71 @@ +-- | +-- Module : DobutokO.Sound.Effects.Loudness +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"loudness\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Loudness 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 Loudness a = L | L1 a | L2 a a deriving Eq + +instance Show (Loudness Float) where + show (L1 x) + | compare x (-50.0) /= LT && compare x 15.0 /= GT = mconcat ["loudness ", showFFloat Nothing x " "] + | otherwise = "" + show (L2 x y) + | compare x (-50.0) /= LT && compare x 15.0 /= GT && compare y 50.0 /= LT && compare y 75.0 /= GT = mconcat ["loudness ", showFFloat Nothing x " ", + showFFloat Nothing y " "] + | otherwise = "" + show _ = "loudness " + +type Ldness = Loudness Float + +loudnessC :: Loudness a -> String +loudnessC L = "L" +loudnessC (L1 _) = "L1" +loudnessC _ = "L2" + +loudness1 :: Loudness a -> Maybe a +loudness1 (L1 x) = Just x +loudness1 (L2 x _) = Just x +loudness1 _ = Nothing + +loudness2 :: Loudness a -> Maybe a +loudness2 (L2 _ y) = Just y +loudness2 _ = Nothing + +loudnessSet1 :: a -> Loudness a -> Loudness a +loudnessSet1 x (L2 _ y) = L2 x y +loudnessSet1 x _ = L1 x + +loudnessSet2 :: a -> Loudness a -> Loudness a +loudnessSet2 y (L2 x _) = L2 x y +loudnessSet2 y (L1 x) = L2 x y +loudnessSet2 _ _ = L + +showLdQ :: Ldness -> [String] +showLdQ = words . show diff --git a/DobutokO/Sound/Effects/MCompand.hs b/DobutokO/Sound/Effects/MCompand.hs new file mode 100644 index 0000000..1fa4471 --- /dev/null +++ b/DobutokO/Sound/Effects/MCompand.hs @@ -0,0 +1,307 @@ +-- | +-- Module : DobutokO.Sound.Effects.MCompand +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"compand\" and \"mcompand\" effects. +-- + +{-# 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 diff --git a/DobutokO/Sound/Effects/Misc.hs b/DobutokO/Sound/Effects/Misc.hs new file mode 100644 index 0000000..c160b92 --- /dev/null +++ b/DobutokO/Sound/Effects/Misc.hs @@ -0,0 +1,60 @@ +-- | +-- Module : DobutokO.Sound.Effects.Misc +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying some of the SoX effects (first of all those ones without any passible parameters) +-- and / or some of their combinations. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP #-} + +module DobutokO.Sound.Effects.Misc 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 Data.List (intersperse) + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data Misc = D | E | OO | RE | RI | S deriving Eq + +instance Show Misc where + show D = "deemph " + show E = "earwax " + show OO = "oops " + show RE = "reverse " + show RI = "riaa " + show S = "swap " + +data MscS a = Msc [a] deriving Eq + +instance (Show a) => Show (MscS a) where + show (Msc ys) + | null ys = [] + | otherwise = mconcat [mconcat . intersperse " " . map show $ ys, " "] + +type Mscs = MscS Misc + +mscS1 :: MscS a -> [a] +mscS1 (Msc xs) = xs + +mscSSet1 :: [a] -> MscS a +mscSSet1 = Msc + +showMscQ :: Show a => MscS a -> [String] +showMscQ = words . show diff --git a/DobutokO/Sound/Effects/Modulation2.hs b/DobutokO/Sound/Effects/Modulation2.hs new file mode 100644 index 0000000..03a65fd --- /dev/null +++ b/DobutokO/Sound/Effects/Modulation2.hs @@ -0,0 +1,21 @@ +-- | +-- Module : DobutokO.Sound.Effects.Modulation2 +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying some of the SoX effects. +-- + +{-# OPTIONS_GHC -threaded #-} + +module DobutokO.Sound.Effects.Modulation2 where + + +data Modulation = S | T deriving Eq + +instance Show Modulation where + show S = "-s " + show T = "-t " diff --git a/DobutokO/Sound/Effects/Noise.hs b/DobutokO/Sound/Effects/Noise.hs new file mode 100644 index 0000000..ebcfc15 --- /dev/null +++ b/DobutokO/Sound/Effects/Noise.hs @@ -0,0 +1,88 @@ +-- | +-- Module : DobutokO.Sound.Effects.Noise +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"noiseprof\" and \"noisered\" effects. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Noise 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 + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data Noiseprof a = N | NP a deriving Eq + +instance Show (Noiseprof FilePath) where + show (NP file) = mconcat ["noiseprof ",file, " "] + show _ = "noiseprof " + +type NoiseP = Noiseprof FilePath + +noiseprofC :: Noiseprof a -> String +noiseprofC N = "N" +noiseprofC _ = "NP" + +noiseprof1 :: Noiseprof a -> Maybe a +noiseprof1 (NP x) = Just x +noiseprof1 _ = Nothing + +noiseprofSet1 :: a -> Noiseprof a +noiseprofSet1 = NP + +showNPQ :: NoiseP -> [String] +showNPQ = words . show + +data Noisered a b = NR | NR1 a | NR2 a b deriving Eq + +instance Show (Noisered FilePath Float) where + show (NR2 file x) = mconcat ["noisered ",show file, " ", showFFloat Nothing (toRange 1.0 . abs $ x) " "] + show (NR1 file) = mconcat ["noisered ",show file, " "] + show _ = "noisered - " -- the shell command will expect input from stdin. If it is not prepared, planned and available, do not use at all. + +type NoiseR = Noisered FilePath Float + +noiseredC :: Noisered a b -> String +noiseredC (NR2 _ _) = "NR2" +noiseredC (NR1 _) = "NR1" +noiseredC _ = "NR" + +noisered1 :: Noisered a b -> Maybe a +noisered1 (NR2 x _) = Just x +noisered1 (NR1 x) = Just x +noisered1 _ = Nothing + +noisered2 :: Noisered a b -> Maybe b +noisered2 (NR2 _ y) = Just y +noisered2 _ = Nothing + +noiseredSet1 :: a -> Noisered a b -> Noisered a b +noiseredSet1 x (NR2 _ y) = NR2 x y +noiseredSet1 x _ = NR1 x + +noiseredSet2 :: b -> Noisered a b -> Maybe (Noisered a b) +noiseredSet2 y (NR2 x _) = Just (NR2 x y) +noiseredSet2 y (NR1 x) = Just (NR2 x y) +noiseredSet2 _ _ = Nothing + +showNRQ :: NoiseR -> [String] +showNRQ = words . show diff --git a/DobutokO/Sound/Effects/Overdrive.hs b/DobutokO/Sound/Effects/Overdrive.hs new file mode 100644 index 0000000..44148b2 --- /dev/null +++ b/DobutokO/Sound/Effects/Overdrive.hs @@ -0,0 +1,67 @@ +-- | +-- Module : DobutokO.Sound.Effects.Overdrive +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"overdrive\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Overdrive 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 + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data Overdrive a = OD | OD1 a | OD2 a a deriving Eq + +instance Show (Overdrive Float) where + show (OD1 x) = mconcat ["overdrive ", showFFloat Nothing (toRange 100.0 (abs x)) " "] + show (OD2 x y) = mconcat ["overdrive ", showFFloat Nothing (toRange 100.0 (abs x)) " ", showFFloat Nothing (toRange 100.0 (abs y)) " "] + show _ = "overdrive " + +type Ovdrive = Overdrive Float + +overdriveC :: Overdrive a -> String +overdriveC OD = "OD" +overdriveC (OD1 _) = "OD1" +overdriveC _ = "OD2" + +overdrive1 :: Overdrive a -> Maybe a +overdrive1 (OD1 x) = Just x +overdrive1 (OD2 x _) = Just x +overdrive1 _ = Nothing + +overdrive2 :: Overdrive a -> Maybe a +overdrive2 (OD2 _ y) = Just y +overdrive2 _ = Nothing + +overdriveSet1 :: a -> Overdrive a -> Overdrive a +overdriveSet1 x (OD2 _ y) = OD2 x y +overdriveSet1 x _ = OD1 x + +overdriveSet2 :: a -> Overdrive a -> Maybe (Overdrive a) +overdriveSet2 y (OD2 x _) = Just (OD2 x y) +overdriveSet2 y (OD1 x) = Just (OD2 x y) +overdriveSet2 _ _ = Nothing + +showODQ :: Ovdrive -> [String] +showODQ = words . show diff --git a/DobutokO/Sound/Effects/Pad.hs b/DobutokO/Sound/Effects/Pad.hs new file mode 100644 index 0000000..51f2ca1 --- /dev/null +++ b/DobutokO/Sound/Effects/Pad.hs @@ -0,0 +1,86 @@ +-- | +-- Module : DobutokO.Sound.Effects.Pad +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"pad\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances #-} + +module DobutokO.Sound.Effects.Pad where + +import DobutokO.Sound.Effects.Timespec +import DobutokO.Sound.One + +data PadSpec a = PS a a deriving Eq + +instance Show (PadSpec TSpecification) where + show (PS x y) = mconcat [show x,"@",show y," "] + +type PadS = PadSpec TSpecification + +padSpec1 :: PadSpec a -> a +padSpec1 (PS x _) = x + +padSpec2 :: PadSpec a -> a +padSpec2 (PS _ y) = y + +padSpecSet1 :: a -> PadSpec a -> PadSpec a +padSpecSet1 x (PS _ y) = PS x y + +padSpecSet2 :: a -> PadSpec a -> PadSpec a +padSpecSet2 y (PS x _) = PS x y + +showPSQ :: PadS -> [String] +showPSQ = words . show + +data Pad a b = PD1 [b] | PD2 a [b] | PD3 a a [b] deriving Eq + +instance Show (Pad TSpecification PadS) where + show (PD1 ys) + | null ys = "" + | otherwise = mconcat ["pad ", mconcat . map show $ ys] + show (PD2 x ys) + | null ys = mconcat ["pad ", show x] + | otherwise = mconcat ["pad ", show x, " ", mconcat . map show $ ys] + show (PD3 x z ys) + | null ys = mconcat ["pad ", show x, " ", show z, " "] + | otherwise = mconcat ["pad ", show x, " ", mconcat . map show $ ys, show z, " "] + +type Pad4 = Pad TSpecification PadS + +padC :: Pad a b -> String +padC (PD1 _) = "PD1" +padC (PD2 _ _) = "PD2" +padC (PD3 _ _ _) = "PD3" + +pad1 :: Pad a b -> [a] +pad1 (PD1 _) = [] +pad1 (PD2 x _) = [x] +pad1 (PD3 x y _) = [x,y] + +pad2 :: Pad a b -> [b] +pad2 (PD1 ys) = ys +pad2 (PD2 _ ys) = ys +pad2 (PD3 _ _ ys) = ys + +padSet1 :: One2 a -> Pad a b -> Pad a b +padSet1 (O21 x) (PD1 zs) = PD2 x zs +padSet1 (O22 x y) (PD1 zs) = PD3 x y zs +padSet1 (O21 x) (PD2 _ zs) = PD2 x zs +padSet1 (O22 x y) (PD2 _ zs) = PD3 x y zs +padSet1 (O21 x) (PD3 _ _ zs) = PD2 x zs +padSet1 (O22 x y) (PD3 _ _ zs) = PD3 x y zs + +padSet2 :: [b] -> Pad a b -> Pad a b +padSet2 zs (PD1 _) = PD1 zs +padSet2 zs (PD2 x _) = PD2 x zs +padSet2 zs (PD3 x y _) = PD3 x y zs + +showPaQ :: Pad4 -> [String] +showPaQ = words . show diff --git a/DobutokO/Sound/Effects/PassReject.hs b/DobutokO/Sound/Effects/PassReject.hs new file mode 100644 index 0000000..2cb6f33 --- /dev/null +++ b/DobutokO/Sound/Effects/PassReject.hs @@ -0,0 +1,235 @@ +-- | +-- Module : DobutokO.Sound.Effects.PassReject +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX effects with the needed specifications. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.PassReject 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.Effects.Specs +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data FreqWidth a b = Fr1 a | FrW2 a b deriving Eq + +instance Show (FreqWidth Freq1 Width1) where + show (Fr1 x) = show x + show (FrW2 x y) = mconcat [show x," ",show y] + +type FreqW2 = FreqWidth Freq1 Width1 + +freqWidthC :: FreqWidth a b -> String +freqWidthC (Fr1 _) = "Fr1" +freqWidthC (FrW2 _ _) = "FrW2" + +freqWidth1 :: FreqWidth a b -> a +freqWidth1 (Fr1 x) = x +freqWidth1 (FrW2 x _) = x + +freqWidth2 :: FreqWidth a b -> Maybe b +freqWidth2 (Fr1 _) = Nothing +freqWidth2 (FrW2 _ y) = Just y + +freqWidthSet1 :: a -> FreqWidth a b -> FreqWidth a b +freqWidthSet1 x (Fr1 _) = Fr1 x +freqWidthSet1 x (FrW2 _ y) = FrW2 x y + +freqWidthSet2 :: b -> FreqWidth a b -> FreqWidth a b +freqWidthSet2 y (Fr1 x) = FrW2 x y +freqWidthSet2 y (FrW2 x _) = FrW2 x y + +data Freq a = Fr a deriving Eq + +instance Show (Freq Freq1) where + show (Fr x) = show x + +type Freq11 = Freq Freq1 + +freqC :: Freq a -> String +freqC (Fr _) = "Fr" + +freq1 :: Freq a -> a +freq1 (Fr x) = x + +freqSet1 :: a -> Freq a -> Freq a +freqSet1 x (Fr _) = Fr x + +data AllPass a = AP a deriving Eq + +instance Show (AllPass FreqW2) where + show (AP x) = mconcat ["allpass ",show x] + +type Allpass = AllPass FreqW2 + +allPass1 :: AllPass a -> a +allPass1 (AP x) = x + +allPassSet1 :: a -> AllPass a -> AllPass a +allPassSet1 x (AP _) = AP x + +showApQ :: Allpass -> [String] +showApQ = words . show + +data BandReject a = BR a deriving Eq + +instance Show (BandReject FreqW2) where + show (BR x) = mconcat ["bandreject ",show x] + +type Bandreject = BandReject FreqW2 + +bandReject1 :: BandReject a -> a +bandReject1 (BR x) = x + +bandRejectSet1 :: a -> BandReject a -> BandReject a +bandRejectSet1 x (BR _) = BR x + +showBrQ :: Bandreject -> [String] +showBrQ = words . show + +data BandpassPar = C0 | C deriving Eq + +instance Show BandpassPar where + show C0 = "" + show C = "-c " + +data BandPass a b = BP a b deriving Eq + +instance Show (BandPass BandpassPar FreqW2) where + show (BP x y) = mconcat ["bandpass ",show x,show y] + +type Bandpass = BandPass BandpassPar FreqW2 + +bandPass1 :: BandPass a b -> a +bandPass1 (BP x _) = x + +bandPass2 :: BandPass a b -> b +bandPass2 (BP _ y) = y + +bandPassSet1 :: a -> BandPass a b -> BandPass a b +bandPassSet1 x (BP _ y) = BP x y + +bandPassSet2 :: b -> BandPass a b -> BandPass a b +bandPassSet2 y (BP x _) = BP x y + +showBpQ :: Bandpass -> [String] +showBpQ = words . show + +data BandPar = N0 | N deriving Eq + +instance Show BandPar where + show N0 = "" + show N = "-n " + +data Band a b = B a b deriving Eq + +instance Show (Band BandPar FreqW2) where + show (B x y) = mconcat ["band ",show x,show y] + +type Band2 = Band BandPar FreqW2 + +band1 :: Band a b -> a +band1 (B x _) = x + +band2 :: Band a b -> b +band2 (B _ y) = y + +bandSet1 :: a -> Band a b -> Band a b +bandSet1 x (B _ y) = B x y + +bandSet2 :: b -> Band a b -> Band a b +bandSet2 y (B x _) = B x y + +showB2Q :: Band2 -> [String] +showB2Q = words . show + +data HighLowPar = HL1 | HL2 deriving Eq + +instance Show HighLowPar where + show HL1 = "-1 " + show HL2 = "-2 " + +data HighPass a b = HP a b deriving Eq + +instance Show (HighPass HighLowPar FreqW2) where + show (HP x y) = mconcat ["highpass ",show x,show y] + +type HighPass2 = HighPass HighLowPar FreqW2 + +highPass1 :: HighPass a b -> a +highPass1 (HP x _) = x + +highPass2 :: HighPass a b -> b +highPass2 (HP _ y) = y + +highPassSet1 :: a -> HighPass a b -> HighPass a b +highPassSet1 x (HP _ y) = HP x y + +highPassSet2 :: b -> HighPass a b -> HighPass a b +highPassSet2 y (HP x _) = HP x y + +showHpQ :: HighPass2 -> [String] +showHpQ = words . show + +data LowPass a b = LP a b deriving Eq + +instance Show (LowPass HighLowPar FreqW2) where + show (LP x y) = mconcat ["lowpass ",show x,show y] + +type LowPass2 = LowPass HighLowPar FreqW2 + +lowPass1 :: LowPass a b -> a +lowPass1 (LP x _) = x + +lowPass2 :: LowPass a b -> b +lowPass2 (LP _ y) = y + +lowPassSet1 :: a -> LowPass a b -> LowPass a b +lowPassSet1 x (LP _ y) = LP x y + +lowPassSet2 :: b -> LowPass a b -> LowPass a b +lowPassSet2 y (LP x _) = LP x y + +showLpQ :: LowPass2 -> [String] +showLpQ = words . show + +data Equalizer a b = Eqlz a b deriving Eq + +instance Show (Equalizer FreqW2 Float) where + show (Eqlz x y) = mconcat ["equalizer ",show x," ",showFFloat Nothing y " "] + +type Equaliz = Equalizer FreqW2 Float + +equalizer1 :: Equalizer a b -> a +equalizer1 (Eqlz x _) = x + +equalizer2 :: Equalizer a b -> b +equalizer2 (Eqlz _ y) = y + +equalizerSet1 :: a -> Equalizer a b -> Equalizer a b +equalizerSet1 x (Eqlz _ y) = Eqlz x y + +equalizerSet2 :: b -> Equalizer a b -> Equalizer a b +equalizerSet2 y (Eqlz x _) = Eqlz x y + +showEqlQ :: Equaliz -> [String] +showEqlQ = words . show + diff --git a/DobutokO/Sound/Effects/Phaser.hs b/DobutokO/Sound/Effects/Phaser.hs new file mode 100644 index 0000000..d1b8ee5 --- /dev/null +++ b/DobutokO/Sound/Effects/Phaser.hs @@ -0,0 +1,67 @@ +-- | +-- Module : DobutokO.Sound.Effects.Phaser +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"phaser\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Phaser 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.Effects.Modulation2 + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data Phaser a b = Ph a a a a a b deriving Eq + +instance Show (Phaser Float Modulation) where + show (Ph gainin gainout delay decay speed mod1) = mconcat ["phaser ",showFFloat Nothing gainin " ",showFFloat Nothing gainout " ", showFFloat Nothing delay " ", + showFFloat Nothing decay " ", showFFloat Nothing speed " ", show mod1] + +type Phaser2 = Phaser Float Modulation + +phaser1 :: Int -> Phaser a b -> a +phaser1 n (Ph x0 x1 x2 x3 x4 _) + | n == 1 = x0 + | n == 2 = x1 + | n == 3 = x2 + | n == 4 = x3 + | n == 5 = x4 + | otherwise = error "DobutokO.Sound.Effects.Phaser.phaser1: Not defined parameter. " + +phaser2 :: Phaser a b -> b +phaser2 (Ph _ _ _ _ _ y) = y + +phaserSet1 :: Int -> a -> Phaser a b -> Phaser a b +phaserSet1 n x (Ph x0 x1 x2 x3 x4 y) + | n == 1 = Ph x x1 x2 x3 x4 y + | n == 2 = Ph x0 x x2 x3 x4 y + | n == 3 = Ph x0 x1 x x3 x4 y + | n == 4 = Ph x0 x1 x2 x x4 y + | n == 5 = Ph x0 x1 x2 x3 x y + | otherwise = error "DobutokO.Sound.Effects.Phaser.phaserSet1: Not defined parameter. " + +phaserSet2 :: b -> Phaser a b -> Phaser a b +phaserSet2 y (Ph x0 x1 x2 x3 x4 _) = Ph x0 x1 x2 x3 x4 y + +showPhQ :: Phaser2 -> [String] +showPhQ = words . show diff --git a/DobutokO/Sound/Effects/Pitch.hs b/DobutokO/Sound/Effects/Pitch.hs new file mode 100644 index 0000000..3a1a5cb --- /dev/null +++ b/DobutokO/Sound/Effects/Pitch.hs @@ -0,0 +1,58 @@ +-- | +-- Module : DobutokO.Sound.Effects.Pitch +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the \"pitch\" SoX effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances #-} + +module DobutokO.Sound.Effects.Pitch where + + +import Numeric (showFFloat) +import DobutokO.Sound.Effects.Segment + +data Pitch a b c = Pt2 a b | Pt3 a b c deriving Eq + +instance Show (Pitch Qdash Float Segm) where + show (Pt2 x y) = mconcat ["pitch ", show x,showFFloat Nothing y " "] + show (Pt3 x y z) = mconcat ["pitch ", show x, showFFloat Nothing y " ", show z] + +type Ptch = Pitch Qdash Float Segm + +pitchC :: Pitch a b c -> String +pitchC (Pt2 _ _) = "Pt2" +pitchC (Pt3 _ _ _) = "Pt3" + +pitch1 :: Pitch a b c -> a +pitch1 (Pt2 x _) = x +pitch1 (Pt3 x _ _) = x + +pitch2 :: Pitch a b c -> b +pitch2 (Pt2 _ y) = y +pitch2 (Pt3 _ y _) = y + +pitch3 :: Pitch a b c -> Maybe c +pitch3 (Pt3 _ _ z) = Just z +pitch3 _ = Nothing + +pitchSet1 :: a -> Pitch a b c -> Pitch a b c +pitchSet1 x (Pt2 _ y) = Pt2 x y +pitchSet1 x (Pt3 _ y z) = Pt3 x y z + +pitchSet2 :: b -> Pitch a b c -> Pitch a b c +pitchSet2 y (Pt2 x _) = Pt2 x y +pitchSet2 y (Pt3 x _ z) = Pt3 x y z + +pitchSet3 :: c -> Pitch a b c -> Pitch a b c +pitchSet3 z (Pt3 x y _) = Pt3 x y z +pitchSet3 z (Pt2 x y) = Pt3 x y z + +showPtchQ :: Ptch -> [String] +showPtchQ = words . show diff --git a/DobutokO/Sound/Effects/Rate.hs b/DobutokO/Sound/Effects/Rate.hs new file mode 100644 index 0000000..936dfeb --- /dev/null +++ b/DobutokO/Sound/Effects/Rate.hs @@ -0,0 +1,206 @@ +-- | +-- Module : DobutokO.Sound.Effects.Rate +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"rate\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Rate 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) + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data RateTL = Q | L deriving Eq + +instance Show RateTL where + show Q = "-q " + show _ = "-l " + +data RateTH = M | H | V deriving Eq + +instance Show RateTH where + show M = "-m " + show H = "-h " + show _ = "-v " + +data ROpt1 = N1 | M1 | I1 | L1 deriving Eq + +instance Show ROpt1 where + show M1 = "-M " + show I1 = "-I " + show L1 = "-L " + show _ = "" + +data ROpt2 = N2 | S2 deriving Eq + +instance Show ROpt2 where + show S2 = "-s " + show _ = "" + +data ROpt3 = N3 | A3 deriving Eq + +instance Show ROpt3 where + show A3 = "-a " + show _ = "" + +data Ropt4 a = N4 | B a deriving Eq + +instance Show (Ropt4 Float) where + show (B x) = mconcat ["-b ", if compare (toRange 99.7 (abs x)) 74.0 == LT then "74.0" else showFFloat Nothing (toRange 99.7 (abs x)) " "] + show _ = "" + +type ROpt4 = Ropt4 Float + +rOpt4C :: Ropt4 a -> String +rOpt4C (B _) = "B" +rOpt4C _ = "N4" + +rOpt41 :: Ropt4 a -> Maybe a +rOpt41 (B x) = Just x +rOpt41 _ = Nothing + +rOpt4Set1 :: a -> Ropt4 a +rOpt4Set1 = B + +data Ropt5 a = N5 | P a deriving Eq + +instance Show (Ropt5 Float) where + show (P x) = mconcat ["-p ", showFFloat Nothing (toRange 100.0 (abs x)) " "] + show _ = "" + +type ROpt5 = Ropt5 Float + +rOpt5C :: Ropt5 a -> String +rOpt5C (P _) = "P" +rOpt5C _ = "N5" + +rOpt51 :: Ropt5 a -> Maybe a +rOpt51 (P x) = Just x +rOpt51 _ = Nothing + +rOpt5Set1 :: a -> Ropt5 a +rOpt5Set1 = P + +data RateL a b = RL a b deriving Eq + +instance Show (RateL RateTL Freq1) where + show (RL x y) = mconcat ["rate ", show x, show y] + +type RateLow = RateL RateTL Freq1 + +rateL1 :: RateL a b -> a +rateL1 (RL x _) = x + +rateL2 :: RateL a b -> b +rateL2 (RL _ y) = y + +rateLSet1 :: a -> RateL a b -> RateL a b +rateLSet1 x (RL _ y) = RL x y + +rateLSet2 :: b -> RateL a b -> RateL a b +rateLSet2 y (RL x _) = RL x y + +showRLQ :: RateLow -> [String] +showRLQ = words . show + +data RateH a b1 b2 b3 b4 b5 c = RH a b1 b2 b3 b4 b5 c deriving Eq + +instance Show (RateH RateTH ROpt1 ROpt2 ROpt3 ROpt4 ROpt5 Freq1) where + show (RH x y1 y2 y3 y4 y5 z) = mconcat ["rate ", show x, show y1, show y2, show y3, show y4, show y5, show z] + +type RateHigh = RateH RateTH ROpt1 ROpt2 ROpt3 ROpt4 ROpt5 Freq1 + +rateH1 :: RateH a b1 b2 b3 b4 b5 c -> a +rateH1 (RH x _ _ _ _ _ _) = x + +rateH21 :: RateH a b1 b2 b3 b4 b5 c -> b1 +rateH21 (RH _ y1 _ _ _ _ _) = y1 + +rateH22 :: RateH a b1 b2 b3 b4 b5 c -> b2 +rateH22 (RH _ _ y2 _ _ _ _) = y2 + +rateH23 :: RateH a b1 b2 b3 b4 b5 c -> b3 +rateH23 (RH _ _ _ y3 _ _ _) = y3 + +rateH24 :: RateH a b1 b2 b3 b4 b5 c -> b4 +rateH24 (RH _ _ _ _ y4 _ _) = y4 + +rateH25 :: RateH a b1 b2 b3 b4 b5 c -> b5 +rateH25 (RH _ _ _ _ _ y5 _) = y5 + +rateH3 :: RateH a b1 b2 b3 b4 b5 c -> c +rateH3 (RH _ _ _ _ _ _ z) = z + +rateHSet1 :: a -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c +rateHSet1 x (RH _ y1 y2 y3 y4 y5 z) = RH x y1 y2 y3 y4 y5 z + +rateHSet21 :: b1 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c +rateHSet21 y1 (RH x _ y2 y3 y4 y5 z) = RH x y1 y2 y3 y4 y5 z + +rateHSet22 :: b2 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c +rateHSet22 y2 (RH x y1 _ y3 y4 y5 z) = RH x y1 y2 y3 y4 y5 z + +rateHSet23 :: b3 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c +rateHSet23 y3 (RH x y1 y2 _ y4 y5 z) = RH x y1 y2 y3 y4 y5 z + +rateHSet24 :: b4 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c +rateHSet24 y4 (RH x y1 y2 y3 _ y5 z) = RH x y1 y2 y3 y4 y5 z + +rateHSet25 :: b5 -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c +rateHSet25 y5 (RH x y1 y2 y3 y4 _ z) = RH x y1 y2 y3 y4 y5 z + +rateHSet3 :: c -> RateH a b1 b2 b3 b4 b5 c -> RateH a b1 b2 b3 b4 b5 c +rateHSet3 z (RH x y1 y2 y3 y4 y5 _) = RH x y1 y2 y3 y4 y5 z + +showRHQ :: RateHigh -> [String] +showRHQ = words . show + +data Rate2 a b = LR a | HR b deriving Eq + +instance Show (Rate2 RateLow RateHigh) where + show (LR x) = show x + show (HR x) = show x + +type Rate = Rate2 RateLow RateHigh + +rate2C :: Rate2 a b -> String +rate2C (LR _) = "LR" +rate2C _ = "HR" + +rate21 :: Rate2 a b -> Maybe a +rate21 (LR x) = Just x +rate21 _ = Nothing + +rate22 :: Rate2 a b -> Maybe b +rate22 (HR y) = Just y +rate22 _ = Nothing + +rate2Set1 :: RateLow -> Rate +rate2Set1 = LR + +rate2Set2 :: RateHigh -> Rate +rate2Set2 = HR + +showRQ :: Rate -> [String] +showRQ = words . show diff --git a/DobutokO/Sound/Effects/Remix.hs b/DobutokO/Sound/Effects/Remix.hs new file mode 100644 index 0000000..1dde71c --- /dev/null +++ b/DobutokO/Sound/Effects/Remix.hs @@ -0,0 +1,154 @@ +-- | +-- Module : DobutokO.Sound.Effects.Remix +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"remix\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Remix 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) + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data Vol3 a = P | I | V | P2 a | I2 a | V2 a deriving Eq + +instance (Show a, RealFloat a) => Show (Vol3 a) where + show P = "p0" + show I = "i0" + show V = "v1" + show (P2 a) = 'p':showFFloat Nothing a "" + show (I2 a) = 'i':showFFloat Nothing a "" + show (V2 a) = 'v':showFFloat Nothing a "" + +vol31 :: Vol3 Float -> Float +vol31 P = 0.0 +vol31 I = 0.0 +vol31 V = 1.0 +vol31 (P2 x) = x +vol31 (I2 x) = x +vol31 (V2 x) = x + +vol3Set1 :: Float -> Vol3 Float -> Vol3 Float +vol3Set1 x P + | x == 0.0 = P + | otherwise = P2 x +vol3Set1 x I + | x == 0.0 = I + | otherwise = I2 x +vol3Set1 x V + | x == 1.0 = V + | otherwise = V2 x +vol3Set1 x (P2 _) = P2 x +vol3Set1 x (I2 _) = I2 x +vol3Set1 x (V2 _) = V2 x + +type Vol3F = Vol3 Float + +data IChannel a b = ICh a (Vol3 b) deriving Eq + +ichannel1 :: IChannel a b -> a +ichannel1 (ICh x _) = x + +ichannel2 :: Vol3F -> IChannel a Float -> Vol3F +ichannel2 P (ICh _ y) = y +ichannel2 I (ICh _ y) = y +ichannel2 V (ICh _ y) = y +ichannel2 (P2 _) (ICh _ y) = P2 (vol31 y) +ichannel2 (I2 _) (ICh _ y) = I2 (vol31 y) +ichannel2 (V2 _) (ICh _ y) = V2 (vol31 y) + +ichannel2C :: IChannel a b -> String +ichannel2C (ICh _ P) = "P" +ichannel2C (ICh _ I) = "I" +ichannel2C (ICh _ V) = "V" +ichannel2C (ICh _ (P2 _)) = "P2" +ichannel2C (ICh _ (I2 _)) = "I2" +ichannel2C (ICh _ (V2 _)) = "V2" + +ichannel21 :: IChannel a Float -> Float +ichannel21 (ICh _ y) = vol31 y + +ichannelSet1 :: a -> IChannel a b -> IChannel a b +ichannelSet1 x (ICh _ y) = ICh x y + +ichannelSet2 :: Vol3 b -> IChannel a b -> IChannel a b +ichannelSet2 y (ICh x _) = ICh x y + +type IChanF = IChannel Int Float + +instance (Show a, Integral a, Show b, RealFloat b) => Show (IChannel a b) where + show (ICh x y) = mconcat [show x, show y] + +data OChannel a = OCh [a] deriving Eq + +instance (Show a) => Show (OChannel a) where + show (OCh []) = [] + show (OCh [x]) = show x + show (OCh ys) = mconcat . intersperse "," . map show $ ys + +ochannel1 :: OChannel a -> [a] +ochannel1 (OCh xs) = xs + +ochannelSet1 :: [a] -> OChannel a -> OChannel a +ochannelSet1 xs _ = OCh xs + +type OChanF = OChannel IChanF + +data MixSpec = A | M | D deriving Eq + +instance Show MixSpec where + show A = "-a " + show M = "-m " + show D = [] + +data Remix a b = Rmx | Rmix a [b] deriving Eq + +instance Show (Remix MixSpec OChanF) where + show (Rmix x ys) = mconcat ["remix ",show x, mconcat . intersperse " " . map show $ ys] + show Rmx = "remix -" + +remixC :: Remix a b -> String +remixC Rmx = "Rmx" +remixC (Rmix _ _) = "Rmix" + +remix1 :: Remix a b -> Maybe a +remix1 Rmx = Nothing +remix1 (Rmix x _) = Just x + +remix2 :: Remix a b -> [b] +remix2 Rmx = [] +remix2 (Rmix _ xs) = xs + +type ReMix = Remix MixSpec OChanF + +remixSet1 :: MixSpec -> ReMix -> ReMix +remixSet1 _ Rmx = Rmx +remixSet1 y (Rmix _ xs) = Rmix y xs + +remixSet2 :: [OChanF] -> ReMix -> ReMix +remixSet2 ys Rmx = Rmix D ys +remixSet2 ys (Rmix x _) = Rmix x ys + +showRmQ :: ReMix -> [String] +showRmQ = words . show + diff --git a/DobutokO/Sound/Effects/Repeat.hs b/DobutokO/Sound/Effects/Repeat.hs new file mode 100644 index 0000000..90b81d2 --- /dev/null +++ b/DobutokO/Sound/Effects/Repeat.hs @@ -0,0 +1,56 @@ +-- | +-- Module : DobutokO.Sound.Effects.Repeat +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"repeat\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Repeat 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 + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data Count a = I | O1 | Ct a deriving Eq + +instance Show (Count Int) where + show I = "- " + show O1 = "" + show (Ct n) + | n == 0 = "- " + | otherwise = show n ++ " " + +type CountR = Count Int + +data Repeat a = Rpt a deriving Eq + +instance Show (Repeat CountR) where + show (Rpt x) = mconcat ["repeat ",show x] + +repeat1 :: Repeat a -> a +repeat1 (Rpt x) = x + +repeatSet1 :: a -> Repeat a +repeatSet1 = Rpt + +type Repeat1 = Repeat CountR + +showRptQ :: Repeat1 -> [String] +showRptQ = words . show diff --git a/DobutokO/Sound/Effects/Reverb.hs b/DobutokO/Sound/Effects/Reverb.hs new file mode 100644 index 0000000..59f5025 --- /dev/null +++ b/DobutokO/Sound/Effects/Reverb.hs @@ -0,0 +1,113 @@ +-- | +-- Module : DobutokO.Sound.Effects.Reverb +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"reverb\" and \"reverse\" effects. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Reverb 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 qualified DobutokO.Sound.Frequency as FQ +import DobutokO.Sound.ToRange + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data Four = O4 | T4 | H4 | F4 deriving Eq + +data Reverb a b c d = Rvrb a b [c] d deriving Eq + +instance Show (Reverb Four FQ.Di Float Int) where + show (Rvrb variant wet xs n) + | compare n 0 == LT = error $ "DobutokO.Sound.Effects.Reverb.show is not defined for the value of the last argument " ++ show n + | otherwise = + let (zs, ks) = splitAt 4 xs in + let ys = map (toRange 100.0) zs in + if null ks + then case variant of + O4 -> mconcat ["reverb ", if wet == FQ.O then "-w " else "", mconcat . intersperse " " . map (\x -> showFFloat (Just n) x " ") $ ys] + T4 -> mconcat ["reverse reverb ", if wet == FQ.O then "-w " else "", mconcat . intersperse " " . map (\x -> showFFloat (Just n) x " ") $ ys," reverse"] + H4 -> mconcat ["reverb ", if wet == FQ.O then "-w " else "", mconcat . intersperse " " . map (\x -> showFFloat (Just n) x " ") $ ys," reverse"] + _ -> mconcat ["reverse reverb ", if wet == FQ.O then "-w " else "", mconcat . intersperse " " . map (\x -> showFFloat (Just n) x " ") $ ys] + else let r5 = head ks in if null . tail $ ks then + case variant of + O4 -> mconcat ["reverb ", if wet == FQ.O then "-w " else "", mconcat . intersperse " " . map (\x -> showFFloat (Just n) x " ") $ ys, " ", + showFFloat (Just n) r5 ""] + T4 -> mconcat ["reverse reverb ", if wet == FQ.O then "-w " else "", mconcat . intersperse " " . map (\x -> showFFloat (Just n) x " ") $ ys," ", + showFFloat (Just n) r5 ""," reverse"] + H4 -> mconcat ["reverb ", if wet == FQ.O then "-w " else "", mconcat . intersperse " " . map (\x -> showFFloat (Just n) x " ") $ ys," ", + showFFloat (Just n) r5 ""," reverse"] + _ -> mconcat ["reverse reverb ", if wet == FQ.O then "-w " else "", mconcat . intersperse " " . map (\x -> showFFloat (Just n) x " ") $ ys," ", + showFFloat (Just n) r5 ""] + else let r60 = last ks in + let r6 = (r60 / 120.0 - (fromIntegral . truncate $ r60 / 120.0)) * 120.0 in + case variant of + O4 -> mconcat ["reverb ", if wet == FQ.O then "-w " else "", mconcat . intersperse " " . map (\x -> showFFloat (Just n) x " ") $ ys, " ", + showFFloat (Just n) r5 ""," ",showFFloat (Just n) r6 ""] + T4 -> mconcat ["reverse reverb ", if wet == FQ.O then "-w " else "", mconcat . intersperse " " . map (\x -> showFFloat (Just n) x " ") $ ys," ", + showFFloat (Just n) r5 " ",showFFloat (Just n) r6 " reverse"] + H4 -> mconcat ["reverb ", if wet == FQ.O then "-w " else "", mconcat . intersperse " " . map (\x -> showFFloat (Just n) x " ") $ ys," ", + showFFloat (Just n) r5 " ",showFFloat (Just n) r6 " reverse"] + _ -> mconcat ["reverse reverb ", if wet == FQ.O then "-w " else "", mconcat . intersperse " " . map (\x -> showFFloat (Just n) x " ") $ ys," ", + showFFloat (Just n) r5 " ",showFFloat (Just n) r6 ""] + +reverb1 :: Reverb a b c d -> a +reverb1 (Rvrb x _ _ _) = x + +reverb2 :: Reverb a b c d -> b +reverb2 (Rvrb _ y _ _) = y + +reverb3 :: Reverb a b c d -> [c] +reverb3 (Rvrb _ _ zs _) = take 6 zs + +reverb4 :: Reverb a b c d -> d +reverb4 (Rvrb _ _ _ t) = t + +type ReverbE = Reverb Four FQ.Di Float Int + +reverb3E :: Int -> ReverbE -> Float +reverb3E n x + | compare n 0 == GT && compare n 7 == LT = if null . drop (n - 1) . reverb3 $ x then 50.0 * fromIntegral ((((n - 1) `quot` 2) + 1) `rem` 3) else reverb3 x !! (n - 1) + | otherwise = error "DobutokO.Sound.Effects.Reverb.reverb3E: Not defined parameter. " + +reverbSet1 :: a -> Reverb a b c d -> Reverb a b c d +reverbSet1 x (Rvrb _ y zs t) = Rvrb x y zs t + +reverbSet2 :: b -> Reverb a b c d -> Reverb a b c d +reverbSet2 y (Rvrb x _ zs t) = Rvrb x y zs t + +reverbSet3 :: [c] -> Reverb a b c d -> Reverb a b c d +reverbSet3 zs (Rvrb x y _ t) = Rvrb x y (take 6 zs) t + +reverbSet4 :: d -> Reverb a b c d -> Reverb a b c d +reverbSet4 t (Rvrb x y zs _) = Rvrb x y zs t + +reverbSet3E :: Int -> Float -> ReverbE -> ReverbE +reverbSet3E n y x + | compare n 0 == GT && compare n 5 == LT = Rvrb (reverb1 x) (reverb2 x) (mconcat [take (n - 1) . reverb3 $ x, [toRange 100.0 y], drop n . reverb3 $ x]) (reverb4 x) + | n == 5 = Rvrb (reverb1 x) (reverb2 x) (mconcat [take 4 . reverb3 $ x, [y], drop 5 . reverb3 $ x]) (reverb4 x) + | n == 6 = Rvrb (reverb1 x) (reverb2 x) (mconcat [take 5 . reverb3 $ x, [toRange 120.0 y]]) (reverb4 x) + | otherwise = error "DobutokO.Sound.Effects.Reverb.reverbSet3E: The first argument is out of range [1..6]. " + +showQReverb :: ReverbE -> [String] +showQReverb = words . show + diff --git a/DobutokO/Sound/Effects/Segment.hs b/DobutokO/Sound/Effects/Segment.hs new file mode 100644 index 0000000..d80762a --- /dev/null +++ b/DobutokO/Sound/Effects/Segment.hs @@ -0,0 +1,90 @@ +-- | +-- Module : DobutokO.Sound.Effects.Segment +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the \"pitch\" and / or \"tempo\" SoX effects. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Segment 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 Segment a = E0 | S1 a | S2 a a | S3 a a a deriving Eq + +instance Show (Segment Float) where + show (E0) = "" + show (S1 x) + | compare x 10.0 /= LT && compare x 120.0 /= GT = showFFloat Nothing x " " + | otherwise = error "DobutokO.Sound.Effects.Segment.show: Not defined for the value. It must be in [10.0..120.0]. " + show (S2 x y) + | compare x 10.0 /= LT && compare x 120.0 /= GT && compare y 0.0 /= LT && compare y 30.0 /= GT = mconcat [showFFloat Nothing x " ", showFFloat Nothing y " "] + | otherwise = error "DobutokO.Sound.Effects.Segment.show: Not defined for the values. The first one must be in [10.0..120.0] and the second one -- in [0.0..30.0]. " + show (S3 x y z) + | compare x 10.0 /= LT && compare x 120.0 /= GT && compare y 0.0 /= LT && compare y 30.0 /= GT && compare z 0.0 /= LT && compare z 30.0 /= GT = + mconcat [showFFloat Nothing x " ", showFFloat Nothing y " ", showFFloat Nothing z " "] + | otherwise = + error "DobutokO.Sound.Effects.Segment.show: Not defined for the values. The first one must be in [10.0..120.0], the second and the third ones -- in [0.0..30.0] . " + +type Segm = Segment Float + +segmentC :: Segment a -> String +segmentC E0 = "E0" +segmentC (S1 _) = "S1" +segmentC (S2 _ _) = "S2" +segmentC (S3 _ _ _) = "S3" + +segment1 :: Segment a -> Maybe a +segment1 (S1 x) = Just x +segment1 (S2 x _) = Just x +segment1 (S3 x _ _) = Just x +segment1 _ = Nothing + +segment2 :: Segment a -> Maybe a +segment2 (S2 _ y) = Just y +segment2 (S3 _ y _) = Just y +segment2 _ = Nothing + +segment3 :: Segment a -> Maybe a +segment3 (S3 _ _ z) = Just z +segment3 _ = Nothing + +segmentSet1 :: a -> Segment a -> Segment a +segmentSet1 x (S2 _ y) = S2 x y +segmentSet1 x (S3 _ y z) = S3 x y z +segmentSet1 x _ = S1 x + +segmentSet2 :: a -> a -> Segment a -> Segment a +segmentSet2 x y (S3 _ _ z) = S3 x y z +segmentSet2 x y _ = S2 x y + +segmentSet3 :: a -> a -> a -> Segment a +segmentSet3 = S3 + +data Qdash = E | Q deriving Eq + +instance Show Qdash where + show E = "" + show Q = "-q " + + diff --git a/DobutokO/Sound/Effects/Silence.hs b/DobutokO/Sound/Effects/Silence.hs new file mode 100644 index 0000000..44cc7cd --- /dev/null +++ b/DobutokO/Sound/Effects/Silence.hs @@ -0,0 +1,244 @@ +-- | +-- Module : DobutokO.Sound.Effects.Silence +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"silence\" effect. +-- + +{-# 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 -- there is a not clearly documented possibility to specify also hours as duration, but it is rarely used and so is omitted. + +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 + +-- | Analogical to 'TSpec' but without the first argument (it is unneeded here). +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"] -- is rarely used, but is technically possible. + 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"] -- is rarely used, but is technically possible. + 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 diff --git a/DobutokO/Sound/Effects/Sinc.hs b/DobutokO/Sound/Effects/Sinc.hs new file mode 100644 index 0000000..01a6312 --- /dev/null +++ b/DobutokO/Sound/Effects/Sinc.hs @@ -0,0 +1,197 @@ +-- | +-- Module : DobutokO.Sound.Effects.Sinc +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"sinc\" effect. +-- + +{-# 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 diff --git a/DobutokO/Sound/Effects/Specs.hs b/DobutokO/Sound/Effects/Specs.hs new file mode 100644 index 0000000..fa427e3 --- /dev/null +++ b/DobutokO/Sound/Effects/Specs.hs @@ -0,0 +1,55 @@ +-- | +-- Module : DobutokO.Sound.Effects.Specs +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX effects with the needed specifications. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances #-} + +module DobutokO.Sound.Effects.Specs where + +import Numeric (showFFloat) + +data Frequency a = FHz a | FkHz a deriving Eq + +instance Show (Frequency Float) where + show (FHz x) = showFFloat Nothing x " " + show (FkHz x) = showFFloat Nothing x "k " + +type Freq1 = Frequency Float + +frequency1 :: Freq1 -> Float +frequency1 (FHz x) = x +frequency1 (FkHz x) = 1000.0 * x + +frequencySet1 :: Float -> Freq1 -> Freq1 +frequencySet1 x (FHz _) = FHz x +frequencySet1 x (FkHz _) = FkHz x + +data Width a = H a | K a | O a | Q a deriving Eq + +instance Show (Width Float) where + show (H x) = showFFloat Nothing x "h" + show (K x) = showFFloat Nothing x "k" + show (O x) = showFFloat Nothing x "o" + show (Q x) = showFFloat Nothing x "q" + +type Width1 = Width Float + +width1 :: Width a -> a +width1 (H x) = x +width1 (K x) = x +width1 (O x) = x +width1 (Q x) = x + +widthSet1 :: a -> Width a -> Width a +widthSet1 x (H _) = H x +widthSet1 x (K _) = K x +widthSet1 x (O _) = O x +widthSet1 x (Q _) = Q x diff --git a/DobutokO/Sound/Effects/Spectrogram.hs b/DobutokO/Sound/Effects/Spectrogram.hs new file mode 100644 index 0000000..c0a7b81 --- /dev/null +++ b/DobutokO/Sound/Effects/Spectrogram.hs @@ -0,0 +1,246 @@ +-- | +-- Module : DobutokO.Sound.Effects.Spectrogram +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"spectrogram\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Spectrogram 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 qualified DobutokO.Sound.Effects.Timespec as TS +import DobutokO.Sound.Effects.Misc (MscS(..)) + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data SFloat1 a = X1 a | X a | Y1 a | Y a | Z1 a | Z a | Q a | W a | P a deriving Eq + +instance Show (SFloat1 Float) where + show (X1 x) = mconcat ["-x ", showFFloat Nothing (if compare (toRange 200000.0 . abs $ x) 100.0 == LT then 100.0 else toRange 200000.0 . abs $ x) " "] + show (X x) = mconcat ["-X ", showFFloat Nothing (if compare (toRange 5000.0 . abs $ x) 1.0 == LT then 1.0 else toRange 5000.0 . abs $ x) " "] + show (Y1 x) = mconcat ["-y ", showFFloat Nothing (if compare (toRange 1200.0 . abs $ x) 64.0 == LT then 64.0 else toRange 1200.0 . abs $ x) " "] + show (Y x) = mconcat ["-Y ", showFFloat Nothing (if compare (toRange 2050.0 . abs $ x) 130.0 == LT then 130.0 else toRange 2050.0 . abs $ x) " "] + show (Z1 x) = mconcat ["-z ", showFFloat Nothing (if compare (toRange 180.0 . abs $ x) 20.0 == LT then 20.0 else toRange 180.0 . abs $ x) " "] + show (Z x) = mconcat ["-Z ", showFFloat Nothing (toRange 100.0 x) " "] + show (Q x) = mconcat ["-q ", showFFloat Nothing (toRange 249.0 . abs $ x) " "] + show (W x) = mconcat ["-W ", showFFloat Nothing (toRange 10.0 x) " "] + show (P x) = mconcat ["-p ", showFFloat Nothing (if compare (toRange 6.0 . abs $ x) 1.0 == LT then 1.0 else toRange 6.0 . abs $ x) " "] + +type SFloat = SFloat1 Float + +sFloat1C :: SFloat1 a -> String +sFloat1C (X1 _) = "X1" +sFloat1C (X _) = "X" +sFloat1C (Y1 _) = "Y1" +sFloat1C (Y _) = "Y" +sFloat1C (Z1 _) = "Z1" +sFloat1C (Z _) = "Z" +sFloat1C (Q _) = "Q" +sFloat1C (W _) = "W" +sFloat1C _ = "P" + +sFloat11 :: SFloat1 a -> a +sFloat11 (X1 x) = x +sFloat11 (X x) = x +sFloat11 (Y1 x) = x +sFloat11 (Y x) = x +sFloat11 (Z1 x) = x +sFloat11 (Z x) = x +sFloat11 (Q x) = x +sFloat11 (W x) = x +sFloat11 (P x) = x + +sFloat1Set1 :: a -> SFloat1 a -> SFloat1 a +sFloat1Set1 x (X1 _) = X1 x +sFloat1Set1 x (X _) = X x +sFloat1Set1 x (Y1 _) = Y1 x +sFloat1Set1 x (Y _) = Y x +sFloat1Set1 x (Z1 _) = Z1 x +sFloat1Set1 x (Z _) = Z x +sFloat1Set1 x (Q _) = Q x +sFloat1Set1 x (W _) = W x +sFloat1Set1 x _ = P x + +data SString1 a = W1 a | T a | C a | O a deriving Eq + +-- | For 'W1' the argument can be one of the following: \"Hann\" (default), \"Hamming\", \"Bartlett\", \"Rectangular\", \"Kaiser\", \"Dolph\". +instance Show (SString1 String) where + show (W1 xs) + | null xs || take 3 xs == "Han" = [] + | head xs <= 'B' = "-w Bartlett " + | head xs <= 'D' = "-w Dolph " + | head xs <= 'H' = "-w Hamming " + | head xs <= 'K' = "-w Kaiser " + | head xs <= 'R' = "-w Rectangular " + | otherwise = "" + show (T xs) = mconcat ["-t ", xs , " "] + show (C xs) = mconcat ["-c ", xs , " "] + show (O xs) = mconcat ["-o ", xs , " "] + +type SString = SString1 String + +sString1C :: SString1 a -> String +sString1C (W1 _) = "W1" +sString1C (T _) = "T" +sString1C (C _) = "C" +sString1C _ = "O" + +sString11 :: SString1 a -> a +sString11 (W1 x) = x +sString11 (T x) = x +sString11 (C x) = x +sString11 (O x) = x + +sString1Set1 :: a -> SString1 a -> SString1 a +sString1Set1 x (W1 _) = W1 x +sString1Set1 x (T _) = T x +sString1Set1 x (C _) = C x +sString1Set1 x (O _) = O x + +data Spectr = S1 | M | H | L | A1 | A | R deriving Eq + +instance Show Spectr where + show S1 = "-s " + show M = "-m " + show H = "-h " + show L = "-l " + show A1 = "-a " + show A = "-A " + show _ = "-r " + +data Advanced1 a = S a deriving Eq + +instance Show (Advanced1 TS.TSpecification) where + show (S x) = mconcat ["-S ", show x] + +advanced11 :: Advanced1 a -> a +advanced11 (S x) = x + +advanced1Set1 :: a -> Advanced1 a +advanced1Set1 = S + +type PositionS = Advanced1 TS.TSpecification + +data DTSpec2 a b = DTs b | DTm a b | DTh a a b | DS a deriving Eq + +instance Show (DTSpec2 Int Float) where + show (DTs y) = showFFloat Nothing (abs y) "t" + show (DTm y z) = mconcat [show (abs y),":",showFFloat Nothing (abs z) "t"] + show (DTh y1 y2 z) = mconcat [show (abs y1),":",show (abs y2),":",showFFloat Nothing (abs z) "t"] + show (DS y) = mconcat [show (abs y),"s"] + +type FirstDTSpec = DTSpec2 Int Float + +isTimeD :: DTSpec2 a b -> Bool +isTimeD (DS _) = False +isTimeD _ = True + +isSamplesD :: DTSpec2 a b -> Bool +isSamplesD (DS _) = True +isSamplesD _ = False + +dTSpec2CD :: FirstDTSpec -> String +dTSpec2CD (DTs _) = "DTs" +dTSpec2CD (DTm _ _) = "DTm" +dTSpec2CD (DTh _ _ _) = "DTh" +dTSpec2CD (DS _) = "DS" + +secondsD :: FirstDTSpec -> Maybe Float +secondsD (DTs x) = Just (abs x) +secondsD (DTm x y) = Just (abs y + fromIntegral (60 * abs x)) +secondsD (DTh x y z) = Just (abs z + fromIntegral (3600 * abs x + 60 * abs y)) +secondsD _ = Nothing + +minutesD :: FirstDTSpec -> Maybe Int +minutesD (DTs x) = Just (truncate $ abs x / 60.0) +minutesD (DTm x y) = Just (abs x + truncate (abs y / 60.0)) +minutesD (DTh x y z) = Just (abs y + truncate (abs z / 60.0) + 60 * abs x) +minutesD _ = Nothing + +hoursD :: FirstDTSpec -> Maybe Int +hoursD (DTs x) = Just (truncate $ abs x / 3600.0) +hoursD (DTm x y) = Just (truncate (fromIntegral (abs x) / 60.0 + abs y / 3600.0)) +hoursD (DTh x y z) = Just (abs x + truncate (abs z / 3600.0 + fromIntegral (abs y) / 60.0)) +hoursD _ = Nothing + +samplesD :: FirstDTSpec -> Maybe Int +samplesD (DS x) = Just x +samplesD _ = Nothing + +seconds2FstDTSpec2 :: Float -> FirstDTSpec +seconds2FstDTSpec2 y = DTs (abs y) + +samples2FstDTSpec2 :: Int -> FirstDTSpec +samples2FstDTSpec2 y = DS (abs y) + +type TSpec = TS.TimeSpec FirstDTSpec TS.NextTSpec + +instance Show (TS.TimeSpec FirstDTSpec TS.NextTSpec) where + show (TS.TS1 x) = show x + show (TS.TS2 x ys) = mconcat [show x,mconcat . map show $ ys] + +data DurationD1 a = D a deriving Eq + +instance Show (DurationD1 TSpec) where + show (D x) = show x + +type DurationD = DurationD1 TSpec + +data Spectrogram3 a b c d e = SG [a] [b] [c] [d] [e] deriving Eq + +instance Show (Spectrogram3 SFloat SString Spectr PositionS DurationD) where + show (SG xs ys zs ts us) = mconcat ["spectrogram ", show (Msc xs), show (Msc ys), show (Msc zs), show (Msc ts), show (Msc us)] + +type Spectrogram = Spectrogram3 SFloat SString Spectr PositionS DurationD + +spectrogram31 :: Spectrogram3 a b c d e -> [a] +spectrogram31 (SG xs _ _ _ _) = xs + +spectrogram32 :: Spectrogram3 a b c d e -> [b] +spectrogram32 (SG _ ys _ _ _) = ys + +spectrogram33 :: Spectrogram3 a b c d e -> [c] +spectrogram33 (SG _ _ zs _ _) = zs + +spectrogram34 :: Spectrogram3 a b c d e -> [d] +spectrogram34 (SG _ _ _ ts _) = ts + +spectrogram35 :: Spectrogram3 a b c d e -> [e] +spectrogram35 (SG _ _ _ _ us) = us + +spectrogramSet31 :: [a] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e +spectrogramSet31 xs (SG _ ys zs ts us) = SG xs ys zs ts us + +spectrogramSet32 :: [b] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e +spectrogramSet32 ys (SG xs _ zs ts us) = SG xs ys zs ts us + +spectrogramSet33 :: [c] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e +spectrogramSet33 zs (SG xs ys _ ts us) = SG xs ys zs ts us + +spectrogramSet34 :: [d] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e +spectrogramSet34 ts (SG xs ys zs _ us) = SG xs ys zs ts us + +spectrogramSet35 :: [e] -> Spectrogram3 a b c d e -> Spectrogram3 a b c d e +spectrogramSet35 us (SG xs ys zs ts _) = SG xs ys zs ts us + +showSGQ :: Spectrogram -> [String] +showSGQ = words . show diff --git a/DobutokO/Sound/Effects/Speed.hs b/DobutokO/Sound/Effects/Speed.hs new file mode 100644 index 0000000..d2c94e4 --- /dev/null +++ b/DobutokO/Sound/Effects/Speed.hs @@ -0,0 +1,59 @@ +-- | +-- Module : DobutokO.Sound.Effects.Speed +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the \"speed\" SoX effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Speed 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 Cents = E | C deriving Eq + +instance Show Cents where + show C = "c" + show _ = "" + +data Speed a b = Spd a b deriving Eq + +instance Show (Speed Float Cents) where + show (Spd x y) = mconcat [showFFloat Nothing x "",show y] + +type Spd2 = Speed Float Cents + +speed1 :: Speed a b -> a +speed1 (Spd x _) = x + +speed2 :: Speed a b -> b +speed2 (Spd _ y) = y + +speedSet1 :: a -> Speed a b -> Speed a b +speedSet1 x (Spd _ y) = Spd x y + +speedSet2 :: b -> Speed a b -> Speed a b +speedSet2 y (Spd x _) = Spd x y + +showSpdQ :: Spd2 -> [String] +showSpdQ = words . show diff --git a/DobutokO/Sound/Effects/Splice.hs b/DobutokO/Sound/Effects/Splice.hs new file mode 100644 index 0000000..718beff --- /dev/null +++ b/DobutokO/Sound/Effects/Splice.hs @@ -0,0 +1,52 @@ +-- | +-- Module : DobutokO.Sound.Effects.Splice +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"splice\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances #-} + +module DobutokO.Sound.Effects.Splice where + +import Data.List (intersperse) +import DobutokO.Sound.Effects.Timespec +import DobutokO.Sound.One (One3(..)) + + +data SpliceP = N0 | H | T | Q deriving Eq + +instance Show SpliceP where + show H = "-h " + show T = "-t " + show Q = "-q " + show _ = "" + +data Splice2 a b = SL a [One3 b] deriving Eq + +instance Show (Splice2 SpliceP TSpecification) where + show (SL x ys) + | null ys = "" + | otherwise = mconcat ["splice ", show x, mconcat . intersperse " " . map show $ ys] + +type Splice = Splice2 SpliceP TSpecification + +splice21 :: Splice2 a b -> a +splice21 (SL x _) = x + +splice22 :: Splice2 a b -> [One3 b] +splice22 (SL _ ys) = ys + +splice2Set1 :: a -> Splice2 a b -> Splice2 a b +splice2Set1 x (SL _ ys) = SL x ys + +splice2Set2 :: [One3 b] -> Splice2 a b -> Splice2 a b +splice2Set2 ys (SL x _) = SL x ys + +showSLQ :: Splice -> [String] +showSLQ = words . show diff --git a/DobutokO/Sound/Effects/Stat.hs b/DobutokO/Sound/Effects/Stat.hs new file mode 100644 index 0000000..da8a720 --- /dev/null +++ b/DobutokO/Sound/Effects/Stat.hs @@ -0,0 +1,72 @@ +-- | +-- Module : DobutokO.Sound.Effects.Stat +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"stat\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Stat 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.Effects.Misc (MscS(..)) + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data StatP a = S a | RMS | V | Freq | D deriving Eq + +instance Show (StatP Float) where + show (S x) = mconcat ["-s ", showFFloat Nothing x " "] + show RMS = "-rms " + show V = "-v " + show D = "-d " + show _ = "-freq " + +type StatP1 = StatP Float + +statPC :: StatP a -> String +statPC (S _) = "S" +statPC RMS = "RMS" +statPC V = "V" +statPC D = "D" +statPC _ = "Freq" + +statP1 :: StatP a -> Maybe a +statP1 (S x) = Just x +statP1 _ = Nothing + +statPSet1 :: a -> StatP a +statPSet1 = S + +data Stat1 a = ST (MscS a) deriving Eq + +instance Show (Stat1 StatP1) where + show (ST (Msc xs)) = mconcat ["stat ", show (Msc xs)] + +type Stat = Stat1 StatP1 + +stat11 :: Stat1 a -> [a] +stat11 (ST (Msc xs)) = xs + +stat1Set1 :: [a] -> Stat1 a +stat1Set1 xs = ST (Msc xs) + +showSTQ :: Stat -> [String] +showSTQ = words . show diff --git a/DobutokO/Sound/Effects/Stats.hs b/DobutokO/Sound/Effects/Stats.hs new file mode 100644 index 0000000..04b0abc --- /dev/null +++ b/DobutokO/Sound/Effects/Stats.hs @@ -0,0 +1,102 @@ +-- | +-- Module : DobutokO.Sound.Effects.Stats +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"stats\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Stats 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.Effects.Misc (MscS(..),mscS1) +import DobutokO.Sound.ToRange + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data StatsP a = E | B a | X a | S a deriving Eq + +instance Show (StatsP Float) where + show (B x) = mconcat ["-b ", showFFloat Nothing (if compare (abs x) 2.0 == LT then 2.0 else (toRange 32.0 . abs $ x)) " "] + show (X x) = mconcat ["-x ", showFFloat Nothing (if compare (abs x) 2.0 == LT then 2.0 else (toRange 32.0 . abs $ x)) " "] + show (S x) = mconcat ["-s ", showFFloat Nothing (toRange 99.0 x) " "] + show _ = "" + +type StatsPF = StatsP Float + +statsPC :: StatsP a -> String +statsPC (B _) = "B" +statsPC (X _) = "X" +statsPC (S _) = "S" +statsPC _ = "E" + +statsP1 :: StatsP a -> Maybe a +statsP1 (B x) = Just x +statsP1 (X x) = Just x +statsP1 (S x) = Just x +statsP1 _ = Nothing + +statsPSet1 :: a -> StatsP a -> StatsP a +statsPSet1 x (B _) = B x +statsPSet1 x (X _) = X x +statsPSet1 x (S _) = S x +statsPSet1 _ _ = E + +data Window1 a = E0 | W a deriving Eq + +instance Show (Window1 Float) where + show (W x) = mconcat ["-w ", showFFloat Nothing (if compare (abs x) 0.01 == LT then 0.01 else (toRange 10.0 . abs $ x)) " "] + show _ = "" + +type Window = Window1 Float + +window1C :: Window1 a -> String +window1C E0 = "E0" +window1C _ = "W" + +window11 :: Window1 a -> Maybe a +window11 (W x) = Just x +window11 _ = Nothing + +window1Set1 :: a -> Window1 a +window1Set1 = W + +data Stats2 a b = STT (MscS a) (MscS b) deriving Eq + +instance Show (Stats2 StatsPF Window) where + show (STT x y) = mconcat ["stats ", show x, show y] + +type Stats = Stats2 StatsPF Window + +stats21 :: Stats2 a b -> [a] +stats21 (STT x _) = mscS1 x + +stats22 :: Stats2 a b -> [b] +stats22 (STT _ y) = mscS1 y + +stats2Set1 :: [a] -> Stats2 a b -> Stats2 a b +stats2Set1 xs (STT _ y) = STT (Msc xs) y + +stats2Set2 :: [b] -> Stats2 a b -> Stats2 a b +stats2Set2 ys (STT x _) = STT x (Msc ys) + +showSTTQ :: Stats -> [String] +showSTTQ = words . show diff --git a/DobutokO/Sound/Effects/Stretch.hs b/DobutokO/Sound/Effects/Stretch.hs new file mode 100644 index 0000000..5cf4e55 --- /dev/null +++ b/DobutokO/Sound/Effects/Stretch.hs @@ -0,0 +1,88 @@ +-- | +-- Module : DobutokO.Sound.Effects.Stretch +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"stretch\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Stretch 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 + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data StretchP a = SR a a a deriving Eq + +-- | the first argument can be less than 1.0 but it is not recommended. The default value is 20.0. +instance Show (StretchP Float) where + show (SR x y z) = mconcat [showFFloat Nothing (abs x) " lin ", showFFloat Nothing (toRange 1.0 . abs $ y) " ", showFFloat Nothing (toRange 0.5 . abs $ z) " "] + +type StretchPF = StretchP Float + +stretch1 :: StretchP a -> a +stretch1 (SR x _ _) = x + +stretch2 :: StretchP a -> a +stretch2 (SR _ y _) = y + +stretch3 :: StretchP a -> a +stretch3 (SR _ _ z) = z + +stretchSet1 :: a -> StretchP a -> StretchP a +stretchSet1 x (SR _ y z) = SR x y z + +stretchSet2 :: a -> StretchP a -> StretchP a +stretchSet2 y (SR x _ z) = SR x y z + +stretchSet3 :: a -> StretchP a -> StretchP a +stretchSet3 z (SR x y _) = SR x y z + +data Stretch2 a b = SR21 a | SR22 a b deriving Eq + +instance Show (Stretch2 Float StretchPF) where + show (SR21 x) = mconcat ["stretch ", if compare (abs x) 0.001 == LT then "0.001 " else showFFloat Nothing (abs x) " "] + show (SR22 x y) = mconcat ["stretch ", if compare (abs x) 0.001 == LT then "0.001 " else showFFloat Nothing (abs x) " ", show y] + +type Stretch = Stretch2 Float StretchPF + +stretch2C :: Stretch2 a b -> String +stretch2C (SR21 _) = "SR21" +stretch2C _ = "SR22" + +stretch21 :: Stretch2 a b -> a +stretch21 (SR21 x) = x +stretch21 (SR22 x _) = x + +stretch22 :: Stretch2 a b -> Maybe b +stretch22 (SR22 _ y) = Just y +stretch22 _ = Nothing + +stretch2Set1 :: a -> Stretch2 a b -> Stretch2 a b +stretch2Set1 x (SR21 _) = SR21 x +stretch2Set1 x (SR22 _ y) = SR22 x y + +stretch2Set2 :: b -> Stretch2 a b -> Stretch2 a b +stretch2Set2 y (SR21 x) = SR22 x y +stretch2Set2 y (SR22 x _) = SR22 x y + +showSTRQ :: Stretch -> [String] +showSTRQ = words . show diff --git a/DobutokO/Sound/Effects/Tempo.hs b/DobutokO/Sound/Effects/Tempo.hs new file mode 100644 index 0000000..214dcf0 --- /dev/null +++ b/DobutokO/Sound/Effects/Tempo.hs @@ -0,0 +1,74 @@ +-- | +-- Module : DobutokO.Sound.Effects.Tempo +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the \"tempo\" SoX effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances #-} + +module DobutokO.Sound.Effects.Tempo where + + +import Numeric (showFFloat) +import DobutokO.Sound.Effects.Segment + +data MSL = E | M | S | L deriving Eq + +instance Show MSL where + show M = "-m " + show S = "-s " + show L = "-l " + show _ = "" + +data Tempo a b c d = Tm3 a b c | Tm4 a b c d deriving Eq + +instance Show (Tempo Qdash MSL Float Segm) where + show (Tm3 x y z) = mconcat ["tempo ", show x,show y, showFFloat Nothing z " "] + show (Tm4 x y z t) = mconcat ["tempo ", show x, show y, showFFloat Nothing z " ", show t] + +type Tmp = Tempo Qdash MSL Float Segm + +tempoC :: Tempo a b c d -> String +tempoC (Tm3 _ _ _) = "Tm3" +tempoC (Tm4 _ _ _ _) = "Tm4" + +tempo1 :: Tempo a b c d -> a +tempo1 (Tm3 x _ _) = x +tempo1 (Tm4 x _ _ _) = x + +tempo2 :: Tempo a b c d -> b +tempo2 (Tm3 _ y _) = y +tempo2 (Tm4 _ y _ _) = y + +tempo3 :: Tempo a b c d -> c +tempo3 (Tm4 _ _ z _) = z +tempo3 (Tm3 _ _ z) = z + +tempo4 :: Tempo a b c d -> Maybe d +tempo4 (Tm4 _ _ _ t) = Just t +tempo4 _ = Nothing + +tempoSet1 :: a -> Tempo a b c d -> Tempo a b c d +tempoSet1 x (Tm3 _ y z) = Tm3 x y z +tempoSet1 x (Tm4 _ y z t) = Tm4 x y z t + +tempoSet2 :: b -> Tempo a b c d -> Tempo a b c d +tempoSet2 y (Tm3 x _ z) = Tm3 x y z +tempoSet2 y (Tm4 x _ z t) = Tm4 x y z t + +tempoSet3 :: c -> Tempo a b c d -> Tempo a b c d +tempoSet3 z (Tm4 x y _ t) = Tm4 x y z t +tempoSet3 z (Tm3 x y _) = Tm3 x y z + +tempoSet4 :: d -> Tempo a b c d -> Tempo a b c d +tempoSet4 t (Tm3 x y z) = Tm4 x y z t +tempoSet4 t (Tm4 x y z _) = Tm4 x y z t + +showTmpQ :: Tmp -> [String] +showTmpQ = words . show diff --git a/DobutokO/Sound/Effects/Timespec.hs b/DobutokO/Sound/Effects/Timespec.hs new file mode 100644 index 0000000..4eda564 --- /dev/null +++ b/DobutokO/Sound/Effects/Timespec.hs @@ -0,0 +1,192 @@ +-- | +-- Module : DobutokO.Sound.Effects.Timespec +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX effects with the needed time specifications. +-- + +{-# 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) +import DobutokO.Sound.One + +#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 + +instance Show (One3 TSpecification) where + show (O31 x) = mconcat [show x, " "] + show (O32 x y) = mconcat [show x, ",", show y, " "] + show (O33 x y z) = mconcat [show x, ",", show y, ",", show z, " "] + diff --git a/DobutokO/Sound/Effects/Tremolo.hs b/DobutokO/Sound/Effects/Tremolo.hs new file mode 100644 index 0000000..7d46c48 --- /dev/null +++ b/DobutokO/Sound/Effects/Tremolo.hs @@ -0,0 +1,63 @@ +-- | +-- Module : DobutokO.Sound.Effects.Tremolo +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"tremolo\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Tremolo 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 + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data Tremolo a = TL1 a | TL2 a a deriving Eq + +instance Show (Tremolo Float) where + show (TL1 x) = mconcat ["tremolo ", showFFloat Nothing (abs x) " "] + show (TL2 x y) = mconcat ["tremolo ", showFFloat Nothing (abs x) " ", showFFloat Nothing (toRange 100.0 (abs y)) " "] + +type Treml = Tremolo Float + +tremoloC :: Tremolo a -> String +tremoloC (TL1 _) = "TL1" +tremoloC _ = "TL2" + +tremolo1 :: Tremolo a -> a +tremolo1 (TL1 x) = x +tremolo1 (TL2 x _) = x + +tremolo2 :: Tremolo a -> Maybe a +tremolo2 (TL2 _ y) = Just y +tremolo2 _ = Nothing + +tremoloSet1 :: a -> Tremolo a -> Tremolo a +tremoloSet1 x (TL2 _ y) = TL2 x y +tremoloSet1 x _ = TL1 x + +tremoloSet2 :: a -> Tremolo a -> Tremolo a +tremoloSet2 y (TL2 x _) = TL2 x y +tremoloSet2 y (TL1 x) = TL2 x y + +showTLQ :: Treml -> [String] +showTLQ = words . show diff --git a/DobutokO/Sound/Effects/Trim.hs b/DobutokO/Sound/Effects/Trim.hs new file mode 100644 index 0000000..5f30bdb --- /dev/null +++ b/DobutokO/Sound/Effects/Trim.hs @@ -0,0 +1,34 @@ +-- | +-- Module : DobutokO.Sound.Effects.Trim +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"trim\" effect with the needed time specifications. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances #-} + +module DobutokO.Sound.Effects.Trim where + +import DobutokO.Sound.Effects.Timespec + + +data Trim a = Trim a deriving Eq + +instance Show (Trim TSpecification) where + show (Trim x) = mconcat ["trim ",show x] + +trim1 :: Trim a -> a +trim1 (Trim x) = x + +trimSet1 :: a -> Trim a +trimSet1 x = Trim x + +type Trim1 = Trim TSpecification + +showTrimQ :: Trim1 -> [String] +showTrimQ = words . show diff --git a/DobutokO/Sound/Effects/Upsample.hs b/DobutokO/Sound/Effects/Upsample.hs new file mode 100644 index 0000000..cd41ab5 --- /dev/null +++ b/DobutokO/Sound/Effects/Upsample.hs @@ -0,0 +1,51 @@ +-- | +-- Module : DobutokO.Sound.Effects.Upsample +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"upsample\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Upsample 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 + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data Upsample a = U | US1 a deriving Eq + +instance Show (Upsample Int) where + show (US1 x) = mconcat ["upsample ", if x == 0 then "" else show (abs x) ++ " "] + show _ = "upsample " + +type USample = Upsample Int + +upsampleC :: Upsample a -> String +upsampleC U = "U" +upsampleC _ = "US1" + +upSample1 :: Upsample a -> Maybe a +upSample1 (US1 x) = Just x +upSample1 _ = Nothing + +upSampleSet1 :: a -> Upsample a +upSampleSet1 = US1 + +showUSQ :: USample -> [String] +showUSQ = words . show diff --git a/DobutokO/Sound/Effects/Vad.hs b/DobutokO/Sound/Effects/Vad.hs new file mode 100644 index 0000000..fd95420 --- /dev/null +++ b/DobutokO/Sound/Effects/Vad.hs @@ -0,0 +1,124 @@ +-- | +-- Module : DobutokO.Sound.Effects.Vad +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"vad\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Vad 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.Misc (MscS(..),mscS1) + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data VadP a = T1 a | T a | S1 a | G a | P1 a | B a | N a | N1 a | R a | F a | M1 a | M a | H1 a | L1 a | H a | L a deriving Eq + +instance Show (VadP Float) where + show (T1 x) = mconcat ["-t ", showFFloat Nothing (toRange 20.0 . abs $ x) " "] + show (T x) = mconcat ["-T ", showFFloat Nothing (if compare (toRange 1.0 . abs $ x) 0.01 == LT then 0.01 else toRange 1.0 . abs $ x) " "] + show (S1 x) = mconcat ["-s ", showFFloat Nothing (if compare (toRange 4.0 . abs $ x) 0.1 == LT then 0.1 else toRange 4.0 . abs $ x) " "] + show (G x) = mconcat ["-g ", showFFloat Nothing (if compare (toRange 1.0 . abs $ x) 0.1 == LT then 0.1 else toRange 1.0 . abs $ x) " "] + show (P1 x) = mconcat ["-p ", showFFloat Nothing (toRange 4.0 . abs $ x) " "] + show (B x) = mconcat ["-b ", showFFloat Nothing (if compare (toRange 10.0 . abs $ x) 0.1 == LT then 0.1 else toRange 10.0 . abs $ x) " "] + show (N x) = mconcat ["-N ", showFFloat Nothing (if compare (toRange 10.0 . abs $ x) 0.1 == LT then 0.1 else toRange 10.0 . abs $ x) " "] + show (N1 x) = mconcat ["-n ", showFFloat Nothing (if compare (toRange 0.1 . abs $ x) 0.001 == LT then 0.001 else toRange 0.1 . abs $ x) " "] + show (R x) = mconcat ["-r ", showFFloat Nothing (toRange 2.0 . abs $ x) " "] + show (F x) = mconcat ["-f ", showFFloat Nothing (if compare (toRange 50.0 . abs $ x) 5.0 == LT then 5.0 else toRange 50.0 . abs $ x) " "] + show (M1 x) = mconcat ["-m ", showFFloat Nothing (if compare (toRange 1.0 . abs $ x) 0.01 == LT then 0.01 else toRange 1.0 . abs $ x) " "] + show (M x) = mconcat ["-M ", showFFloat Nothing (if compare (toRange 1.0 . abs $ x) 0.1 == LT then 0.1 else toRange 1.0 . abs $ x) " "] + show (H1 x) = mconcat ["-h ", showFFloat Nothing (abs x) " "] + show (L1 x) = mconcat ["-l ", showFFloat Nothing (abs x) " "] + show (H x) = mconcat ["-H ", showFFloat Nothing (abs x) " "] + show (L x) = mconcat ["-L ", showFFloat Nothing (abs x) " "] + +type VadP1 = VadP Float + +vadPC :: VadP a -> String +vadPC (T1 _) = "T1" +vadPC (T _) = "T" +vadPC (S1 _) = "S1" +vadPC (G _) = "G" +vadPC (P1 _) = "P1" +vadPC (B _) = "B" +vadPC (N _) = "N" +vadPC (N1 _) = "N1" +vadPC (R _) = "R" +vadPC (F _) = "F" +vadPC (M1 _) = "M1" +vadPC (M _) = "M" +vadPC (H1 _) = "H1" +vadPC (L1 _) = "L1" +vadPC (H _) = "H" +vadPC (L _) = "L" + +vadP1 :: VadP a -> a +vadP1 (T1 x) = x +vadP1 (T x) = x +vadP1 (S1 x) = x +vadP1 (G x) = x +vadP1 (P1 x) = x +vadP1 (B x) = x +vadP1 (N x) = x +vadP1 (N1 x) = x +vadP1 (R x) = x +vadP1 (F x) = x +vadP1 (M1 x) = x +vadP1 (M x) = x +vadP1 (H1 x) = x +vadP1 (L1 x) = x +vadP1 (H x) = x +vadP1 (L x) = x + +vadPSet1 :: a -> VadP a -> VadP a +vadPSet1 x (T1 _) = T1 x +vadPSet1 x (T _) = T x +vadPSet1 x (S1 _) = S1 x +vadPSet1 x (G _) = G x +vadPSet1 x (P1 _) = P1 x +vadPSet1 x (B _) = B x +vadPSet1 x (N _) = N x +vadPSet1 x (N1 _) = N1 x +vadPSet1 x (R _) = R x +vadPSet1 x (F _) = F x +vadPSet1 x (M1 _) = M1 x +vadPSet1 x (M _) = M x +vadPSet1 x (H1 _) = H1 x +vadPSet1 x (L1 _) = L1 x +vadPSet1 x (H _) = H x +vadPSet1 x (L _) = L x + +data Vad1 a = VD (MscS a) deriving Eq + +instance Show (Vad1 VadP1) where + show (VD x) = mconcat ["vad ", show x] + +type Vad = Vad1 VadP1 + +vad11 :: Vad1 a -> [a] +vad11 (VD x) = mscS1 x + +vad1Set1 :: [a] -> Vad1 a -> Vad1 a +vad1Set1 xs (VD (Msc _)) = VD (Msc xs) + +showVDQ :: Vad -> [String] +showVDQ = words . show diff --git a/DobutokO/Sound/Effects/Vol.hs b/DobutokO/Sound/Effects/Vol.hs new file mode 100644 index 0000000..37c9901 --- /dev/null +++ b/DobutokO/Sound/Effects/Vol.hs @@ -0,0 +1,85 @@ +-- | +-- Module : DobutokO.Sound.Effects.Vol +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX \"vol\" effect. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE CPP, FlexibleInstances #-} + +module DobutokO.Sound.Effects.Vol 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 + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data VolType = N | A | P | D deriving Eq + +instance Show VolType where + show A = "amplitude " + show P = "power " + show D = "dB " + show _ = "" + +data Vol2 a b = V1 a | V2 a b | V3 a b a deriving Eq + +instance Show (Vol2 Float VolType) where + show (V1 x) = mconcat ["vol ", showFFloat Nothing x " "] + show (V2 x y) = mconcat ["vol ", showFFloat Nothing x " ", show y] + show (V3 x y z) = mconcat ["vol ", showFFloat Nothing x " ", show y, showFFloat Nothing (toRange 0.1 (abs z)) " "] + +type Vol = Vol2 Float VolType + +volC :: Vol2 a b -> String +volC (V1 _) = "V1" +volC (V2 _ _) = "V2" +volC (V3 _ _ _) = "V3" + +vol1 :: Vol2 a b -> a +vol1 (V1 x) = x +vol1 (V2 x _) = x +vol1 (V3 x _ _) = x + +vol2 :: Vol2 a b -> Maybe b +vol2 (V2 _ y) = Just y +vol2 (V3 _ y _) = Just y +vol2 _ = Nothing + +vol3 :: Vol2 a b -> Maybe a +vol3 (V3 _ _ z) = Just z +vol3 _ = Nothing + +volSet1 :: a -> Vol2 a b -> Vol2 a b +volSet1 x (V1 _) = V1 x +volSet1 x (V2 _ y) = V2 x y +volSet1 x (V3 _ y z) = V3 x y z + +volSet2 :: b -> Vol2 a b -> Vol2 a b +volSet2 y (V1 x) = V2 x y +volSet2 y (V2 x _) = V2 x y +volSet2 y (V3 x _ z) = V3 x y z + +volSet3 :: Float -> Vol -> Vol +volSet3 x (V1 x1) = V3 x1 N x +volSet3 x (V2 x1 y) = V3 x1 y x +volSet3 x (V3 x1 y _) = V3 x1 y x + +showVQ :: Vol -> [String] +showVQ = words . show diff --git a/DobutokO/Sound/One.hs b/DobutokO/Sound/One.hs new file mode 100644 index 0000000..c4ceede --- /dev/null +++ b/DobutokO/Sound/One.hs @@ -0,0 +1,69 @@ +-- | +-- Module : DobutokO.Sound.One +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Can be used for applying the SoX effects. +-- + +{-# OPTIONS_GHC -threaded #-} +{-# LANGUAGE FlexibleInstances #-} + +module DobutokO.Sound.One where + +data One2 a = O21 a | O22 a a deriving Eq + +one2C :: One2 a -> String +one2C (O21 _) = "O21" +one2C (O22 _ _) = "O22" + +one21 :: One2 a -> [a] +one21 (O21 x) = [x] +one21 (O22 x y) = [x,y] + +one2Set1 :: a -> One2 a -> One2 a +one2Set1 x (O21 _) = O21 x +one2Set1 x (O22 _ y) = O22 x y + +one2Set2 :: a -> One2 a -> One2 a +one2Set2 y (O21 x) = O22 x y +one2Set2 y (O22 x _) = O22 x y + +one2toList :: One2 a -> [a] +one2toList (O21 x) = [x] +one2toList (O22 x y) = [x,y] + +data One3 a = O31 a | O32 a a | O33 a a a deriving Eq + +one3C :: One3 a -> String +one3C (O31 _) = "O31" +one3C (O32 _ _) = "O32" +one3C (O33 _ _ _) = "O33" + +one31 :: One3 a -> [a] +one31 (O31 x) = [x] +one31 (O32 x y) = [x,y] +one31 (O33 x y z) = [x,y,z] + +one3Set1 :: a -> One3 a -> One3 a +one3Set1 x (O31 _) = O31 x +one3Set1 x (O32 _ y) = O32 x y +one3Set1 x (O33 _ y z) = O33 x y z + +one3Set2 :: a -> One3 a -> One3 a +one3Set2 y (O31 x) = O32 x y +one3Set2 y (O32 x _) = O32 x y +one3Set2 y (O33 x _ z) = O33 x y z + +one3Set3 :: a -> One3 a -> Maybe (One3 a) +one3Set3 z (O32 x y) = Just (O33 x y z) +one3Set3 z (O33 x y _) = Just (O33 x y z) +one3Set3 _ _ = Nothing + +one3toList :: One3 a -> [a] +one3toList (O31 x) = [x] +one3toList (O32 x y) = [x, y] +one3toList (O33 x y z) = [x, y, z] diff --git a/DobutokO/Sound/ToRange.hs b/DobutokO/Sound/ToRange.hs new file mode 100644 index 0000000..57f0c96 --- /dev/null +++ b/DobutokO/Sound/ToRange.hs @@ -0,0 +1,20 @@ +-- | +-- Module : DobutokO.Sound.ToRange +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to create experimental music. +-- Auxiliary module to re-position the number to the needed range. +-- + +{-# OPTIONS_GHC -threaded #-} + +module DobutokO.Sound.ToRange where + +toRange :: Float -> Float -> Float +toRange range x + | range /= 0.0 = (x / range - fromIntegral (truncate (x / range))) * range + | otherwise = error "DobutokO.Sound.ToRange.toRange: Zero range. " + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..2eaab6b --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2020 OleksandrZhabenko + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.markdown b/README.markdown new file mode 100644 index 0000000..304d1a8 --- /dev/null +++ b/README.markdown @@ -0,0 +1,8 @@ + ***** Analysis of the Usage of Classes for the Version 0.12.0.0 ***** + --------------------------------------------------------------------- + +The information about usage of the classes for the version 0.12.0.0 can be found here: +https://web.archive.org/web/20200723125904/https://oleksandrzhabenko.github.io/en/Classification_of_the_dobutokO-effects_classes-4_Pages.pdf + +The document is produced by using the Google Spreadsheets functionality. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/dobutokO-effects.cabal b/dobutokO-effects.cabal new file mode 100644 index 0000000..00146ea --- /dev/null +++ b/dobutokO-effects.cabal @@ -0,0 +1,25 @@ +-- Initial dobutokO-effects.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: dobutokO-effects +version: 0.13.0.0 +synopsis: A library to deal with SoX effects and possibilities +description: Can be used to get access to different SoX possibilities +homepage: https://hackage.haskell.org/package/dobutokO-effects +license: MIT +license-file: LICENSE +author: OleksandrZhabenko +maintainer: olexandr543@yahoo.com +copyright: (c) 2020 Oleksandr Zhabenko +category: Sound, Music +build-type: Simple +extra-source-files: ChangeLog.md, README.markdown +cabal-version: >=1.10 + +library + exposed-modules: DobutokO.Sound.Combine, DobutokO.Sound.ToRange, DobutokO.Sound.One, DobutokO.Sound.Effects.Reverb, DobutokO.Sound.Effects.Fade, DobutokO.Sound.Effects.Remix, DobutokO.Sound.Effects.Timespec, DobutokO.Sound.Effects.Delay, DobutokO.Sound.Effects.Specs, DobutokO.Sound.Effects.PassReject, DobutokO.Sound.Effects.BassTreble, DobutokO.Sound.Effects.Trim, DobutokO.Sound.Effects.Repeat, DobutokO.Sound.Effects.Phaser, DobutokO.Sound.Effects.Chorus, DobutokO.Sound.Effects.Modulation2, DobutokO.Sound.Effects.Echo, DobutokO.Sound.Effects.Misc, DobutokO.Sound.Effects.Channels, DobutokO.Sound.Effects.Bend, DobutokO.Sound.Effects.Segment, DobutokO.Sound.Effects.Pitch, DobutokO.Sound.Effects.Tempo, DobutokO.Sound.Effects.Speed, DobutokO.Sound.Effects.Biquad, DobutokO.Sound.Effects.Contrast, DobutokO.Sound.Effects.DCShift, DobutokO.Sound.Effects.Downsample, DobutokO.Sound.Effects.Upsample, DobutokO.Sound.Effects.Hilbert, DobutokO.Sound.Effects.Loudness, DobutokO.Sound.Effects.Overdrive, DobutokO.Sound.Effects.Tremolo, DobutokO.Sound.Effects.Noise, DobutokO.Sound.Effects.Pad, DobutokO.Sound.Effects.MCompand, DobutokO.Sound.Effects.Dither, DobutokO.Sound.Effects.FIR, DobutokO.Sound.Effects.Flanger, DobutokO.Sound.Effects.Gain, DobutokO.Sound.Effects.LADSPA, DobutokO.Sound.Effects.Rate, DobutokO.Sound.Effects.Vol, DobutokO.Sound.Effects.Silence, DobutokO.Sound.Effects.Sinc, DobutokO.Sound.Effects.Stretch, DobutokO.Sound.Effects.Spectrogram, DobutokO.Sound.Effects.Splice, DobutokO.Sound.Effects.Stat, DobutokO.Sound.Effects.Stats, DobutokO.Sound.Effects.Vad, DobutokO.Sound.Effects.Classes.FstParam, DobutokO.Sound.Effects.Classes.SndParam, DobutokO.Sound.Effects.Classes.ThdParam, DobutokO.Sound.Effects.Classes.FourthParam, DobutokO.Sound.Effects.Classes.FstParamSet, DobutokO.Sound.Effects.Classes.SndParamSet, DobutokO.Sound.Effects.Classes.ThdParamSet, DobutokO.Sound.Effects.Classes.FourthParamSet, DobutokO.Sound.Effects.Classes.ComplexParamSet + -- other-modules: + other-extensions: CPP, FlexibleInstances, MultiParamTypeClasses + build-depends: base >=4.7 && <4.15, dobutokO-frequency >=0.1 && <1 + -- hs-source-dirs: + default-language: Haskell2010