module MMSyn7h where
import Data.Char (isSpace, isControl)
import Data.Maybe (isJust,fromJust)
import System.IO
import System.Environment (getArgs)
import System.Process (readProcessWithExitCode)
import System.Directory (removeFile, listDirectory)
import Control.Exception (bracketOnError)
import EndOfExe (showE)
import Melodics.Ukrainian (convertToProperUkrainian, takeData)
import UkrainianLControl
import qualified Data.Vector as V
import qualified Data.ByteString.Lazy as B
import Data.List (isSuffixOf)
import CaseBi (getBFst')
main7h :: IO ()
main7h = bracketOnError (do
putStrLn "Please, specify the arguments to control the output speech file! "
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\" 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
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
_ <- readProcessWithExitCode ts ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw",
fst . snd . genControl . concat $ args, nameSF ++ (snd . snd . genControl . concat $ args)] ""
removeFile $ nameSF ++ ".raw"
if isJust . showE $ "play"
then do
_ <- readProcessWithExitCode (fromJust . showE $ "play") [nameSF ++ (snd . snd . genControl . concat $ args)] ""
cleanCreatedSoundFs
else error "SoX play is not installed properly in the system. Please, install it properly and execute the program again."
else do
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 ["-r22050","-c1","-L","-esigned-integer","-b16", nameSF ++ ".raw",
fst . snd . genControl . concat $ args, nameSF ++ (snd . snd . genControl . concat $ args)] ""
removeFile $ nameSF ++ ".raw")
appendS16LEFile :: V.Vector String -> Handle -> IO ()
appendS16LEFile xs hdl | not (V.null xs) =
do
dataList <- (V.mapM takeData . V.fromList) ["-.wav", "0.wav", "1.wav", "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"]
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), ("а", 3), ("б", 4),
("в", 5), ("г", 6), ("д", 7), ("дж", 8), ("дз", 9), ("е", 10), ("ж", 11), ("з", 12), ("и", 13),
("й", 14), ("к", 15), ("л", 16), ("м", 17), ("н", 18), ("о", 19), ("п", 20), ("р", 21),
("с", 22), ("сь", 23), ("т", 24), ("у", 25), ("ф", 26), ("х", 27), ("ц", 28), ("ць", 29), ("ч", 30),
("ш", 31), ("ь", 32), ("і", 33), ("ґ", 34)]) u
else error "File is not closed!"
else error "Data sound file is not read!") xs
hClose hdl
| otherwise = return ()
cleanCreatedSoundFs :: IO ()
cleanCreatedSoundFs = do
dirCs <- listDirectory "."
let remFs = concatMap (\ys -> filter (\zs -> ys `isSuffixOf` zs) dirCs) [".raw", ".wav", ".ogg", ".flac"] in mapM_ removeFile remFs