packages feed

dobutokO2 0.15.1.0 → 0.16.0.0

raw patch · 6 files changed

+330/−41 lines, 6 filesdep ~directoryPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: directory

API changes (from Hackage documentation)

- DobutokO.Sound: putInEnku :: Int -> Int -> Double -> Maybe Double
- DobutokO.Sound: putInEnkuV :: Int -> Int -> Vector Double -> Vector Double
- DobutokO.Sound: putInOctave :: Int -> Double -> Maybe Double
- DobutokO.Sound: putInOctaveV :: Int -> Vector Double -> Vector Double
+ DobutokO.Sound: liftInEnku :: Int -> Int -> Double -> Maybe Double
+ DobutokO.Sound: liftInEnkuV :: Int -> Int -> Vector Double -> Vector Double
+ DobutokO.Sound: liftInOctave :: Int -> Double -> Maybe Double
+ DobutokO.Sound: liftInOctaveV :: Int -> Vector Double -> Vector Double
+ DobutokO.Sound.Executable: dobutokO2H9 :: Bool -> String -> FilePath -> IO ()
+ DobutokO.Sound.IntermediateF: getFileRSizes :: IO (Vector Integer)
+ DobutokO.Sound.IntermediateF: getFileRSizesS :: IO (Vector Int)
+ DobutokO.Sound.IntermediateF: getFileRSizesS2 :: IO (Vector Int)
+ DobutokO.Sound.IntermediateF: getFileRTuples :: IO (Vector (FilePath, Integer))
+ DobutokO.Sound.IntermediateF: indexesFromMrk :: String -> Int
+ DobutokO.Sound.IntermediateF: infoFromV :: Vector String -> [(Vector Int, Vector String)]
+ DobutokO.Sound.IntermediateF: internalConv :: ([String], [String]) -> (Vector Int, Vector String)
+ DobutokO.Sound.IntermediateF: isHighQ :: String -> Bool
+ DobutokO.Sound.IntermediateF: ixFromRes :: String -> String
+ DobutokO.Sound.IntermediateF: ixInterv :: Int -> IO (Int, Int)
+ DobutokO.Sound.IntermediateF: listVDirectory :: IO (Vector FilePath)
+ DobutokO.Sound.IntermediateF: pAnR1 :: Vector String -> IO (Vector String)
+ DobutokO.Sound.IntermediateF: pAnR2 :: Vector String -> IO ()
+ DobutokO.Sound.IntermediateF: pAnR_ :: IO ()
+ DobutokO.Sound.IntermediateF: playAMrk :: IO (Vector String)
+ DobutokO.Sound.IntermediateF: playAndMark :: Vector FilePath -> IO (Vector String)
+ DobutokO.Sound.IntermediateF: playCollect1Dec :: Vector String -> Int -> IO Bool
+ DobutokO.Sound.IntermediateF: playCollectDec :: Vector String -> IO (Vector Bool)
+ DobutokO.Sound.IntermediateF: playSeqAR :: Int -> IO ()
+ DobutokO.Sound.IntermediateF: playSeqARV :: Vector Int -> IO ()
+ DobutokO.Sound.IntermediateF: playSeqARV2 :: Vector String -> IO ()
+ DobutokO.Sound.IntermediateF: replaceWithHQs :: FilePath -> Vector Bool -> Vector FilePath -> IO ()
+ DobutokO.Sound.IntermediateF: shouldBeReplaced :: String -> Bool
+ DobutokO.Sound.IntermediateF: thisOne :: IO Bool

Files

CHANGELOG.md view
@@ -152,3 +152,8 @@  * Fifteenth version revised A. Fixed issue with the wrong mapping between the first command line arguments and the executable behaviour. Added the needed behaviour for the "61" first command line option. Some improvement for the README.markdown file.++## 0.16.0.0 -- 2020-03-23++* Sixteenth version. Changed dependency version for directory package. Some documentation improvements for README.markdown file. Added a new module+DobutokO.Sound.IntermediateF to work with intermediate files. Changed the names of the some functions in DobutokO.Sound module and its exports.
DobutokO/Sound.hs view
@@ -47,15 +47,15 @@   , octaveUp   , octaveDown   , whichOctave-  , putInOctave-  , putInOctaveV+  , liftInOctave+  , liftInOctaveV   -- * Work with enky (extension to octaves functionality)   , nkyT   , enkuUp   , enkuDown   , whichEnka-  , putInEnku-  , putInEnkuV+  , liftInEnku+  , liftInEnkuV   -- ** Even more extended   , dviykyTA   , triykyTA@@ -218,8 +218,8 @@ -- | Function lifts the given frequency to the given number of the octave (in American notation, from 0 to 8). This number is an 'Int' parameter. -- The function also takes into account the lower pure quint for the closest note. -- If it is not practical to determine the number, then the function returns 'Nothing'.-putInOctave :: Int -> Double -> Maybe Double-putInOctave n x+liftInOctave :: Int -> Double -> Maybe Double+liftInOctave n x   | compare n 0 == LT || compare n 8 == GT = Nothing   | compare (closestNote x) 24.4996 == GT =       case compare (fromJust . whichOctave $ x) n of@@ -236,10 +236,10 @@                      else Just (V.unsafeLast . V.iterateN (fromIntegral z1 + 1) octaveDown $ closestNote x)   | otherwise = Nothing --- | Similarly to 'putInOctave' returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT').+-- | Similarly to 'liftInOctave' returns a 'Maybe' number (actually frequency) for the n-th elements set of notes (see 'nkyT'). -- A second 'Int' parameter defines that @n@.-putInEnku :: Int -> Int -> Double -> Maybe Double-putInEnku n ku x+liftInEnku :: Int -> Int -> Double -> Maybe Double+liftInEnku n ku x   | compare n 0 == LT || compare n ((108 `quot` ku) - 1) == GT = Nothing   | getBFst' (False, V.fromList . zip [2,3,4,6,9,12] $ repeat True) ku && compare (closestNote x) 24.4996 == GT =       case compare (fromJust . whichEnka ku $ x) n of@@ -259,13 +259,13 @@ -- | Function lifts the 'V.Vector' of 'Double' representing frequencies to the given octave with the 'Int' number. Better to use numbers in the range [1..8]. -- The function also takes into account the lower pure quint for the obtained note behaviour. If it is not practical to determine the octave, the resulting -- frequency is omitted from the resulting 'V.Vector'.-putInOctaveV :: Int -> V.Vector Double -> V.Vector Double-putInOctaveV n = V.mapMaybe (\z -> putInOctave n z)+liftInOctaveV :: Int -> V.Vector Double -> V.Vector Double+liftInOctaveV n = V.mapMaybe (\z -> liftInOctave n z) --- | Similarly to 'putInOctaveV' returns a 'V.Vector' 'Double' (actually frequencies) for the n-th elements set of notes (see 'nkyT') instead of octaves.+-- | Similarly to 'liftInOctaveV' returns a 'V.Vector' 'Double' (actually frequencies) for the n-th elements set of notes (see 'nkyT') instead of octaves. -- A second 'Int' parameter defines that @n@. -putInEnkuV :: Int -> Int -> V.Vector Double -> V.Vector Double-putInEnkuV n ku = V.mapMaybe (\z -> putInEnku n ku z)+liftInEnkuV :: Int -> Int -> V.Vector Double -> V.Vector Double+liftInEnkuV n ku = V.mapMaybe (\z -> liftInEnku n ku z)  -------------------------------------------------------------------------------------------------------------------------------- @@ -606,7 +606,7 @@         noteN1  = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s   ; if null noteN1 then return (11440::Int)       else let noteN2  = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN2 })-  let vecB = putInOctaveV m . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA+  let vecB = liftInOctaveV m . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA   oberSoXSynthN n ampL time3 zs vecB   path2s <- listDirectory "."   let paths3 = sort . filter (isPrefixOf "result") $ path2s@@ -632,7 +632,7 @@         noteN1  = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s   ; if null noteN1 then return (11440::Int)       else let noteN2  = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN2 })-  let vecB = putInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA+  let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA   oberSoXSynthN n ampL time3 zs vecB   path2s <- listDirectory "."   let paths3 = sort . filter (isPrefixOf "result") $ path2s@@ -664,7 +664,7 @@         noteN1  = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s   ; if null noteN1 then return (11440::Int)       else let noteN2  = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN2 })-  let vecB = putInOctaveV m . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA+  let vecB = liftInOctaveV m . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA   oberSoXSynthN2 n ampL time3 zs tts vecB   path2s <- listDirectory "."   let paths3 = sort . filter (isPrefixOf "result") $ path2s@@ -690,7 +690,7 @@         noteN1  = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s   ; if null noteN1 then return (11440::Int)       else let noteN2  = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN2 })-  let vecB = putInEnkuV m ku. V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA+  let vecB = liftInEnkuV m ku. V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA   oberSoXSynthN2 n ampL time3 zs tts vecB   path2s <- listDirectory "."   let paths3 = sort . filter (isPrefixOf "result") $ path2s@@ -726,7 +726,7 @@         noteN1  = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s   ; if null noteN1 then return (11440::Int)       else let noteN2  = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN2 })-  let vecB = putInOctaveV m . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA+  let vecB = liftInOctaveV m . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA   oberSoXSynthN3 n ampL time3 dAmpl zs tts vs vecB   path2s <- listDirectory "."   let paths3 = sort . filter (isPrefixOf "result") $ path2s@@ -752,7 +752,7 @@         noteN1  = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s   ; if null noteN1 then return (11440::Int)       else let noteN2  = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN2 })-  let vecB = putInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA+  let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA   oberSoXSynthN3 n ampL time3 dAmpl zs tts vs vecB   path2s <- listDirectory "."   let paths3 = sort . filter (isPrefixOf "result") $ path2s@@ -1015,7 +1015,7 @@           noteN0 = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s     ; if null noteN0 then return (11440::Int)       else let noteN1  = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN1 })-  let vecB = putInOctaveV m . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA+  let vecB = liftInOctaveV m . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA   uniqOberSoXSynthN n ampL time3 zs wws vecB   path2s <- listDirectory "."   let paths3 = sort . filter (isPrefixOf "result") $ path2s@@ -1042,7 +1042,7 @@           noteN0 = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s     ; if null noteN0 then return (11440::Int)       else let noteN1  = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN1 })-  let vecB = putInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA+  let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA   uniqOberSoXSynthN n ampL time3 zs wws vecB   path2s <- listDirectory "."   let paths3 = sort . filter (isPrefixOf "result") $ path2s@@ -1075,7 +1075,7 @@           noteN0 = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s     ; if null noteN0 then return (11440::Int)       else let noteN1  = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN1 })-  let vecB = putInOctaveV m . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA+  let vecB = liftInOctaveV m . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA   uniqOberSoXSynthN3 n ampL time3 zs wws tts vecB   path2s <- listDirectory "."   let paths3 = sort . filter (isPrefixOf "result") $ path2s@@ -1102,7 +1102,7 @@           noteN0 = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s     ; if null noteN0 then return (11440::Int)       else let noteN1  = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN1 })-  let vecB = putInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA+  let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA   uniqOberSoXSynthN3 n ampL time3 zs wws tts vecB   path2s <- listDirectory "."   let paths3 = sort . filter (isPrefixOf "result") $ path2s@@ -1139,7 +1139,7 @@           noteN0 = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s     ; if null noteN0 then return (11440::Int)       else let noteN1  = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN1 })-  let vecB = putInOctaveV m . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA+  let vecB = liftInOctaveV m . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA   uniqOberSoXSynthN4 n ampL time3 dAmpl zs wws tts vs vecB   path2s <- listDirectory "."   let paths3 = sort . filter (isPrefixOf "result") $ path2s@@ -1166,7 +1166,7 @@           noteN0 = takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s     ; if null noteN0 then return (11440::Int)       else let noteN1  = read (takeWhile isDigit . dropWhile (not . isDigit) . concat . drop 13 . take 14 $ line0s)::Int in return noteN1 })-  let vecB = putInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA+  let vecB = liftInEnkuV m ku . V.map fromIntegral . V.filter (/= (11440::Int)) $ vecA   uniqOberSoXSynthN4 n ampL time3 dAmpl zs wws tts vs vecB   path2s <- listDirectory "."   let paths3 = sort . filter (isPrefixOf "result") $ path2s
DobutokO/Sound/Executable.hs view
@@ -15,6 +15,7 @@   dobutokO2   , recAndProcess   , dobutokO2H7+  , dobutokO2H9 ) where  import System.Exit (ExitCode (ExitSuccess))@@ -33,6 +34,7 @@ import SoXBasics import Processing_mmsyn7ukr import DobutokO.Sound hiding (dobutokO2, recAndProcess)+import DobutokO.Sound.IntermediateF (pAnR_)  -- | Function that actually makes processing in the @dobutokO2@ executable. Please, check before executing -- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end.wav\" files in the current directory, because they can be overwritten.@@ -45,7 +47,7 @@   exist2 <- doesFileExist file   getBFst' (dobutokO2H exist2 args file, V.fromList . fmap (\(xs, f) -> (xs,f exist2 args file)) $ [("0",o2help),("1",dobutokO2H1),("11",dobutokO2H11),     ("2",dobutokO2H2),("21",dobutokO2H21),("3",dobutokO2H3),("31",dobutokO2H31),("4",dobutokO2H4),("41",dobutokO2H41),("5",dobutokO2H5),-      ("51",dobutokO2H51),("61",dobutokO2H61),("7",dobutokO2H7),("8",dobutokO2H8),("80",dobutokO2H80)]) arg1+      ("51",dobutokO2H51),("61",dobutokO2H61),("7",dobutokO2H7),("8",dobutokO2H8),("80",dobutokO2H80),("9",dobutokO2H9)]) arg1  dobutokO2H1 :: Bool -> String -> FilePath -> IO () dobutokO2H1 exist2 args file = do@@ -216,6 +218,11 @@           error $ "The end file \"end.wav\" was not created. "         else error "The end file \"end.wav\" was not created. " {-# INLINE dobutokO2H80 #-}++-- | Actually works as 'pAnR_' function.+dobutokO2H9 :: Bool -> String -> FilePath -> IO ()+dobutokO2H9 _ _ _ = pAnR_+{-# INLINE dobutokO2H9 #-}  isDataStr :: String -> Bool isDataStr = null . filter (== '@')
+ DobutokO/Sound/IntermediateF.hs view
@@ -0,0 +1,272 @@+-- |+-- Module      :  DobutokO.Sound.IntermediateF+-- 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.++{-# OPTIONS_GHC -threaded #-}++module DobutokO.Sound.IntermediateF (+  -- * Basic functions to work with intermediate files \"result\*wav\"+  getFileRSizes+  , getFileRSizesS+  , getFileRSizesS2+  , getFileRTuples+  , listVDirectory+  , isHighQ+  , shouldBeReplaced+  , indexesFromMrk+  -- * Functions to edit the melody by editing the intermediate files \"result\*wav\"+  , playAndMark+  , playAMrk+  , pAnR1+  , pAnR2+  , pAnR_+  -- * Additional functions+  -- ** Get information+  , infoFromV+  , internalConv+  , ixFromRes+  , ixInterv+  , thisOne+  -- ** Process and Edit+  , playSeqAR+  , playSeqARV+  , playSeqARV2+  , playCollect1Dec+  , playCollectDec+  , replaceWithHQs+) where++import Control.Concurrent (myThreadId,forkIO,threadDelay,killThread)+import qualified Data.List as L (sort)+import Control.Exception (onException)+import Data.List (isPrefixOf,isSuffixOf,(\\))+import Data.Char (isDigit,isSpace)+import qualified Data.Vector as V +import System.Directory+import SoXBasics (playA,durationA)+import EndOfExe (showE)+import System.Process (readProcessWithExitCode)+import Data.Maybe (fromJust)++-- | Gets sizes of the \"result\*.wav\" files in the current directory. +getFileRSizes :: IO (V.Vector Integer)+getFileRSizes = do+  dirN <- listDirectory "."+  let dirN1 = V.fromList . L.sort . filter (isPrefixOf "result") . filter (isSuffixOf ".wav") $ dirN+  sizes <- V.mapM getFileSize dirN1+  return sizes++-- | Similar to 'getFileRSizes', but sizes are 'Int', not 'Integer'. For most cases it is more memory efficient.+getFileRSizesS :: IO (V.Vector Int)+getFileRSizesS = do+  dirN0 <- listDirectory "."+  let dirN2 = V.fromList . L.sort . filter (isPrefixOf "result") . filter (isSuffixOf ".wav") $ dirN0+  sizes1 <- V.mapM getFileSize dirN2+  return . V.map fromIntegral $ sizes1++-- | Variant of 'getFileRSizes' function.+getFileRSizesS2 :: IO (V.Vector Int)+getFileRSizesS2 = getFileRSizes >>= \s -> return . V.map fromIntegral $ s++-- | Gets 'V.Vector' of tuples of the pairs of \"result\*.wav\" files and their respective sizes.+getFileRTuples :: IO (V.Vector (FilePath,Integer))+getFileRTuples = do+  dirN <- listDirectory "."+  let dirN0 = L.sort . filter (isPrefixOf "result") . filter (isSuffixOf ".wav") $ dirN+  sizes0 <- mapM getFileSize dirN0+  let tpls = V.fromList . zip dirN0 $ sizes0+  return tpls++-- | Gets 'V.Vector' of the filenames for \"result\*.wav\" files in the current directory.+listVDirectory :: IO (V.Vector FilePath)+listVDirectory = do+  dir0N <- listDirectory "."+  let diNN = V.fromList . L.sort . filter (\s -> isPrefixOf "result" s && isSuffixOf ".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.+playAndMark :: V.Vector FilePath -> IO (V.Vector String)+playAndMark vec+  | V.null vec = return V.empty+  | otherwise = V.imapM (\i xs -> do+      duration <- durationA $ V.unsafeIndex vec i+      putStrLn "Listen to the next sound, please. Please, do not enter anything while sound plays. "+      forkIO $ do+        myThread <- myThreadId+        playA xs+        killThread myThread+      threadDelay (read (show $ truncate (duration * fromIntegral 1000000))::Int)+      putStr "How do you mark the file that has just been played now -- if of high quality, print \"1\", if of low quality, print \"0\", "+      putStrLn "if it is just accepted, press \'Enter\'. "  +      mark0 <- getLine+      putStrLn "-----------------------------------------------------------------------------------------"+      let mark = take 1 mark0+      case mark of+        "1" -> return $ show i ++ "*" ++ xs+        "0" -> return $ show i ++ "**" ++ xs+        _   -> return []) vec >>= V.filterM (\t -> return . not . null $ t) ++-- | Function 'playAndMark' applied to all the \"result\*.wav\" files in the current directory.+playAMrk :: IO (V.Vector String)+playAMrk = listVDirectory >>= playAndMark++-- | Function-predicate to check whether a file corresponding to its 'String' argument is needed to be replaced while processing.+shouldBeReplaced :: String -> Bool+shouldBeReplaced (x:y:xs)+  | x == '*' && y == '*' = True+  | otherwise = shouldBeReplaced (y:xs)+shouldBeReplaced _ = False++-- | Function-predicate to check whether a file corresponding to its 'String' argument is considered as one of higher quality and therefore can be used+-- to replace the not so suitable ones while processing.+isHighQ :: String -> Bool+isHighQ xs = (length . filter (== '*') $ xs) == 1++-- | Gets an index of the 'V.Vector' element corresponding to the 'String' generated by 'playAndMark' function.+indexesFromMrk :: String -> Int+indexesFromMrk xs = read (takeWhile (\t1 -> t1 /= '*') xs)::Int++-- | Used to obtain parameters for processment.+internalConv :: ([String],[String]) -> (V.Vector Int, V.Vector String)+internalConv (xss,yss) = (V.fromList . map indexesFromMrk $ xss,V.fromList . map (dropWhile (== '*')) $ yss)++-- | Axiliary function to get a 'String' of consequent digits in the name of the \"result\*.wav\" file.+ixFromRes :: String -> String+ixFromRes xs = (takeWhile (/= '.') xs) \\ "result"++-- | Given an index of the element in the 'listVDirectory' output returns a tuple of the boundaries of the indexes usable for playback. +-- Note: index0 is probably from [0..], l1 is necessarily from [0..]. Interesting case is: 0 <= index0 < l1.+ixInterv :: Int -> IO (Int, Int)+ixInterv index0+  | compare index0 0 == LT = do+      dirV <- listVDirectory+      let l1 = V.length dirV+      case compare l1 13 of+        LT -> return (0,l1 - 1)+        _  -> return (0,11)+  | compare index0 7 == LT = do+      dirV <- listVDirectory+      let l1 = V.length dirV+      case compare index0 (l1 - 5) of+        GT -> return (0, l1 - 1) +        _  -> return (0, index0 + 4)     +  | otherwise = do+      dirV <- listVDirectory+      let l1 = V.length dirV+      case compare l1 13 of+       LT -> return (0,l1 - 1)+       _  -> +         case compare index0 (l1 - 5) of+           GT -> return (index0 - 7, l1 - 1)+           _  -> return (index0 - 7, index0 + 4)++-- | Parser to the result of 'listVDirectory' function to get the needed information.+infoFromV :: V.Vector String -> [(V.Vector Int, V.Vector String)]+infoFromV vec = map (internalConv . unzip . V.toList . V.map (break (== '*'))) [v1, v2]+  where (v1, v2) = V.partition shouldBeReplaced vec++-- | Plays a sequence of sounds in the interval of them obtained by 'ixInterv' function.+playSeqAR :: Int -> IO ()+playSeqAR index0 = do+  (minBnd,maxBnd) <- ixInterv index0+  dirV2 <- listVDirectory+  mapM_ (\i -> playA $ V.unsafeIndex dirV2 i) [minBnd..maxBnd]++-- | Plays a sequence of consequential sounds in the melody in the interval of them obtained by 'ixInterv' function for each element index+-- from 'V.Vector' of indexes.+playSeqARV :: V.Vector Int -> IO ()+playSeqARV vec = do+  dirV2 <- listVDirectory+  V.mapM_ (\i -> playA $ V.unsafeIndex dirV2 i) vec++-- | Plays a sequence of sounds considered of higher quality.+playSeqARV2 :: V.Vector String -> IO ()+playSeqARV2 vec = do+  let indexesHQs = fst . last . infoFromV $ vec  +  playSeqARV indexesHQs++-- | The same as 'playSeqARV2', but additionally collects the resulting 'Bool' values and then returns them. It is used to define, which sounds  from those of+-- higher quality will replace those ones considered to be replaced.+playCollectDec :: V.Vector String -> IO (V.Vector Bool)+playCollectDec vec = do+  dirV3 <- listVDirectory+  let indexesHQs = fst . last . infoFromV $ vec+  vecBools <- V.mapM (playCollect1Dec dirV3) indexesHQs+  return vecBools++-- | Actually replaces the file represented by 'FilePath' argument with no (then there is no replacement at all), or with just one,+-- or with a sequence of sounds being considered of higher quality to form a new melody. If the lengths of the second and the third+-- arguments differs from each other then the function uses as these arguments truncated vectors of the minimal of the two lengths. +replaceWithHQs :: FilePath -> V.Vector Bool -> V.Vector FilePath -> IO ()+replaceWithHQs file0 vecBools stringHQs+ | V.length vecBools == V.length stringHQs =+   case V.length stringHQs of+    0 -> putStrLn "That's all!"+    1 | V.unsafeIndex vecBools 0 -> do+         copyFile (head . V.toList $ stringHQs) "resultI.wav"+         renameFile "resultI.wav" file0+      | otherwise -> putStrLn "Nothing has changed. "+    _ -> do+         let yss = V.toList . V.ifilter (\i _ -> V.unsafeIndex vecBools i == True) $ stringHQs+         case length yss of+          0 -> putStrLn "That's all!"+          1 -> copyFile (head yss) file0+          _ -> do+            (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) (yss ++ [file0]) ""+            putStrLn herr+ | otherwise =+  let stringHQ2s = V.take (min (V.length vecBools) (V.length stringHQs)) stringHQs+      vecBool2s  = V.take (min (V.length vecBools) (V.length stringHQs)) vecBools in replaceWithHQs file0 vecBool2s stringHQ2s++-- | 'IO' checkbox whether to add the sound played to the sequence of sounds that will replace the needed one.+thisOne :: IO Bool+thisOne = do+  putStrLn "Would you like to add this sound played just now to the sequence of sounds that will replace the needed one? "+  yes <- getLine+  putStrLn "-----------------------------------------------------------------------"+  return $ take 1 yes == "1"++-- | Plays a sound file considered to be of higher quality and then you define whether to use the played sound to replace that one considered to be replaced.+playCollect1Dec :: V.Vector String -> Int -> IO Bool+playCollect1Dec dirV2 i +  | compare i 0 /= LT && compare i (V.length dirV2) /= GT = do +     playA $ V.unsafeIndex dirV2 i+     thisOne+  | otherwise = error "DobutokO.Sound.IntermediateF.playCollect1Dec: wrong Int parameter! "++-- | Process the sound corresponding to the first element in the first argument. Returns a 'V.tail' of the first element of the first command line argument.+-- Replaces (if specified) the sound with a sequence of (or just one, or made no replacement at all) sounds considered of higher quality.+pAnR1 :: V.Vector String -> IO (V.Vector String)+pAnR1 vec+ | V.null vec = putStrLn "You have processed all the marked files! " >> return V.empty+ | otherwise = do+    let [(indexes0,strings),(indexesHQ,stringHQs)] = infoFromV vec+    putStrLn "Please, listen to the melody and remember what sound you would like to replace and the surrounding sounds. "+    playSeqAR $ V.unsafeIndex indexes0 0+    putStrLn "---------------------------------------------------------------"+    putStrLn "Now, please, listen to a collection of sounds considered of higher quality which you can use to replace the needed one. "+    vecBools <- playCollectDec vec+    replaceWithHQs (V.unsafeIndex strings 0) vecBools stringHQs+    return $ V.map (\(ix,xs) -> show ix ++ "**" ++ xs) . V.zip (V.unsafeDrop 1 indexes0) $ (V.unsafeDrop 1 strings)++-- | Process the sounds consequently corresponding to the elements in the first argument.+-- Replaces (if specified) the sounds with a sequence of (or just one, or made no replacement at all) sounds considered of higher quality for every sound needed.+pAnR2 :: V.Vector String -> IO ()+pAnR2 vec+ | V.null vec = putStrLn "You have processed all the marked files! "+ | otherwise = onException (pAnR1 vec >>= pAnR2) (return ())++-- | Marks the needed files as of needed to be replaced or those ones considered of higher quality that will replace the needed ones. Then actually replaces them+-- as specified. Uses internally 'playAMrk' and 'pAnR2' functions. +pAnR_ :: IO ()+pAnR_ = do+  vec <- playAMrk+  pAnR2 vec
README.markdown view
@@ -13,7 +13,7 @@  For the executable you enter in the terminal: -dobutokO2 { 0 | 1 | 11 | 2 | 21 | 3 | 31 | 4 | 41 | 5 | 51 | 6 | 7 | 8 | 80 } {fileName} {Ukrainian text}+dobutokO2 { 0 | 1 | 11 | 2 | 21 | 3 | 31 | 4 | 41 | 5 | 51 | 6 | 7 | 8 | 80 | 9 } {fileName} {Ukrainian text}    where filename is:   the full name of the file to be recorded in the current directory or@@ -39,6 +39,11 @@              of consequential notes. This allows to create more 'condensed' and                'narrower' compositions that being more defined can be at the                  same time more precise.++  "9" -> the program works with existing "result\*.wav" files and you can replace+     some of them by other one(s) or their sequences. This allows to create files,+       then edit them using this first command line option (possibly for several+         times) and at last create a resulting melody file with "8" or "80" options.      In more details: @@ -98,7 +103,7 @@          command line arguments to get the test final sound file. It can be then            listened to and probably remade again by editing the "result\*" files              and running the program with this option again. In such a case,-               noone from the other command line arguments is important for the+               none from the other command line arguments is important for the                  program running, so they all can be simply omitted.     "80" -> the same as "8" but with one important difference that the program if@@ -107,6 +112,8 @@          back and try again with just the same files. In such a case, you need to            repeat all the process of creation of "result\*" files. Be aware and use              with care!++  "9" -> see the information above.                _  -> the program behaves like for the "5" option, but generates      obertones using additional String and allows maximum control over@@ -116,15 +123,13 @@ options except "80" there are files "result\*.wav" in the directory. These are the resulting melody generated in their order preserved. -The program now lifts the frequencies to the octave with the number, which you-can specify during its execution.--You can specify some control parameters during the program execution. This-leads to different sounding.+The program now lifts the frequencies to the octave or to the enka with the number,+which you can specify during its execution. -You can use the default values (backward compatible with the 0.2.0.0 version)-by simply pressing 'Enter' while being prompted and the informational message-contains the line about the default value.+You can use the default values (backward compatible with the 0.2.0.0 version +if the first command line option does not consist of two digits and the last one+is not a '0' or '1') by simply pressing 'Enter' while being prompted and+the informational message contains the line about the default value.  ** Note: 
dobutokO2.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                dobutokO2-version:             0.15.1.0+version:             0.16.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 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+  exposed-modules:     Main, DobutokO.Sound, DobutokO.Sound.Functional, DobutokO.Sound.Executable, DobutokO.Sound.IntermediateF   -- 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.5 && <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, 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.5 && <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, 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