dobutokO4 0.4.0.0 → 0.5.0.0

raw patch · 3 files changed

+147/−8 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• DobutokO/Sound/Faded.hs +142/−7
• dobutokO4.cabal +1/−1

@@ -25,3 +25,7 @@ ## 0.4.0.0 -- 2020-06-09  * Fourth version. Added moreF-based functions to the DobutokO.Sound.Faded module. They allow to create a sequence of sounds with frequency modulation.++## 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. 

@@ -13,7 +13,8 @@  module DobutokO.Sound.Faded (   -- * Provide special faded effects and frequency modulation-  overChangeVolGN+  overChangeVolGNC+  , overChangeVolGN   , overChangeVolG   , overChangeVolGC   , overChangeVolGF@@ -38,13 +39,17 @@   , basicF2N   , basicF2CN   -- * Generate several files with frequency modulation+  , moreFNC   , moreFN   , moreFCN+  , reverbFix   -- * Auxiliary functions   , endingWF   , charFadeType   , argString   , freqChange+  -- * Special numbers+  , sameConst ) where  #ifdef __GLASGOW_HASKELL__@@ -105,14 +110,18 @@             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 freq2 x0 xdelta ((t0,v0), ((v0 * t1 - v1 * t0) / (v0 - v1),0)) >> renameFile ((filestart ++ "G") ++ -       prependZeroes 6 (show j) ++ endingWF ys) ("temp0" ++ endingWF ys)-     overChangeVolGN filestart ys cs j freq1 freq2 x0 xdelta (((v0 * t1 - v1 * t0) / (v0 - v1),0), (t1,v1)) >> renameFile ((filestart ++ "G") ++ +     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)+     (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)-     (code1,_,herr1) <- readProcessWithExitCode (fromJust (showE "sox")) ["temp0" ++ endingWF ys,"temp1" ++ endingWF ys, (filestart ++ "G") ++ +      (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)-     else error $ "DobutokO.Sound.Faded.overChangeVolGN: " ++ herr1 +      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        0 -> @@ -324,3 +333,129 @@ -- | 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 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 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 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 +    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", +        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 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) ""]) ""+      if code2 == ExitSuccess +        then do+          (code3,_,herr3) <- readProcessWithExitCode (fromJust (showE "sox")) ["-m","test0" ++ endingWF ys,"test1" ++ endingWF ys, (filestart ++ "G") ++ +            prependZeroes 6 (show j) ++ endingWF ys, "vol", "2"] ""+          if code3 == ExitSuccess +            then removeFile ("test0" ++ endingWF ys) >> removeFile ("test1" ++ 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)+        (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)) >> +           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.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"]) "" +        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)) >> +           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) +         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"]) "" +        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)) >> +           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 +      0 -> +       if v0 == 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)) ""]) ""+          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", +              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 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", +          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 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 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+      c2 = if null xs2 then 'l' else head xs2+  v1 <- evalSndFV f v+  V.imapM_ (\i x -> do+    overChangeVolGNC check filestart ys [c1] i freq1 freq2 x0 xdelta x+    fadeEndsTMB c2 per $ (filestart ++ "G") ++ prependZeroes 6 (show i) ++ endingWF ys+    reverbFix $ (filestart ++ "G") ++ prependZeroes 6 (show i) ++ endingWF ys) v1++-- | Auxiliary function that can be used to apply a \"reverb\" effect or in this module context to fix unpleasant noise for concatenated parts. Usually, can be used after +-- application of the other functions in the module to transform the noise into more music sound. It is usually applied after all the other functions.+reverbFix :: FilePath -> IO ()+reverbFix file = do+  (code,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) [file,"temp" ++ file,"reverb","-w","10", "1", "100"] ""+  if code /= ExitSuccess then do +    exi <- doesFileExist $ "temp" ++ file+    if exi then removeFile ("temp" ++ file) >> error ("DobutokO.Sound.Faded.reverbFix: Operation on the file" ++ show file ++ " was unsucessful " ++ herr)+    else error $ "DobutokO.Sound.Faded.reverbFix: Operation on the file" ++ show file ++ " was unsucessful " ++ herr+  else renameFile ("temp" ++ file) file+  

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                dobutokO4-version:             0.4.0.0+version:             0.5.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