diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -27,3 +27,8 @@ ## 0.3.0.1 -- 2020-01-05 * Third version revised A. Fixed an issue with the not compiling code. + +## 0.4.0.0 -- 2020-01-10 + +* Fourth version. Added the possibility to work with not the full set of Ukrainian sounds representations, but with some of them. +The program now can use more command line arguments. Added new functions and dependencies. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2019 OleksandrZhabenko +Copyright (c) 2019-2020 OleksandrZhabenko Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the diff --git a/MMSyn7h.hs b/MMSyn7h.hs --- a/MMSyn7h.hs +++ b/MMSyn7h.hs @@ -27,70 +27,121 @@ import Data.List (isSuffixOf) import CaseBi (getBFst') import System.Info (os) +import MMSyn7s (show7s) --- | Function that proposes and creates if accepted the sound record with the new \"voice\". Besides it can play the newly created file once. +-- | Function that proposes and creates if accepted the sound record with the new \"voice\". Besides it can play the newly created file once and can delete +-- the sound files in the current directory. If you specify the second command line argument \"s\" and then a list of @String@ represented the Ukrainian sounds, +-- then the program will use only these sounds representations additionally to the default ones \"-.wav\", \"0.wav\" and \"1.wav\". main7h :: IO () main7h = bracketOnError (do dir <- getCurrentDirectory putStrLn "You are now in the directory: " putStrLn $ show dir putStrLn "" - putStrLn "Please, specify the arguments to control the output speech file! " + putStrLn "You could specify the control parameters for the output speech file as the first command line argument to the running program mmsyn7h! " putStrLn "See https://hackage.haskell.org/package/mmsyn6ukr-0.6.2.0/docs/UkrainianLControl.html#v:genControl for more information." - putStrLn "You can specify e. g. \"o9-1\" or \"o5-1\" (and the most compressed audio in the .ogg format will be produced) or other option." - arg <- getArgs - let args = take 1 arg in do - putStrLn "Please, specify the name of the resulting sound file! Please, do NOT use '}' character and space or control characters!" - nameOfSoundFile <- getLine - let nameSF = filter (\x -> not (isSpace x) && not (isControl x) && x /= '}') nameOfSoundFile in + putStr "You could specify e. g. \"o9-1\" or \"o5-1\" (and the most compressed audio in the .ogg format will be produced) or other option. " + putStrLn "If you have not specified the parameters and now would like to, please, terminate the running program and execute it again with the proper command line arguments. " + args <- getArgs + putStrLn "And now, please, specify the name of the resulting sound file! Please, do NOT use '}' character and space or control characters!" + nameOfSoundFile <- getLine + let nameSF = filter (\x -> not (isSpace x) && not (isControl x) && x /= '}') nameOfSoundFile in return (args, nameSF)) (\(args, nameSF) -> do putStr "Notice, there was (may be) CmdLineArgument exception. To avoid it, please, specify the command line argument (if needed) in the form \"ABC\"" putStrLn $ " where A is either a letter \'f\', \'o\', \'w\' or a digit and B and C are both digits! The exception (may be) arose from the command line arguments " ++ show args ++ " for the file: " ++ show nameSF ++ ". Please, check also whether the SoX was installed with the support for needed codec.") (\(args, nameSF) -> do - putStrLn "" - putStr "The resulting file will be played just after it is created by the program. To remove all the created sound files from the directory, " - putStrLn "please, specify as the first character in the input as \"0\". Otherwise, the program will not remove any records (if they are not overwritten). " - putStrLn "" - putStrLn "Now enter the Ukrainian text." - putStrLn "" - xs <- getContents - if take 1 xs == "0" then do - let ys = take (nSymbols (let zs = take 1 args in if null zs then [] else fst . genControl . head $ zs)) (drop 1 xs) in - withBinaryFile (nameSF ++ ".raw") AppendMode (appendS16LEFile (convertToProperUkrainian ys)) - putStrLn "The .raw file was created by the program. It will be processed further. " - let ts = fromJust (showE "sox") in do - let ws = snd . genControl . concat $ args - _ <- readProcessWithExitCode ts ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw", - fst ws, nameSF ++ snd ws] "" - removeFile $ nameSF ++ ".raw" - if take 5 os == "mingw" - then do - _ <- readProcessWithExitCode (fromJust . showE $ "sox") [nameSF ++ snd ws, "-t", "waveaudio", "-d"] "" - cleanCreatedSoundFs - else if isJust . showE $ "play" - then do - _ <- readProcessWithExitCode (fromJust . showE $ "play") [nameSF ++ snd ws] "" - cleanCreatedSoundFs - else error "SoX play is not installed properly in the system. Please, install it properly and execute the program again." - else do - let ws = snd . genControl . concat $ args - let ys = take (nSymbols (let zs = take 1 args in if null zs then [] else fst . genControl . head $ zs)) xs in - withBinaryFile (nameSF ++ ".raw") AppendMode (appendS16LEFile (convertToProperUkrainian ys)) - putStrLn "The .raw file was created by the program. It will be processed further. " - let ts = fromJust (showE "sox") in do - _ <- readProcessWithExitCode ts (case fst ws of - "" -> ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw", nameSF ++ snd ws] - _ -> ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw", fst ws, nameSF ++ snd ws]) "" - removeFile $ nameSF ++ ".raw" - if take 5 os == "mingw" - then do - _ <- readProcessWithExitCode (fromJust . showE $ "sox") [nameSF ++ snd ws, "-t", "waveaudio", "-d"] "" - cleanCreatedSoundFs - else if isJust . showE $ "play" - then do - _ <- readProcessWithExitCode (fromJust . showE $ "play") [nameSF ++ snd ws] "" - cleanCreatedSoundFs - else error "SoX play is not installed properly in the system. Please, install it properly and execute the program again.") + let arg = take 1 args + if (not . null . drop 2 $ args) && ((concat . drop 1 . take 2 $ args) == "s") + then do + putStrLn "" + putStr "The resulting file will be played just after it is created by the program. To remove all the created sound files from the directory, " + putStrLn "please, specify now the first character in the input as \"0\". Otherwise, the program will not remove any records (if they are not overwritten). " + putStrLn "" + putStrLn "Now enter the Ukrainian text." + putStrLn "" + xs <- getContents + if take 1 xs == "0" then do + let ys = take (nSymbols (if null arg then [] else fst . genControl . head $ arg)) (drop 1 xs) in + withBinaryFile (nameSF ++ ".raw") AppendMode (appendS16LEFileList (convertToProperUkrainian ys, show7s . unwords . drop 2 $ args)) + putStrLn "The .raw file was created by the program. It will be processed further. " + let ts = fromJust (showE "sox") in do + let ws = snd . genControl . concat $ arg + _ <- readProcessWithExitCode ts ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw", + fst ws, nameSF ++ snd ws] "" + removeFile $ nameSF ++ ".raw" + if take 5 os == "mingw" + then do + _ <- readProcessWithExitCode (fromJust . showE $ "sox") [nameSF ++ snd ws, "-t", "waveaudio", "-d"] "" + cleanCreatedSoundFs + else if isJust . showE $ "play" + then do + _ <- readProcessWithExitCode (fromJust . showE $ "play") [nameSF ++ snd ws] "" + cleanCreatedSoundFs + else error "SoX play is not installed properly in the system. Please, install it properly and execute the program again." + else do + let ws = snd . genControl . concat $ arg + let ys = take (nSymbols (if null arg then [] else fst . genControl . head $ arg)) xs in + withBinaryFile (nameSF ++ ".raw") AppendMode (appendS16LEFileList (convertToProperUkrainian ys, show7s . unwords . drop 2 $ args)) + putStrLn "The .raw file was created by the program. It will be processed further. " + let ts = fromJust (showE "sox") in do + _ <- readProcessWithExitCode ts (case fst ws of + "" -> ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw", nameSF ++ snd ws] + _ -> ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw", fst ws, nameSF ++ snd ws]) "" + removeFile $ nameSF ++ ".raw" + if take 5 os == "mingw" + then do + _ <- readProcessWithExitCode (fromJust . showE $ "sox") [nameSF ++ snd ws, "-t", "waveaudio", "-d"] "" + cleanCreatedSoundFs + else if isJust . showE $ "play" + then do + _ <- readProcessWithExitCode (fromJust . showE $ "play") [nameSF ++ snd ws] "" + cleanCreatedSoundFs + else error "SoX play is not installed properly in the system. Please, install it properly and execute the program again." + else do + putStrLn "" + putStr "The resulting file will be played just after it is created by the program. To remove all the created sound files from the directory, " + putStrLn "please, specify now the first character in the input as \"0\". Otherwise, the program will not remove any records (if they are not overwritten). " + putStrLn "" + putStrLn "Now enter the Ukrainian text." + putStrLn "" + xs <- getContents + if take 1 xs == "0" then do + let ys = take (nSymbols (if null arg then [] else fst . genControl . head $ arg)) (drop 1 xs) in + withBinaryFile (nameSF ++ ".raw") AppendMode (appendS16LEFile (convertToProperUkrainian ys)) + putStrLn "The .raw file was created by the program. It will be processed further. " + let ts = fromJust (showE "sox") in do + let ws = snd . genControl . concat $ arg + _ <- readProcessWithExitCode ts ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw", + fst ws, nameSF ++ snd ws] "" + removeFile $ nameSF ++ ".raw" + if take 5 os == "mingw" + then do + _ <- readProcessWithExitCode (fromJust . showE $ "sox") [nameSF ++ snd ws, "-t", "waveaudio", "-d"] "" + cleanCreatedSoundFs + else if isJust . showE $ "play" + then do + _ <- readProcessWithExitCode (fromJust . showE $ "play") [nameSF ++ snd ws] "" + cleanCreatedSoundFs + else error "SoX play is not installed properly in the system. Please, install it properly and execute the program again." + else do + let ws = snd . genControl . concat $ arg + let ys = take (nSymbols (if null arg then [] else fst . genControl . head $ arg)) xs in + withBinaryFile (nameSF ++ ".raw") AppendMode (appendS16LEFile (convertToProperUkrainian ys)) + putStrLn "The .raw file was created by the program. It will be processed further. " + let ts = fromJust (showE "sox") in do + _ <- readProcessWithExitCode ts (case fst ws of + "" -> ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw", nameSF ++ snd ws] + _ -> ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw", fst ws, nameSF ++ snd ws]) "" + removeFile $ nameSF ++ ".raw" + if take 5 os == "mingw" + then do + _ <- readProcessWithExitCode (fromJust . showE $ "sox") [nameSF ++ snd ws, "-t", "waveaudio", "-d"] "" + cleanCreatedSoundFs + else if isJust . showE $ "play" + then do + _ <- readProcessWithExitCode (fromJust . showE $ "play") [nameSF ++ snd ws] "" + cleanCreatedSoundFs + else error "SoX play is not installed properly in the system. Please, install it properly and execute the program again.") -- | The function that actually produces a .raw file. The mapping table is given in the @Map.txt@ file, but the sound duration differs. appendS16LEFile :: V.Vector String -> Handle -> IO () @@ -115,6 +166,29 @@ else error "Data sound file is not read!") xs hClose hdl | otherwise = return () + +-- | The function that actually produces a .raw file. The mapping table is given in the @Map.txt@ file, but the sound duration differs. +-- The @[String]@ parameter is a sorted list of Ukrainian sounds to be used (for example, it can be obtained with @mmsyn7s@ executable from the same name package). +appendS16LEFileList :: (V.Vector String, [String]) -> Handle -> IO () +appendS16LEFileList (xs, yss) hdl | not (V.null xs) && not (null yss) = + do + let intrm = map (getBFst' ("0.wav", V.fromList . zip ["а","б","в","г","д","дж","дз","е","ж","з","и","й","к","л","м","н","о","п","р","с", + "сь","т","у","ф","х","ц","ць","ч","ш","ь","і","ґ"] $ ["A.wav", "B.wav", "C.wav", "D.wav", "E.wav", "F.wav", "G.wav", "H.wav", + "I.wav", "J.wav", "K.wav", "L.wav", "M.wav", "N.wav", "O.wav", "P.wav", "Q.wav", "R.wav", + "S.wav", "T.wav", "U.wav", "V.wav", "W.wav", "X.wav", "Y.wav", "Z.wav", "a.wav", "b.wav", "c.wav", + "d.wav", "e.wav", "f.wav"])) yss + dataList <- (V.mapM takeData . V.fromList) (["-.wav", "0.wav", "1.wav"] ++ intrm) + V.mapM_ (\u -> + if V.all (\z -> B.length z > 0) dataList + then let rs = tail . dropWhile (/= ' ') . takeWhile (/= '}') . show $ hdl in do + hClose hdl + closedHdl <- hIsClosed hdl + if closedHdl + then B.appendFile rs $ dataList V.! getBFst' (0, V.fromList $ [("-", 0), ("0", 1), ("1", 2)] ++ zip yss [3..]) u + else error "File is not closed!" + else error "Data sound file is not read!") xs + hClose hdl + | otherwise = return () -- | Function that removes all the sounds with ".raw", ".wav", ".ogg", ".flac" extensions in the current directory. It is used for -- the security reasons. diff --git a/README b/README --- a/README +++ b/README @@ -5,4 +5,8 @@ needed files and to produce them by some other means (e. g. by mmsyn7ukr). Besides, you can remove the created by mmsyn7ukr and mmsyn7h files -while the last one is running. +while the last one is running. +If you specify the second command line argument "s" and then +a list of @String@ represented the Ukrainian sounds, then +the program will use only these sounds representations +additionally to the default ones "-.wav", "0.wav" and "1.wav". diff --git a/mmsyn7h.cabal b/mmsyn7h.cabal --- a/mmsyn7h.cabal +++ b/mmsyn7h.cabal @@ -2,15 +2,15 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: mmsyn7h -version: 0.3.0.1 -synopsis: A program and a library that produces a sound recording specified by the Ukrainian text. +version: 0.4.0.0 +synopsis: Produces a sound recording specified by the Ukrainian text. description: A program and a library that are used with mmsyn7ukr (or separately) and are similar to mmsyn6ukr executable. The program uses the data files in the current directory instead of ones in the system defined directories. It reads Ukrainian text with the given by data files sounds. homepage: https://hackage.haskell.org/package/mmsyn7h license: MIT license-file: LICENSE author: OleksandrZhabenko maintainer: olexandr543@yahoo.com -copyright: (c) Oleksandr Zhabenko 2019 +copyright: (c) Oleksandr Zhabenko 2019-2020 category: Language build-type: Simple extra-source-files: ChangeLog.md, README, Map.txt @@ -20,7 +20,7 @@ exposed-modules: MMSyn7h, Main -- other-modules: -- other-extensions: - build-depends: base >=4.7 && <4.14, process >=1.4 && <1.8, vector >=0.11 && <0.14, bytestring >=0.10 && < 0.12, mmsyn2 >=0.1.7 && <1, directory >=1.2.5 && <1.4, mmsyn6ukr >=0.6.2 && <1, mmsyn3 >=0.1.4 && <1 + build-depends: base >=4.7 && <4.14, process >=1.4 && <1.8, vector >=0.11 && <0.14, bytestring >=0.10 && < 0.12, mmsyn2 >=0.1.7 && <1, directory >=1.2.5 && <1.4, mmsyn6ukr >=0.6.2 && <1, mmsyn3 >=0.1.4 && <1, mmsyn7s >=0.1 && <1 -- hs-source-dirs: default-language: Haskell2010 @@ -29,6 +29,6 @@ main-is: Main.hs -- other-modules: -- other-extensions: - build-depends: base >=4.7 && <4.14, process >=1.4 && <1.8, vector >=0.11 && <0.14, bytestring >=0.10 && <0.12, mmsyn2 >=0.1.7 && <1, directory >=1.2.5 && <1.4, mmsyn6ukr >=0.6.2 && <1, mmsyn3 >=0.1.4 && <1 + build-depends: base >=4.7 && <4.14, process >=1.4 && <1.8, vector >=0.11 && <0.14, bytestring >=0.10 && <0.12, mmsyn2 >=0.1.7 && <1, directory >=1.2.5 && <1.4, mmsyn6ukr >=0.6.2 && <1, mmsyn3 >=0.1.4 && <1, mmsyn7s >=0.1 && <1 -- hs-source-dirs: default-language: Haskell2010