diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -29,3 +29,8 @@ ## 0.5.0.0 -- 2020-06-19 * Fifth version. Added new functions that allow to reduce unpleasant noise for the sounds created with DobutokO.Sound.Faded module functions. + +## 0.6.0.0 -- 2020-06-23 + +* Sixth version. Changed a lot of Double arguments in the DobutokO.Sound.Faded to Float ones. This change is inspired by: https://www.youtube.com/watch?v=FYTZkE5BZ-0 + diff --git a/DobutokO/Sound/Faded.hs b/DobutokO/Sound/Faded.hs --- a/DobutokO/Sound/Faded.hs +++ b/DobutokO/Sound/Faded.hs @@ -6,7 +6,11 @@ -- Maintainer : olexandr543@yahoo.com -- -- Helps to create experimental music. --- Uses SoX fade (in a special 2D way) effect and frequency modulation. +-- Uses SoX fade (in a special 2D way) effect and frequency modulation. +-- Since 0.6.0.0 version it uses 'Float' instead of 'Double'. This change is inspired by: +-- https://www.youtube.com/watch?v=FYTZkE5BZ-0 +-- For conversion it uses functions from the 'GHC.Float' module. +-- {-# OPTIONS_GHC -threaded #-} {-# LANGUAGE CPP #-} @@ -48,6 +52,7 @@ , charFadeType , argString , freqChange + , double42Float4 -- * Special numbers , sameConst ) where @@ -70,6 +75,7 @@ import DobutokO.Sound.Functional.Basics import DobutokO.Sound.IntermediateF (soxBasicParams) import Data.Vector.DoubleZip (evalSndFV) +import GHC.Float (float2Double,double2Float) #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__==708 @@ -78,82 +84,85 @@ #endif #endif +double42Float4 :: ((Double,Double), (Double,Double)) -> ((Float,Float), (Float,Float)) +double42Float4 ((x,y),(z,t)) = ((double2Float x,double2Float y),(double2Float z,double2Float t)) + -- | Generates a sound, the volume of which (being plotted graphically) comes through the given 2D points at the time-volume scale with possibly -- changing frequency (they are specified by the first and the second 'Double' arguments). Uses SoX inside especially the \"fade\" and \"synth\" effects. -- For the equal frequencies generates specifically faded output without frequency modulation. -overChangeVolG :: String -> String -> Int -> Double -> Double -> Double -> Double -> ((Double,Double), (Double,Double)) -> IO () +overChangeVolG :: String -> String -> Int -> Float -> Float -> Float -> Float -> ((Double,Double), (Double,Double)) -> IO () overChangeVolG = overChangeVolGN "test" -- | A generalized version of the 'overChangeVolG' with a possibility to specify the name of the resulting file (by default it is \"test\" based). -overChangeVolGN :: FilePath -> String -> String -> Int -> Double -> Double -> Double -> Double -> ((Double,Double), (Double,Double)) -> IO () +overChangeVolGN :: FilePath -> String -> String -> Int -> Float -> Float -> Float -> Float -> ((Double,Double), (Double,Double)) -> IO () overChangeVolGN filestart ys cs j freq1 freq2 x0 xdelta ((t0,v0), (t1,v1)) - | x0 /= 0 && compare (abs x0) 1.0 /= GT && compare freq1 16 == GT && compare freq1 20000 == LT = - case compare (v1 * v0) 0 of + | x0 /= 0 && compare (abs x0) 1.0 /= GT && compare freq1 16 == GT && compare freq1 20000 == LT = let ((t0F,v0F), (t1F,v1F)) = double42Float4 ((t0,v0), (t1,v1)) in + case compare (v1F * v0F) 0 of GT -> do - (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n","test1.wav","synth", - showFFloat Nothing (if t1 == t0 then abs x0 else abs (t1 - t0)) "", "sine", showFFloat (Just 4) freq1 (freqChange (drop 1 cs) freq2 freq1), "fade", + (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n","test1F.wav","synth", + showFFloat Nothing (if t1F == t0F then abs x0 else abs (t1F - t0F)) "", "sine", showFFloat (Just 4) freq1 (freqChange (drop 1 cs) freq2 freq1), "fade", charFadeType (if null cs then 'l' else head cs)] ++ - if compare ((v1 - v0) * (t1 - t0)) 0 /= LT then [showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) ""] - else ["0", "-0.0", showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "vol", - showFFloat (Just 4) (signum v1 * abs (v1 - v0)) ""]) "" + if compare ((v1F - v0F) * (t1F - t0F)) 0 /= LT then [showFFloat Nothing (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) ""] + else ["0", "-0.0", showFFloat Nothing (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) "", "vol", + showFFloat (Just 4) (signum v1F * abs (v1F - v0F)) ""]) "" if code1 /= ExitSuccess then error $ "DobutokO.Sound.Faded.overChangeVolGN: " ++ herr1 else do - (code2,_,herr2) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n","test0.wav","synth", - showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "sine", - showFFloat (Just 4) freq1 (freqChange (drop 1 cs) freq2 freq1), "vol", showFFloat (Just 4) (min v0 v1) ""]) "" + (code2,_,herr2) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n","test0F.wav","synth", + showFFloat Nothing (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) "", "sine", + showFFloat (Just 4) freq1 (freqChange (drop 1 cs) freq2 freq1), "vol", showFFloat (Just 4) (min v0F v1F) ""]) "" if code2 == ExitSuccess then do - (code3,_,herr3) <- readProcessWithExitCode (fromJust (showE "sox")) ["-m","test0" ++ endingWF ys,"test1" ++ endingWF ys, (filestart ++ "G") ++ + (code3,_,herr3) <- readProcessWithExitCode (fromJust (showE "sox")) ["-m","test0F" ++ endingWF ys,"test1F" ++ endingWF ys, (filestart ++ "G") ++ prependZeroes 6 (show j) ++ endingWF ys, "vol", "2"] "" if code3 == ExitSuccess - then removeFile ("test0" ++ endingWF ys) >> removeFile ("test1" ++ endingWF ys) + then removeFile ("test0F" ++ endingWF ys) >> removeFile ("test1F" ++ endingWF ys) else error $ "DobutokO.Sound.Faded.overChangeVolGN: " ++ herr3 else print herr2 >> error "DobutokO.Sound.Faded.overChangeVolGN: Operation not successful. " LT -> do - overChangeVolGN filestart ys cs j freq1 ((v0 * freq2 - v1 * freq1) / (v0 - v1)) x0 xdelta ((t0,v0), ((v0 * t1 - v1 * t0) / (v0 - v1),0)) >> renameFile ((filestart ++ "G") ++ - prependZeroes 6 (show j) ++ endingWF ys) ("temp00" ++ endingWF ys) + overChangeVolGN filestart ys cs j freq1 ((v0F * freq2 - v1F * freq1) / (v0F - v1F)) x0 xdelta ((t0,v0), ((v0 * t1 - v1 * t0) / (v0 - v1),0)) >> + renameFile ((filestart ++ "G") ++ prependZeroes 6 (show j) ++ endingWF ys) ("temp00" ++ endingWF ys) (code0,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["temp00" ++ endingWF ys,"temp0" ++ endingWF ys, "fade", "h", "0", "-0.0", showFFloat (Just 6) ((max freq1 freq2) ** (-1.0)) ""] "" if code0 /= ExitSuccess then error (show herr) else do - overChangeVolGN filestart ys cs j ((v0 * freq2 - v1 * freq1) / (v0 - v1)) freq2 x0 xdelta (((v0 * t1 - v1 * t0) / (v0 - v1),0), (t1,v1)) >> renameFile ((filestart ++ "G") ++ - prependZeroes 6 (show j) ++ endingWF ys) ("temp1" ++ endingWF ys) + overChangeVolGN filestart ys cs j ((v0F * freq2 - v1F * freq1) / (v0F - v1F)) freq2 x0 xdelta (((v0 * t1 - v1 * t0) / (v0 - v1),0), (t1,v1)) >> + renameFile ((filestart ++ "G") ++ prependZeroes 6 (show j) ++ endingWF ys) ("temp1" ++ endingWF ys) (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) ["temp0" ++ endingWF ys,"temp1" ++ endingWF ys, (filestart ++ "G") ++ prependZeroes 6 (show j) ++ endingWF ys] "" if code1 == ExitSuccess then removeFile ("temp0" ++ endingWF ys) >> removeFile ("temp1" ++ endingWF ys) >> removeFile ("temp00" ++ endingWF ys) else error $ "DobutokO.Sound.Faded.overChangeVolGN: " ++ herr1 _ -> - case v1 of + case v1F of 0 -> - if v0 == 0 + if v0F == 0 then do (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n",(filestart ++ "G") ++ prependZeroes 6 (show j) ++ - ".wav","delay", showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "trim", showFFloat Nothing - (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) ""]) "" + ".wav","delay", showFFloat Nothing (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) "", "trim", showFFloat Nothing + (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) ""]) "" if code1 /= ExitSuccess then error $ "DobutokO.Sound.Faded.overChangeVolGN: " ++ herr1 else return () else do (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n",(filestart ++ "G") ++ prependZeroes 6 (show j) ++ - ".wav","synth", showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "sine", + ".wav","synth", showFFloat Nothing (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) "", "sine", showFFloat (Just 4) freq1 (freqChange (drop 1 cs) freq2 freq1), "fade", charFadeType (if null cs then 'l' else head cs)] ++ - if compare t0 t1 == GT then [showFFloat Nothing - (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) ""] else ["0", "-0.0", showFFloat Nothing - (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "vol", showFFloat (Just 4) v0 ""]) "" + if compare t0F t1F == GT then [showFFloat Nothing + (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) ""] else ["0", "-0.0", showFFloat Nothing + (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) "", "vol", showFFloat (Just 4) v0F ""]) "" if code1 /= ExitSuccess then error $ "DobutokO.Sound.Faded.overChangeVolGN: " ++ herr1 else return () _ -> do (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n",(filestart ++ "G") ++ prependZeroes 6 (show j) ++ ".wav", - "synth", showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "sine", + "synth", showFFloat Nothing (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) "", "sine", showFFloat (Just 4) freq1 (freqChange (drop 1 cs) freq2 freq1), "fade", charFadeType (if null cs then 'l' else head cs)] ++ - if compare t1 t0 == GT - then [showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 - else abs (t1 - t0)) ""] else ["0", "-0.0", showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", - "vol", showFFloat (Just 4) v1 ""]) "" + if compare t1F t0F == GT + then [showFFloat Nothing (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 + else abs (t1F - t0F)) ""] else ["0", "-0.0", showFFloat Nothing (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) "", + "vol", showFFloat (Just 4) v1F ""]) "" if code1 /= ExitSuccess then error $ "DobutokO.Sound.Faded.overChangeVolGN: " ++ herr1 else return () | otherwise = error "DobutokO.Sound.Faded.overChangeVolGN: sound for these conditions is not defined. " -freqChange :: String -> Double -> Double -> String +freqChange :: String -> Float -> Float -> String freqChange xs freq freq1 | compare freq 16 /= LT && compare freq 20000 /= GT = if freq /= freq1 then case xs of @@ -162,56 +171,56 @@ "e" -> '/':showFFloat (Just 4) freq "" _ -> '-':showFFloat (Just 4) freq "" else "" - | otherwise = error "DobutokO.Sound.Faded.freqChange: undefined for this value of the frequency (the first Double argument). " + | otherwise = error "DobutokO.Sound.Faded.freqChange: undefined for this value of the frequency (the first Float argument). " -- | Generates a sound, the volume of which (being plotted graphically) comes through the given 2D points at the time-volume scale. Uses SoX inside -- especially the \"fade\" and \"synth\" effects. A frequency does not change and is specified (in Hz) by the first 'Double' argument. -overChangeVol :: String -> Char -> Int -> Double -> Double -> Double -> ((Double,Double), (Double,Double)) -> IO () +overChangeVol :: String -> Char -> Int -> Float -> Float -> Float -> ((Double,Double), (Double,Double)) -> IO () overChangeVol ys c j freq1 = overChangeVolGN "test" ys [c] j freq1 freq1 -- | A generalized version of the 'overChangeVol' with a possibility to specify the name for the mixed files (by default is \"test\" based). -overChangeVolN :: FilePath -> String -> Char -> Int -> Double -> Double -> Double -> ((Double,Double), (Double,Double)) -> IO () +overChangeVolN :: FilePath -> String -> Char -> Int -> Float -> Float -> Float -> ((Double,Double), (Double,Double)) -> IO () overChangeVolN filestart ys c j freq1 = overChangeVolGN filestart ys [c] j freq1 freq1 -- | Generates a sound, the volume of which (being plotted graphically) comes through the given 2D points in the time-volume scale. Uses SoX inside especially -- the \"fade\" and \"synth\" effects. A frequency does not change and is specified (in Hz) by the first 'Double' argument. Is a curried variant of the -- 'overChangeVol' in its two last arguments. -overChangeVolC :: String -> Char -> Int -> Double -> Double -> Double -> (Double,Double) -> (Double,Double) -> IO () +overChangeVolC :: String -> Char -> Int -> Float -> Float -> Float -> (Double,Double) -> (Double,Double) -> IO () overChangeVolC ys c j freq x0 xdelta w1 = overChangeVol ys c j freq x0 xdelta . (,) w1 -- | A generalized version of the 'overChangeVolC' with a possibility to specify the name for the mixed files (by default is \"test\" based). -overChangeVolCN :: FilePath -> String -> Char -> Int -> Double -> Double -> Double -> (Double,Double) -> (Double,Double) -> IO () +overChangeVolCN :: FilePath -> String -> Char -> Int -> Float -> Float -> Float -> (Double,Double) -> (Double,Double) -> IO () overChangeVolCN filestart ys c j freq x0 xdelta w1 = overChangeVolN filestart ys c j freq x0 xdelta . (,) w1 -- | Generates a sound, the volume of which (being plotted graphically) comes through the given 2D points in the time-volume scale with possibly changing frequency (they are specified by -- the first and the second 'Double' arguments). Uses SoX inside especially the \"fade\" and \"synth\" effects. For the equal frequencies generates specifically -- faded output without frequency modulation. Is a curried variant of the 'overChangeVolG' in its two last arguments. -overChangeVolGC :: String -> String -> Int -> Double -> Double -> Double -> Double -> (Double,Double) -> (Double,Double) -> IO () +overChangeVolGC :: String -> String -> Int -> Float -> Float -> Float -> Float -> (Double,Double) -> (Double,Double) -> IO () overChangeVolGC ys cs j freq1 freq2 x0 xdelta w1 = overChangeVolG ys cs j freq1 freq2 x0 xdelta . (,) w1 -- | A generalized version of the 'overChangeVolGC' with a possibility to specify the name for the mixed files (by default is \"test\" based). -overChangeVolGCN :: FilePath -> String -> String -> Int -> Double -> Double -> Double -> Double -> (Double,Double) -> (Double,Double) -> IO () +overChangeVolGCN :: FilePath -> String -> String -> Int -> Float -> Float -> Float -> Float -> (Double,Double) -> (Double,Double) -> IO () overChangeVolGCN filestart ys cs j freq1 freq2 x0 xdelta w1 = overChangeVolGN filestart ys cs j freq1 freq2 x0 xdelta . (,) w1 -- | Generates a sound, the volume of which (being plotted graphically) comes through the given 2D points in the time-volume scale. Uses SoX inside especially -- the \"fade\" and \"synth\" effects. Is a somewhat flipped variant of the 'overChangeVol' with changed order of the arguments (is provided here -- for convenience). -overChangeVolF :: String -> Char -> Int -> Double -> Double -> (Double,Double) -> (Double,Double) -> Double -> IO () +overChangeVolF :: String -> Char -> Int -> Float -> Float -> (Double,Double) -> (Double,Double) -> Float -> IO () overChangeVolF ys c j x0 xdelta w1 w2 freq = overChangeVol ys c j freq x0 xdelta (w1,w2) -- | A generalized version of the 'overChangeVolF' with a possibility to specify the name for the mixed files (by default is \"test\" based). -overChangeVolFN :: FilePath -> String -> Char -> Int -> Double -> Double -> (Double,Double) -> (Double,Double) -> Double -> IO () +overChangeVolFN :: FilePath -> String -> Char -> Int -> Float -> Float -> (Double,Double) -> (Double,Double) -> Float -> IO () overChangeVolFN filestart ys c j x0 xdelta w1 w2 freq = overChangeVolN filestart ys c j freq x0 xdelta (w1,w2) -- | Generates a sound, the volume of which (being plotted graphically) comes through the given 2D points in the time-volume scale with possibly -- changing frequency (they are specified by the first and the second 'Double' arguments). Uses SoX inside especially the \"fade\" and \"synth\" effects. -- For the equal frequencies generates specifically faded output without frequency modulation. Is a somewhat flipped variant of the 'overChangeVolGC' -- with changed order of the arguments (is provided here for convenience). -overChangeVolGF :: String -> String -> Int -> Double -> Double -> (Double,Double) -> (Double,Double) -> Double -> Double -> IO () +overChangeVolGF :: String -> String -> Int -> Float -> Float -> (Double,Double) -> (Double,Double) -> Float -> Float -> IO () overChangeVolGF ys cs j x0 xdelta w1 w2 freq1 freq2 = overChangeVolG ys cs j freq1 freq2 x0 xdelta (w1,w2) -- | A generalized version of the 'overChangeVolGF' with a possibility to specify the name for the mixed files (by default is \"test\" based). -overChangeVolGFN :: FilePath -> String -> String -> Int -> Double -> Double -> (Double,Double) -> (Double,Double) -> Double -> Double -> IO () +overChangeVolGFN :: FilePath -> String -> String -> Int -> Float -> Float -> (Double,Double) -> (Double,Double) -> Float -> Float -> IO () overChangeVolGFN filestart ys cs j x0 xdelta w1 w2 freq1 freq2 = overChangeVolGN filestart ys cs j freq1 freq2 x0 xdelta (w1,w2) -- | A simplified variant of the 'soxBasicParameters' function with defining only a file extension. @@ -252,7 +261,7 @@ -- | Generates a sequence of sounds using 'overChangeVol' so that their time-volume characteristic is going through the 2D points obtained -- with the last two arguments. -- Uses 'fadeEndsTMB', the arguments for which are specified by the second symbol in the second 'String' and by the third 'Double' argument. -basicF :: String -> String -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () +basicF :: String -> String -> Float -> Float -> Float -> Double -> (Double -> Double) -> V.Vector Double -> IO () basicF ys x2s freq x0 xdelta per f v = do let (xs1,xs2) = splitAt 1 x2s c1 = if null xs1 then 'l' else head xs1 @@ -263,7 +272,7 @@ fadeEndsTMB c2 per $ "testG" ++ prependZeroes 6 (show i) ++ endingWF ys) v1 -- | A generalized version of the 'basicF' with a possibility to specify the name for the generated files (by default is \"test\" based). -basicFN :: FilePath -> String -> String -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () +basicFN :: FilePath -> String -> String -> Float -> Float -> Float -> Double -> (Double -> Double) -> V.Vector Double -> IO () basicFN filestart ys x2s freq x0 xdelta per f v = do let (xs1,xs2) = splitAt 1 x2s c1 = if null xs1 then 'l' else head xs1 @@ -283,21 +292,21 @@ -- The 'String' should consist of 6 alphanumeric characters. The first four as for the 'soxBasicParams', and the fifth one -- a letter from the \"hlpqt\". The -- sixth one is one of the \"els\" or some other symbol. -- Otherwise, the default values are used (\"221w\" for the first and \"ll\" for the second one). -basicFC :: String -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () +basicFC :: String -> Float -> Float -> Float -> Double -> (Double -> Double) -> V.Vector Double -> IO () basicFC = basicFCN "test" -- | A generalized version of the 'basicFC' with a possibility to specify the name for the mixed files (by default is \"test\" based). -basicFCN :: FilePath -> String -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () +basicFCN :: FilePath -> String -> Float -> Float -> Float -> Double -> (Double -> Double) -> V.Vector Double -> IO () basicFCN filestart xs freq x0 xdelta per f v = let (ys,x2s) = argString xs in basicFN filestart ys x2s freq x0 xdelta per f v -- | Generates a sequence of sounds using 'overChangeVol' so that their time-volume characteristic (if being plotted graphically) is going through the 2D points obtained -- with the last two arguments. -- Uses 'fadeEndsTMN', the arguments for which are specified by the second symbol in the second 'String' and by the third and fourth 'Double' arguments. -basicF2 :: String -> String -> Double -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () +basicF2 :: String -> String -> Float -> Float -> Float -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () basicF2 = basicF2N "test" -- | A generalized version of the 'basicF2' with a possibility to specify the name for the mixed files (by default is \"test\" based). -basicF2N :: FilePath -> String -> String -> Double -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () +basicF2N :: FilePath -> String -> String -> Float -> Float -> Float -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () basicF2N filestart ys x2s freq x0 xdelta per1 per2 f v = do let (xs1,xs2) = splitAt 1 x2s c1 = if null xs1 then 'l' else head xs1 @@ -312,15 +321,15 @@ -- The 'String' should consist of 6 alphanumeric characters. The first four as for the 'soxBasicParams' and the the fifth one -- a letter -- from the \"hlpqt\". The sixth one is one of the \"els\" or some other symbol. Otherwise, the default values are used (\"221w\" for the first -- and \"ll\" for the second one). -basicF2C :: String -> Double -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () +basicF2C :: String -> Float -> Float -> Float -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () basicF2C = basicF2CN "test" -- | A generalized version of the 'basicF2C' with a possibility to specify the name for the mixed files (by default is \"test\" based). -basicF2CN :: FilePath -> String -> Double -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () +basicF2CN :: FilePath -> String -> Float -> Float -> Float -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () basicF2CN filestart xs freq x0 xdelta per1 per2 f v = let (ys,x2s) = argString xs in basicF2N filestart ys x2s freq x0 xdelta per1 per2 f v -- | A generalized version of the 'basicFN' with a frequency modulation. -moreFN :: FilePath -> String -> String -> Double -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () +moreFN :: FilePath -> String -> String -> Float -> Float -> Float -> Float -> Double -> (Double -> Double) -> V.Vector Double -> IO () moreFN filestart ys x2s freq1 freq2 x0 xdelta per f v = do let (xs1,xs2) = splitAt 1 x2s c1 = if null xs1 then 'l' else head xs1 @@ -331,52 +340,53 @@ fadeEndsTMB c2 per $ (filestart ++ "G") ++ prependZeroes 6 (show i) ++ endingWF ys) v1 -- | A generalized version of the 'basicFCN' with a frequency modulation. -moreFCN :: FilePath -> String -> Double -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () +moreFCN :: FilePath -> String -> Float -> Float -> Float -> Float -> Double -> (Double -> Double) -> V.Vector Double -> IO () moreFCN filestart xs freq1 freq2 x0 xdelta per f v = let (ys,x2s) = argString xs in moreFN filestart ys x2s freq1 freq2 x0 xdelta per f v -------------------------------------------------------------------------------------------- -- | Approximately equals to 2 ** (1/48) if the argument is zero (0) and the inverse value otherwise. -sameConst :: Int -> Double +sameConst :: Int -> Float sameConst i | i == 0 = 0.1 * (7.0 + pi) | otherwise = 10.0 / (7.0 + pi) -- | A generalized version of the 'overChangeVolGN' with a possibility to make lower the noisy clipping by specifying the first parameter. The default parameter -- \"rev\" it uses reverberation to transform the distortion on the edges in case of existing root on fro the 2D line connection points. -overChangeVolGNC :: String -> FilePath -> String -> String -> Int -> Double -> Double -> Double -> Double -> ((Double,Double), (Double,Double)) -> IO () +overChangeVolGNC :: String -> FilePath -> String -> String -> Int -> Float -> Float -> Float -> Float -> ((Double,Double), (Double,Double)) -> IO () overChangeVolGNC check filestart ys cs j freq1 freq2 x0 xdelta ((t0,v0), (t1,v1)) - | x0 /= 0 && compare (abs x0) 1.0 /= GT && compare freq1 16 == GT && compare freq1 20000 == LT = - case compare (v1 * v0) 0 of + | x0 /= 0 && compare (abs x0) 1.0 /= GT && compare freq1 16 == GT && compare freq1 20000 == LT = let ((t0F,v0F), (t1F,v1F)) = double42Float4 ((t0,v0), (t1,v1)) in + case compare (v1F * v0F) 0 of GT -> do - (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n","test1.wav","synth", - showFFloat Nothing (if t1 == t0 then abs x0 else abs (t1 - t0)) "", "sine", showFFloat (Just 4) freq1 (freqChange (drop 1 cs) freq2 freq1), "fade", + (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n","test1F.wav","synth", + showFFloat Nothing (if t1F == t0F then abs x0 else abs (t1F - t0F)) "", "sine", showFFloat (Just 4) freq1 (freqChange (drop 1 cs) freq2 freq1), "fade", charFadeType (if null cs then 'l' else head cs)] ++ - if compare ((v1 - v0) * (t1 - t0)) 0 /= LT then [showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) ""] - else ["0", "-0.0", showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "vol", - showFFloat (Just 4) (signum v1 * abs (v1 - v0)) ""]) "" + if compare ((v1F - v0F) * (t1F - t0F)) 0 /= LT then [showFFloat Nothing (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) ""] + else ["0", "-0.0", showFFloat Nothing (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) "", "vol", + showFFloat (Just 4) (signum v1F * abs (v1F - v0F)) ""]) "" if code1 /= ExitSuccess then error $ "DobutokO.Sound.Faded.overChangeVolGNC: " ++ herr1 else do - (code2,_,herr2) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n","test0.wav","synth", - showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "sine", - showFFloat (Just 4) freq1 (freqChange (drop 1 cs) freq2 freq1), "vol", showFFloat (Just 4) (min v0 v1) ""]) "" + (code2,_,herr2) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n","test0F.wav","synth", + showFFloat Nothing (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) "", "sine", + showFFloat (Just 4) freq1 (freqChange (drop 1 cs) freq2 freq1), "vol", showFFloat (Just 4) (min v0F v1F) ""]) "" if code2 == ExitSuccess then do - (code3,_,herr3) <- readProcessWithExitCode (fromJust (showE "sox")) ["-m","test0" ++ endingWF ys,"test1" ++ endingWF ys, (filestart ++ "G") ++ + (code3,_,herr3) <- readProcessWithExitCode (fromJust (showE "sox")) ["-m","test0F" ++ endingWF ys,"test1F" ++ endingWF ys, (filestart ++ "G") ++ prependZeroes 6 (show j) ++ endingWF ys, "vol", "2"] "" if code3 == ExitSuccess - then removeFile ("test0" ++ endingWF ys) >> removeFile ("test1" ++ endingWF ys) + then removeFile ("test0F" ++ endingWF ys) >> removeFile ("test1F" ++ endingWF ys) else error $ "DobutokO.Sound.Faded.overChangeVolGNC: " ++ herr3 else print herr2 >> error "DobutokO.Sound.Faded.overChangeVolGNC: Operation not successful. " LT -> case check of "simple" -> do - overChangeVolGNC check filestart ys cs j freq1 ((v0 * freq2 - v1 * freq1) / (v0 - v1)) x0 xdelta ((t0,v0), ((v0 * t1 - v1 * t0) / (v0 - v1),0)) >> renameFile (( filestart ++ "G") ++ prependZeroes 6 (show j) ++ endingWF ys) ("temp00" ++ endingWF ys) + overChangeVolGNC check filestart ys cs j freq1 ((v0F * freq2 - v1F * freq1) / (v0F - v1F)) x0 xdelta ((t0,v0), ((v0 * t1 - v1 * t0) / (v0 - v1),0)) >> + renameFile ((filestart ++ "G") ++ prependZeroes 6 (show j) ++ endingWF ys) ("temp00" ++ endingWF ys) (code0,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["temp00" ++ endingWF ys,"temp0" ++ endingWF ys, "fade", "h", "0", "-0.0", showFFloat (Just 6) ((max freq1 freq2) ** (-1.0)) ""] "" if code0 /= ExitSuccess then error (show herr) else do - overChangeVolGNC check filestart ys cs j ((v0 * freq2 - v1 * freq1) / (v0 - v1)) freq2 x0 xdelta (((v0 * t1 - v1 * t0) / (v0 - v1),0), (t1,v1)) >> + overChangeVolGNC check filestart ys cs j ((v0F * freq2 - v1F * freq1) / (v0F - v1F)) freq2 x0 xdelta (((v0 * t1 - v1 * t0) / (v0 - v1),0), (t1,v1)) >> renameFile ((filestart ++ "G") ++ prependZeroes 6 (show j) ++ endingWF ys) ("temp1" ++ endingWF ys) (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) ["temp0" ++ endingWF ys,"temp1" ++ endingWF ys, (filestart ++ "G") ++ prependZeroes 6 (show j) ++ endingWF ys] "" @@ -384,10 +394,10 @@ else error $ "DobutokO.Sound.Faded.overChangeVolGNC: " ++ herr1 "silent" -> do (code0,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n","temp0" ++ endingWF ys,"trim", "0", - showFFloat (Just 6) (abs (v0 * (t0 - t1) / (v0 - v1))) "","vol","0"]) "" + showFFloat (Just 6) (abs (v0F * (t0F - t1F) / (v0F - v1F))) "","vol","0"]) "" if code0 /= ExitSuccess then error (show herr) else do - overChangeVolGNC check filestart ys cs j ((v0 * freq2 - v1 * freq1) / (v0 - v1)) freq2 x0 xdelta (((v0 * t1 - v1 * t0) / (v0 - v1),0), (t1,v1)) >> + overChangeVolGNC check filestart ys cs j ((v0F * freq2 - v1F * freq1) / (v0F - v1F)) freq2 x0 xdelta (((v0 * t1 - v1 * t0) / (v0 - v1),0), (t1,v1)) >> renameFile ((filestart ++ "G") ++ prependZeroes 6 (show j) ++ endingWF ys) ("temp1" ++ endingWF ys) (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) ["temp0" ++ endingWF ys,"temp1" ++ endingWF ys, (filestart ++ "G") ++ prependZeroes 6 (show j) ++ endingWF ys] "" @@ -395,49 +405,49 @@ else error $ "DobutokO.Sound.Faded.overChangeVolGNC: " ++ herr1 _ -> do (code0,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n","temp0" ++ endingWF ys,"trim", "0", - showFFloat (Just 6) (abs (v0 * (t0 - t1) / (v0 - v1))) "","vol","0"]) "" + showFFloat (Just 6) (abs (v0F * (t0F - t1F) / (v0F - v1F))) "","vol","0"]) "" if code0 /= ExitSuccess then error (show herr) else do - overChangeVolGNC check filestart ys cs j ((v0 * freq2 - v1 * freq1) / (v0 - v1)) freq2 x0 xdelta (((v0 * t1 - v1 * t0) / (v0 - v1),0), (t1,v1)) >> + overChangeVolGNC check filestart ys cs j ((v0F * freq2 - v1F * freq1) / (v0F - v1F)) freq2 x0 xdelta (((v0 * t1 - v1 * t0) / (v0 - v1),0), (t1,v1)) >> renameFile ((filestart ++ "G") ++ prependZeroes 6 (show j) ++ endingWF ys) ("temp1" ++ endingWF ys) (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) ["temp0" ++ endingWF ys,"temp1" ++ endingWF ys, (filestart ++ "G") ++ prependZeroes 6 (show j) ++ endingWF ys,"reverb","-w","1","1","10","gain","-n","gain","-9"] "" if code1 == ExitSuccess then removeFile ("temp0" ++ endingWF ys) >> removeFile ("temp1" ++ endingWF ys) else error $ "DobutokO.Sound.Faded.overChangeVolGNC: " ++ herr1 _ -> - case v1 of + case v1F of 0 -> - if v0 == 0 + if v0F == 0 then do (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n",(filestart ++ "G") ++ prependZeroes 6 (show j) ++ - ".wav","delay", showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "trim", showFFloat Nothing - (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) ""]) "" + ".wav","delay", showFFloat Nothing (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) "", "trim", showFFloat Nothing + (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) ""]) "" if code1 /= ExitSuccess then error $ "DobutokO.Sound.Faded.overChangeVolGNC: " ++ herr1 else return () else do (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n",(filestart ++ "G") ++ prependZeroes 6 (show j) ++ - ".wav","synth", showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "sine", + ".wav","synth", showFFloat Nothing (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) "", "sine", showFFloat (Just 4) freq1 (freqChange (drop 1 cs) freq2 freq1), "fade", charFadeType (if null cs then 'l' else head cs)] ++ - if compare t0 t1 == GT then [showFFloat Nothing - (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) ""] else ["0", "-0.0", showFFloat Nothing - (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "vol", showFFloat (Just 4) v0 ""]) "" + if compare t0F t1F == GT then [showFFloat Nothing + (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) ""] else ["0", "-0.0", showFFloat Nothing + (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) "", "vol", showFFloat (Just 4) v0F ""]) "" if code1 /= ExitSuccess then error $ "DobutokO.Sound.Faded.overChangeVolGNC: " ++ herr1 else return () _ -> do (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) (soxBasicParams ys ["","-n",(filestart ++ "G") ++ prependZeroes 6 (show j) ++ ".wav", - "synth", showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", "sine", + "synth", showFFloat Nothing (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) "", "sine", showFFloat (Just 4) freq1 (freqChange (drop 1 cs) freq2 freq1), "fade", charFadeType (if null cs then 'l' else head cs)] ++ - if compare t1 t0 == GT - then [showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 - else abs (t1 - t0)) ""] else ["0", "-0.0", showFFloat Nothing (if compare (abs (t1 - t0)) xdelta /= GT then abs x0 else abs (t1 - t0)) "", - "vol", showFFloat (Just 4) v1 ""]) "" + if compare t1F t0F == GT + then [showFFloat Nothing (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 + else abs (t1F - t0F)) ""] else ["0", "-0.0", showFFloat Nothing (if compare (abs (t1F - t0F)) xdelta /= GT then abs x0 else abs (t1F - t0F)) "", + "vol", showFFloat (Just 4) v1F ""]) "" if code1 /= ExitSuccess then error $ "DobutokO.Sound.Faded.overChangeVolGNC: " ++ herr1 else return () | otherwise = error "DobutokO.Sound.Faded.overChangeVolGNC: sound for these conditions is not defined. " -- | A generalized version of the 'moreFN' with a possibility to change the behaviour for the situation with existing roots on the interval for the line connecting the 2D -- points. -moreFNC :: String -> FilePath -> String -> String -> Double -> Double -> Double -> Double -> Double -> (Double -> Double) -> V.Vector Double -> IO () +moreFNC :: String -> FilePath -> String -> String -> Float -> Float -> Float -> Float -> Double -> (Double -> Double) -> V.Vector Double -> IO () moreFNC check filestart ys x2s freq1 freq2 x0 xdelta per f v = do let (xs1,xs2) = splitAt 1 x2s c1 = if null xs1 then 'l' else head xs1 diff --git a/dobutokO4.cabal b/dobutokO4.cabal --- a/dobutokO4.cabal +++ b/dobutokO4.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: dobutokO4 -version: 0.5.0.0 +version: 0.6.0.0 synopsis: Helps to create experimental music. Uses SoX inside. description: Uses SoX fade (in a special 2D way) and frequency modulation. Provides a special representation for the composition. homepage: https://hackage.haskell.org/package/dobutokO4