dobutokO2 0.27.1.0 → 0.28.0.0

raw patch · 7 files changed

+218/−26 lines, 7 filesdep +bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• DobutokO/Sound/Executable.hs +72/−3
• DobutokO/Sound/Functional.hs +33/−12
• DobutokO/Sound/IntermediateF.hs +17/−4
• DobutokO/Sound/Keyboard.hs +70/−0
• README.markdown +16/−3
• dobutokO2.cabal +4/−4

@@ -266,3 +266,9 @@  * Twenty-seventh version revised A. Fixed issue with functions 'freqsOverlapOvers' and 'elemsOverlapOvers' with wrongly defined for multiple situations. Now they works properly. ++## 0.28.0.0 -- 2020-04-14++* Twenty-eigth version. Some code in existing modules generalization. Added a new explicit dependency -- bytestring package (earlier it was implicit +dependency for the package dependencies). Added a new module DobutokO.Sound.Keyboard to deal with textual and possibly binary source of variativity. +Some minor documentation improvements.

@@ -17,6 +17,10 @@   , recAndProcess   , dobutokO2H7   , dobutokO2H9+  -- * Library functions+  , testSoundGen2G+  , soundGen3G+  , h1 ) where  import Control.Monad (void)@@ -31,14 +35,15 @@ import Data.Char (isDigit,isSpace) import System.Process import EndOfExe (showE)-import qualified Data.Vector as V (Vector (..),generate,fromList,length,imapM_,snoc,toList,unsafeSlice,mapM_,unsafeIndex)+import qualified Data.Vector as V (Vector (..),generate,fromList,length,imapM_,snoc,toList,unsafeSlice,mapM_,imap,unsafeIndex,map,filter) import System.Directory import SoXBasics import Processing_mmsyn7ukr import DobutokO.Sound hiding (dobutokO2, recAndProcess) import DobutokO.Sound.IntermediateF  import DobutokO.Sound.ParseList (parseStoLInts)-import DobutokO.Sound.Functional (soxBasicParams)+import DobutokO.Sound.Functional+import DobutokO.Sound.Keyboard  -- | Function that actually makes processing in the @dobutokO2@ executable. Please, check before executing -- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end*\" files in the current directory, because they can be overwritten.@@ -383,7 +388,7 @@     putStrLn ys  dobutokO2H00 :: Bool -> String -> FilePath -> IO ()-dobutokO2H00 _ _ = fadeAllE+dobutokO2H00 exist2 args beginningSymbols = fadeAllE args beginningSymbols {-# INLINE dobutokO2H00 #-}  ----------------------------------------------------------------------------------------------------------------------------------------------------@@ -620,3 +625,67 @@     processD) {-# INLINE processD99 #-} +----------------------------------------------------------------------------------------------   ++-- | Tesing variant of the 'soundGen3G' with predefined three last functional arguments.+testSoundGen2G :: FilePath -> (Double -> OvertonesO) -> Double -> String -> IO ()+                              ----------------------                        +  --                                    f+testSoundGen2G file f y zs = do+  vecA0 <- fmap (V.map (\t -> quotRem t 108)) (readFileDoubles file) -- >>= print+  let n = V.length vecA0+      freq0 j = V.unsafeIndex notes (snd . V.unsafeIndex vecA0 $ j `rem` n)+      f0 t = V.fromList [(0.05763181818181818 * t, 0.3598),(1.112159090909091 * t, 0.4588962),(2 * t, 0.6853),(3 * t, 0.268),(4 * t, 0.6823),(5 * t, 0.53)]+      fA1 j = fAddFElem (freq0 (j + 1),0.5) (freq0 j) f0 gAdd04 +      fR1 j = fRemoveFElem (freq0 (j + 1),0.5) (freq0 j) f0 gRem03+      vecB = V.imap (\j r -> (V.unsafeIndex notes (snd r),+       case fst r of+         0 -> (\vv -> f0 vv)+         1 -> fA1 j+         2 -> fA1 j+         3 -> fA1 j+         4 -> fA1 j+         _ -> fR1 j)) vecA0+      (t, ws) = splitAt 1 . syllableStr n $ zs+      m0    = length ws+      zeroN = numVZeroesPre vecB+      v2    = V.map (\yy -> y * fromIntegral (yy * m0) / fromIntegral (head t)) . V.fromList $ ws in V.imapM_ (\j (x,k) -> do+        h1 (\u -> k (1.1 * freq0 j)) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j +        renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB+  endFromResult++-- | Generates a sequence of sounds with changing timbre. Uses several functions as parameters. +soundGen3G :: FilePath -> (Double -> OvertonesO) -> Double -> String -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO) +  -> ((Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO) -> (Double -> OvertonesO) -> IO ()+soundGen3G file f y zs gAdd gRem f0 = do+  vecA0 <- fmap (V.map (\t -> quotRem t 108)) (readFileDoubles file) -- >>= print+  let n = V.length vecA0+      freq0 j = V.unsafeIndex notes (snd . V.unsafeIndex vecA0 $ j `rem` n)+      fA1 j = fAddFElem (freq0 (j + 1),0.5) (freq0 j) f0 gAdd+      fR1 j = fRemoveFElem (freq0 (j + 1),0.5) (freq0 j) f0 gRem+      vecB = V.imap (\j r -> (V.unsafeIndex notes (snd r),+       case fst r of+         0 -> (\vv -> f0 vv)+         1 -> fA1 j+         2 -> fA1 j+         3 -> fA1 j+         4 -> fA1 j+         _ -> fR1 j)) vecA0+      (t, ws) = splitAt 1 . syllableStr n $ zs+      m0    = length ws+      zeroN = numVZeroesPre vecB+      v2    = V.map (\yy -> y * fromIntegral (yy * m0) / fromIntegral (head t)) . V.fromList $ ws in V.imapM_ (\j (x,k) -> do+        h1 (\u -> k (1.1 * freq0 j)) (x, (V.unsafeIndex v2 (j `rem` (V.length v2)))) j +        renameFile ("result.wav") $ "result0" ++ prependZeroes zeroN (show (j + 1)) ++ ".wav") vecB+  endFromResult++-- | For the given parameters generates a single sound with overtones.+h1 :: (Double -> OvertonesO) -> (Double, Double) -> Int -> IO ()+h1 f (x, y) j = do+    let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)+        v0    = f note0+        ts = showFFloat (Just 4) (abs y) ""+    (code,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", ts,"sine",showFFloat Nothing note0 ""] ""+    print herr+    partialTest_k v0 0 ts+    mixTest

@@ -112,8 +112,10 @@   , gAdd01   , gAdd02   , gAdd03+  , gAdd04   , gRem01   , gRem02+  , gRem03   -- ** Working with two OvertonesO   , fAddFElems   , fRemoveFElems@@ -1138,22 +1140,22 @@ freqsOverlapOvers :: OvertonesO -> OvertonesO -> Bool freqsOverlapOvers v1 v2 =   let [v11,v21] = map (V.map fst) [v1,v2]-      min2 = V.minimum v21-      max1 = V.maximum v11-      (v22,_) = V.unstablePartition (<= max1) v21-      (v12,_) = V.unstablePartition (>= min2) v11-      [v13,v23] = map (V.uniq . V.fromList . sort . V.toList) [v12,v22]-      [l1,l2]  = map V.length [v13,v23] in compare (V.length . V.uniq . V.fromList . sort . V.toList . V.concat $ [v13,v23]) (l1 + l2) == LT+      v22 = V.filter (<= V.maximum v11) v21 in+        if V.null v22 then False+        else+          let v12 = V.filter (>= V.minimum v21) v11+              [v13,v23] = map (V.uniq . V.fromList . sort . V.toList) [v12,v22]+              [l1,l2]  = map V.length [v13,v23] in compare (V.length . V.uniq . V.fromList . sort . V.toList . V.concat $ [v13,v23]) (l1 + l2) == LT  -- | Similar to 'freqsOverlapOvers', but checks whether the whole tuples are the same instead of the first elements in the tuples are the same. elemsOverlapOvers :: OvertonesO -> OvertonesO -> Bool elemsOverlapOvers v1 v2 =-  let min2 = V.minimumBy (\(x,y) (t,u) -> compare x t) v2-      max1 = V.maximumBy (\(x,y) (t,u) -> compare x t) v1-      (v22,_) = V.unstablePartition (\(x,y) -> x <= fst max1) v2-      (v12,_) = V.unstablePartition (\(x,y) -> x >= fst min2) v1-      [v13,v23] = map (V.uniq . V.fromList . sort . V.toList) [v12,v22]-      [l1,l2]  = map V.length [v13,v23] in compare (V.length . V.uniq . V.fromList . sort . V.toList . V.concat $ [v13,v23]) (l1 + l2) == LT+  let v22 = V.filter (\(x,_) -> x <= fst (V.maximumBy (\(x1,y) (t,u) -> compare x1 t) v1)) v2 in+        if V.null v22 then False+        else+          let v12 = V.filter (\(x,_) -> x >= fst (V.minimumBy (\(x1,y) (t,u) -> compare x1 t) v2)) v1+              [v13,v23] = map (V.uniq . V.fromList . sort . V.toList) [v12,v22]+              [l1,l2]  = map V.length [v13,v23] in compare (V.length . V.uniq . V.fromList . sort . V.toList . V.concat $ [v13,v23]) (l1 + l2) == LT  -- | Example of the function @gAdds@ for the 'fAddFElems'.  gAdds01 :: OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO@@ -1176,3 +1178,22 @@ gAdds02 :: Double -> OvertonesO -> Double -> (Double -> OvertonesO) -> OvertonesO gAdds02 amplMax v0 freq f = renormFD amplMax . gAdds01 v0 freq $ f  +-- | Example of the function @gAdd@. for the 'fAddFElem'. It tries to insert the given ('Double','Double') into the less dense frequency region.+gAdd04 :: (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO+gAdd04 (note,ampl) freq f + | V.null . f $ freq = V.singleton (note,ampl)+ | otherwise =+    let v1 = V.fromList . sortBy (\(x1,y1) (x2,y2) -> compare x1 x2) . V.toList . f $ freq+        v2 = V.zipWith (\(x1,_) (x2,_) -> x2 - x1) v1 (V.unsafeSlice 1 (V.length v1 - 1) v1)+        idxMax = V.maxIndex v2+        newFreq = (fst (V.unsafeIndex v1 (idxMax + 1)) + fst (V.unsafeIndex v1 idxMax)) / 2 in (newFreq,ampl) `V.cons` v1++-- | Example of the function @gRem@ for the 'fRemFElem'. It tries not to remove elements from the less than 6 elements 'OvertonesO' and to remove+-- all the elements in the given range with the width of the twice as many as the second 'Double' in the first argument tuple and the centre+-- in the first 'Double' in the tuple. Similar to somewhat bandreject filter but with more complex behaviour for the sound to be more complex.+gRem03 :: (Double,Double) -> Double -> (Double -> OvertonesO) -> OvertonesO+gRem03 (note,halfwidth) freq f =+ let v1 = V.filter (\(x,y) -> compare (abs (x - note)) halfwidth /= GT) . f $ freq in+   if compare (V.length v1) 5 /= GT then renormF . V.generate 5 $ (\i -> (fromIntegral (i + 1) * note, halfwidth / fromIntegral (i + 3))) +   else v1+     

@@ -57,6 +57,8 @@   , getFileRSizesS2G   , getFileRTuples2G   , listVDirectory2G+  -- * 3G generalized function+  , listVDirectory3G   -- ** Process and Edit   , playSeqAR2G   , playSeqARV2G@@ -174,6 +176,17 @@   let diNN = V.fromList . L.sort . filter (\s -> isPrefixOf "result" s && isSuffixOf (if drop 3 ys == "f" then ".flac" else ".wav") s) $ dir0N   return diNN   +-- | Generalized variant of the 'listVDirectory2G' with a possibility to get 'FilePath' for not only \"result\*\" files, but to specify their +-- beginning with the second 'String' argument. For example:+-- +-- >  listVDirectory3G ys "result" == listVDirectory2G ys+-- +listVDirectory3G :: String -> String -> IO (V.Vector FilePath)+listVDirectory3G ys zs = do+  dir0N <- listDirectory "."+  let diNN = V.fromList . L.sort . filter (\s -> isPrefixOf zs s && isSuffixOf (if drop 3 ys == "f" then ".flac" else ".wav") s) $ dir0N+  return diNN   + -- | During function evaluation you can listen to the sound files and mark them with \"1\" and \"0\". The first one means that the sound is considered -- of higher quality and is intended to be used as a replacement for the worse sounds markd by \"0\". The function returns a 'V.Vector' of specially formatted -- 'String' that represents only those files that are connected with the replacement procedure.@@ -718,10 +731,10 @@ fadeEnds :: FilePath -> IO () fadeEnds file = soxE file ["fade","q","0.01","-0.0"] --- | Applies 'fadeEnds' to all the \"result*.wav\" (or instead all the \"result*.flac\") files in the current directory. The file extension--- is defined by the 'String' argument in accordance with 'soxBasicParams'.-fadeAllE :: String -> IO ()-fadeAllE ys = listVDirectory2G ys >>= V.mapM_ fadeEnds+-- | Applies 'fadeEnds' to all the \"zs*.wav\" (or instead all the \"zs*.flac\") files in the current directory. The file extension+-- is defined by the first 'String' argument in accordance with 'soxBasicParams'. @zs@ here is given by the second 'String' argument.+fadeAllE :: String -> String -> IO ()+fadeAllE ys zs = listVDirectory3G ys zs >>= V.mapM_ fadeEnds  -------------------------------------------------------------------------------------------   

@@ -0,0 +1,70 @@+-- |+-- Module      :  DobutokO.Sound.Keyboard+-- Copyright   :  (c) OleksandrZhabenko 2020+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- A program and a library to create experimental music+-- from a mono audio and a Ukrainian text. Can work with both WAV and FLAC files if+-- your SoX installation supports FLAC.++{-# OPTIONS_GHC -threaded #-}++module DobutokO.Sound.Keyboard where++import CaseBi (getBFst')+import Data.Char (isAsciiLower)+import qualified Data.Vector as V+import qualified Data.ByteString.Lazy.Char8 as BL (ByteString,map,zipWith,tail,filter,getContents,readFile)++-- | Converts a lazy 'BL.ByteString' into a 'V.Vector' of 'Int' using 'hashStr2'. +takeDoubles :: BL.ByteString -> V.Vector Int+takeDoubles xs = V.fromList . BL.zipWith hashStr2 xs $ BL.tail xs++-- | Converts a string of lowercase ASCII letters being typed on the QWERTY keyboard layout into corresponding Dvorak keyboard layout.+qwerty2dvorak :: BL.ByteString -> BL.ByteString+qwerty2dvorak = BL.map (getBFst' (' ',V.fromList . zip ("/;<>" ++ ['a'..'z']) $ "wvszaxje.uidchtnmbrl'poygk,qf;"))++-- | Vice versa to 'qwerty2dvorak'.+dvorak2qwerty :: BL.ByteString -> BL.ByteString+dvorak2qwerty = BL.map (getBFst' (' ',V.fromList . zip ("',.;" ++ ['a'..'z']) $ "qwezanihdyujgcvpmlsrxo;kf.,bt/"))++-- | Hashes two lower case ascii characters. Is used for controlling frequencies and operators.+hashStr2 :: Char -> Char -> Int+hashStr2 x y = getBFst' (57, V.fromList . zip ['a'..'z'] . map (\t -> getBFst' (26 * t + 18, V.fromList . zip ['a'..'z'] $ [(26 * t + 4)..]) y) . +  concat $ [[0],[6..8],[1],[9..11],[4],[12..16],[2],[17..21],[3],[22..24],[5,25]]) x -- 679 is the greatest value ~ \"zz\"; there are 572 effectful val.++-- | Get contents into lazy 'BL.ByteString' with filtering of all characters that are not a lower case ascii letters.+input2BL :: IO (BL.ByteString)+input2BL = fmap (convH [] (BL.filter isAsciiLower)) BL.getContents++-- | Reads a given file into a lazy 'BL.ByteString' with filtering of all characters that are not a lower case ascii letters. It has additional +-- first command line argument to control the way of treating letters: as being typed (entered) properly (null 'String'), or needed to be converted +-- from qwerty to dvorak layout (\"q\" 'String'), or vice versa (otherwise).+readFile2BLGen :: String -> FilePath -> IO (BL.ByteString)+readFile2BLGen ys = fmap (convH ys (BL.filter isAsciiLower)) . BL.readFile++-- | Auxiliary function to define how is a 'BL.ByteString' treated, see 'readFile2BLGen'.+convH :: String -> (BL.ByteString -> BL.ByteString) -> (BL.ByteString -> BL.ByteString)+convH ys f + | null ys = f+ | ys == "q" = qwerty2dvorak . f+ | otherwise = dvorak2qwerty . f+  +-- | Usual way the function 'readFile2BLGen' is used. The text in a file being read is treated as a properly typed (entered) one. So there is no +-- keyboard layout conversion at all.+readFile2BL :: FilePath -> IO (BL.ByteString)+readFile2BL = readFile2BLGen []++-- | After reading a file into a filtered lazy 'BL.ByteString' (see, 'readFile2BLGen') converts the resulting 'BL.ByteString' into a 'V.Vector' +-- of 'Int'. The arguments have the same meaning as for 'readFile2BLGen'.+readFileDoublesGen :: String -> FilePath -> IO (V.Vector Int)+readFileDoublesGen ys = fmap (takeDoubles . convH ys (BL.filter isAsciiLower)) . BL.readFile++-- | Usual way the function 'readFileDoublesGen' is used. The text in a file being read is treated as a properly typed (entered) one. So there is no +-- keyboard layout conversion at all.+readFileDoubles :: FilePath -> IO (V.Vector Int)+readFileDoubles = readFileDoublesGen []++

@@ -21,8 +21,12 @@  OR: -dobutokO2 { 00 | 82 | 820 | 92 | 992 | 9992 } {volatile symbols together, e. g. "0"} {quality control, see information below}+dobutokO2 { 82 | 820 | 92 | 992 | 9992 } {volatile symbols together, e. g. "0"} {quality control, see information below} +OR:++dobutokO2 00 {beginning symbols for the filenames "fade" effect to be applied to} {quality control, see information below}+   where filename is:   the full name of the file to be recorded in the current directory or   the full absolute path to the sound .wav file (or other one format@@ -81,8 +85,9 @@   "0" -> the program just converts multiline Ukrainian text from stdin      into a String and prints it to stdout. No other arguments are used. -  "00" -> the program applies "fade q 0.01 -0.0" SoX effect to every "result\*.wav"-     (or instead of them to every "result\*.flac") file in the current directory.+  "00" -> the program applies "fade q 0.01 -0.0" SoX effect to every "zs\*.wav"+     (or instead of them to every "zs\*.flac") file in the current directory. +       The 'zs' here is specified by the second command line argument.         This allows to avoid clipping while just simply concatenating the files into           one with SoX. The mentioned clipping can be desirable in some circumstances             but generally is not necessary or is redundant. For more information,@@ -238,4 +243,12 @@  Starting from the 0.24.0.0 version, you can refer to examples in the GitHub special repository (https://github.com/OleksandrZhabenko/dobutokO2-examples/)++                ***** Support for not Sound File Variativity Sources *****+                ----------------------------------------------------------+                +Since 0.28.0.0 version the library supports not only the sound file as a +variativity source but also other types of files. They are used through +a special reencoding using lazy bytestrings. For more information, please, +refer to DobutokO.Sound.Keyboard module.                 

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                dobutokO2-version:             0.27.1.0+version:             0.28.0.0 synopsis:            A program and a library to create experimental music from a mono audio and a Ukrainian text description:         It can also create a timbre for the notes. Uses SoX inside. homepage:            https://hackage.haskell.org/package/dobutokO2@@ -17,10 +17,10 @@ cabal-version:       >=1.10  library-  exposed-modules:     Main, DobutokO.Sound, DobutokO.Sound.Functional, DobutokO.Sound.Executable, DobutokO.Sound.IntermediateF, DobutokO.Sound.ParseList+  exposed-modules:     Main, DobutokO.Sound, DobutokO.Sound.Functional, DobutokO.Sound.Executable, DobutokO.Sound.IntermediateF, DobutokO.Sound.ParseList, DobutokO.Sound.Keyboard   -- other-modules:   -- other-extensions:-  build-depends:       base >=4.7 && <4.14, vector >=0.11 && <0.14, process >=1.4 && <1.8, mmsyn3 >=0.1.4 && <1, mmsyn7s >=0.6.6 && <1, directory >=1.2.7 && <1.6, mmsyn7ukr >=0.15.3 && <1, mmsyn2 >=0.1.7 && <1, mmsyn6ukr >=0.6.3.1 && <1+  build-depends:       base >=4.7 && <4.14, bytestring >= 0.10.6 && <1, vector >=0.11 && <0.14, process >=1.4 && <1.8, mmsyn3 >=0.1.4 && <1, mmsyn7s >=0.6.6 && <1, directory >=1.2.7 && <1.6, mmsyn7ukr >=0.15.3 && <1, mmsyn2 >=0.1.7 && <1, mmsyn6ukr >=0.6.3.1 && <1   -- hs-source-dirs:   default-language:    Haskell2010 @@ -28,7 +28,7 @@   main-is:             Main.hs   -- other-modules:   -- other-extensions:-  build-depends:       base >=4.7 && <4.14, vector >=0.11 && <0.14, process >=1.4 && <1.8, mmsyn3 >=0.1.4 && <1, mmsyn7s >=0.6.6 && <1, directory >=1.2.7 && <1.6, mmsyn7ukr >=0.15.3 && <1, mmsyn2 >=0.1.7 && <1, mmsyn6ukr >=0.6.3.1 && <1+  build-depends:       base >=4.7 && <4.14, bytestring >= 0.10.6 && <1, vector >=0.11 && <0.14, process >=1.4 && <1.8, mmsyn3 >=0.1.4 && <1, mmsyn7s >=0.6.6 && <1, directory >=1.2.7 && <1.6, mmsyn7ukr >=0.15.3 && <1, mmsyn2 >=0.1.7 && <1, mmsyn6ukr >=0.6.3.1 && <1   -- hs-source-dirs:   default-language:    Haskell2010