-- | -- Module : Main -- Copyright : (c) OleksandrZhabenko 2019-2020 -- License : MIT -- -- Maintainer : olexandr543@yahoo.com -- -- A program and a library that can be used as a simple -- basic interface to some SoX functionality or for producing -- the approximately Ukrainian speech with your own recorded -- voice (actually it produces needed sound representations). -- module Main where import System.Directory import Control.Exception (onException) import EndOfExe (showE) import Data.Maybe (fromJust) import Paths_mmsyn6ukr import Processing_mmsyn7ukr import System.Environment (getArgs) import System.Info (os) import CaseBi (getBFst') import qualified Data.Vector as V import ReplaceP -- | Function responds for general program execution. It starts with CAUTION to be responsible for usage and to -- use it personally in some important cases (see README). Then the program guides you through the creating your Ukrainian \"voice\". -- Please, use it carefully. The function uses command line arguments. -- For their meaning, please, refer to README file. -- main :: IO () main = do args <- getArgs putStrLn " ***** CAUTION! *****" putStrLn "" putStrLn "\"The possession of great power necessarily implies great responsibility.\"" putStrLn "" putStrLn " (William Lamb)" putStrLn "" putStr "The program mmsyn7ukr produces the \"voice\" represented as an ordered " putStr "set of sounds each of which corresponds (represents) one of the " putStr "Ukrainian sounds so that using them together by mmsyn7h program " putStr "(https://hackage.haskell.org/package/mmsyn7h) can be a background " putStr "for sound synthesis. If you pronounce sounds as the appropriate " putStr "Ukrainian ones, close to proper Ukrainian speech with your own " putStr "voice. This program approximates your voice with a sequence " putStr "of recorded separate sounds with your control over the " putStr "duration of the sounds. They are then precessed by the SoX " putStr "binaries already installed in the system to produce the " putStr "needed sounds and then you can pronounce some Ukrainian text " putStr "with your recorded \"voice\" using mmsyn7h program. In-between " putStr "you can do some additional processing as you need. Moreover, " putStr "you can substitute whatever sounds you like (consider being " putStrLn "sensible) instead of your own voice." putStrLn "" putStr "Be aware that if somebody can get access to the sounds of " putStr "your voice or to the recorded speech (except you) then this " putStr "possibility itself creates security issues and concerns. So, " putStr "please, do NOT give access to such records to anybody else " putStrLn "except you." putStrLn "" putStr "In such a case, the program is for personal usage of every " putStrLn "user ONLY!" putStrLn "" putStr "Being given as an advice in such a case, run the program " putStr "in the empty directory with the current user permissions to write, " putStr "read and search and provide some proofs and evidence that nobody else " putStr "can even read the files in the directory. May be, it is better " putStr "to execute the program being in the directory located in the RAM, " putStr "then consequently wait until the program ends and then reboot " putStrLn "the computer. " putStrLn "" putStr "If the program ends earlier, you must then remove " putStr "(better wipe) the directory contents. No other users should " putStr "have access to the computer after you have begun to run the " putStr "program and have not deleted (or better wiped) the contents " putStr "of the directory. Please, be aware, that there are possibilities " putStr "to read sensitive information from the drives after you have " putStr "deleted the files in a usual way. You can use wiping for better " putStr "security. Besides, if somebody can get access to the memory of " putStr "the computer or to the directory contents where you run the " putStr "program or (may be) to the temporary files created by SoX or " putStr "to the drive where you run the program (not in the RAM, or may " putStr "be in it) then your voice can be stolen and / or used " putStr "inappropriately. Use all possible precautions and measures to " putStrLn "avoid the situation. " putStrLn "" putStr "Be aware also that the given by the program technology (or " putStr "documentation for it in any form) of the voice processing can " putStr "be improved so there is NO guarantees that the given technology " putStr "or its successors cannot be used in violating your voice identity " putStr "to produce from some available voice records the voice for the " putStr "inappropriate usage. Therefore, better is to proove your identity not " putStr "only with the solely voice itself but with some additional " putStrLn "independent sources and measures. " putStrLn "" putStr "The author of the program accordingly to the LICENSE (MIT) does not " putStr "response for any possible issues, but by this notification tries to " putStrLn "intent you to be aware of some possible issues." putStrLn "" onException (if take 5 os == "mingw" then do let eS = fromJust (showE "sox") eSi = fromJust (showE "soxi") return () else do let eS = fromJust (showE "sox") eSi = fromJust (showE "soxi") eSp = fromJust (showE "play") eSr = fromJust (showE "rec") return ()) (error "SoX is not properly installed in your system. Please, install it properly and then run the program again! ") let a0 = if null . take 1 $ args then [] else concat . take 1 $ args a1 = if null . drop 1 . take 2 $ args then [] else concat . drop 1 . take 1 $ args a2 = if null . drop 2 . take 3 $ args then [] else concat . drop 2 . take 3 $ args if null a2 then do paths <- mapM getDataFileName ["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"] copiedFs <- mapM getDataFileName ["-.wav", "0.wav", "1.wav"] mapM_ (produceSound (a0, a1)) paths silenceFs <- mapM makeAbsolute ["-.wav", "0.wav", "1.wav"] let pairs = zip copiedFs silenceFs mapM_ (\(x, y) -> copyFile x y) pairs putStrLn "" putStrLn "Your voice sound files are now created in the current directory! Use in a secure way! Remember the initial CAUTION! " putStrLn "" else do putStrLn "" let rrs = show . head $ [[a2]] list0 = read (replaceP rrs)::[String] wws = 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"])) list0 paths <- mapM getDataFileName wws copiedFs <- mapM getDataFileName ["-.wav", "0.wav", "1.wav"] mapM_ (produceSound (a0, a1)) paths silenceFs <- mapM makeAbsolute ["-.wav", "0.wav", "1.wav"] let pairs = zip copiedFs silenceFs mapM_ (\(x, y) -> copyFile x y) pairs putStrLn "" putStrLn "Your voice sound files are now created in the current directory! Use in a secure way! Remember the initial CAUTION! " putStrLn ""