diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -157,3 +157,9 @@ ## 0.8.1.0 -- 2020-09-25 * Eighth version revised A. Added to the exported functions isUkrainian from the Melodics.Ukrainian module. + +## 0.8.2.0 -- 2020-10-28 + +* Eigth version revised B. Fixed issues with some combinations that were not +properly handled. + diff --git a/Melodics/Ukrainian.hs b/Melodics/Ukrainian.hs --- a/Melodics/Ukrainian.hs +++ b/Melodics/Ukrainian.hs @@ -4,8 +4,8 @@ -- License : MIT -- Maintainer : olexandr543@yahoo.com -- --- Functions provide functionality of a musical instrument synthesizer or for Ukrainian speech synthesis --- especially for poets, translators and writers. +-- Functions provide functionality of a musical instrument synthesizer or for Ukrainian speech synthesis +-- especially for poets, translators and writers. -- module Melodics.Ukrainian ( @@ -16,10 +16,12 @@ ) where import Data.Char -import qualified Data.Vector as V -import qualified Data.ByteString.Lazy as B +import qualified Data.Vector.Unboxed as V +import qualified Data.Vector as VB +import qualified Data.ByteString.Char8 as B import System.IO -import CaseBi (getBFst') +import CaseBi.Unboxed (getBFst') +import qualified CaseBi as X (getBFst') import Data.List.InnToOut.Basic (mapI, mapI2) import Paths_mmsyn6ukr @@ -37,44 +39,44 @@ let dataN = B.drop 44 data1 in return dataN -- | The function that actually produces a .raw file. The mapping table is given in the @Map.txt@ file. -appendS16LEFile :: V.Vector String -> Handle -> IO () -appendS16LEFile xs hdl | not (V.null xs) = +appendS16LEFile :: VB.Vector String -> Handle -> IO () +appendS16LEFile xs hdl | not (VB.null xs) = do - dataFileList <- mapM getDataFileName - ["-.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", + dataFileList <- mapM getDataFileName + ["-.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"] - dataList <- V.mapM takeData . V.fromList $! dataFileList - V.mapM_ (\u -> - if V.all (\z -> B.length z > 0) dataList + dataList <- VB.mapM takeData . VB.fromList $! dataFileList + VB.mapM_ (\u -> + if VB.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 do - 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), + if closedHdl + then do + B.appendFile rs $ dataList VB.! (X.getBFst' (0, VB.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 () --- | The function that converts a written Ukrainian text into the sounding in the program phonetical respesentation. +-- | The function that converts a written Ukrainian text into the sounding in the program phonetical respesentation. -- It is not exact phonetically but you can make for yourself a general impression of the Ukrainian sounding. -convertToProperUkrainian :: String -> V.Vector String +convertToProperUkrainian :: String -> VB.Vector String convertToProperUkrainian ys = toVector . correctA . applyChanges . createTuplesByAnalysis . changeJotted . secondConv . wasFstConverted . filterUkr $ ys correctB :: [String] -> [String] -correctB ys@(xs:xss) | compare (length . filter (== "1") . takeFromFT2 6 $ ys) 1 == GT = +correctB ys@(xs:xss) | compare (length . filter (== "1") . takeFromFT2 6 $ ys) 1 == GT = map (\t -> if t == "1" || isPunctuation (head t) then "-" else t) (takeFromFT2 6 ys) ++ correctB (dropFromFT2 6 ys) | otherwise = (if isPunctuation . head $ xs then "-" else xs):correctB xss correctB [] = [] -filterUkr :: String -> String +filterUkr :: String -> String filterUkr xs = concatMap (\x -> if isUkrainian x then [toLower x] else if isSpace x || isControl x || isPunctuation x then [x] else []) xs secondConv :: String -> String @@ -84,7 +86,7 @@ createTuplesByAnalysis :: String -> [(String, Triple)] createTuplesByAnalysis x@(y:ys) | getBFst' (False, V.fromList $ zip "\1075\1076\1078\1079\1082\1085\1087\1089\1090\1092\1093\1094\1095\1096" (repeat True)) y = initialA x - | not (null ys) && head ys == '\1081' && isConsNotJ y = case y of + | not (null ys) && head ys == '\1081' && isConsNotJ y = case y of '\1089' -> ("\1089\1100", T):createTuplesByAnalysis (tail ys) '\1094' -> ("\1094\1100", T):createTuplesByAnalysis (tail ys) _ -> ([y], T):("\1100", Z):createTuplesByAnalysis (tail ys) @@ -95,17 +97,17 @@ canChange x | isSpace x || isControl x || x == '-' = O | getBFst' (False, V.fromList $ zip "\1075\1076\1078\1079\1082\1085\1087\1089\1090\1092\1093\1094\1095\1096" (repeat True)) x = T | otherwise = Z - + isVoicedObstruent :: String -> Bool -isVoicedObstruent xs | not (null xs) = getBFst' (False, V.fromList $ zip ["\1073","\1075","\1076","\1076\1078","\1076\1079","\1078","\1079","\1169"] (repeat True)) xs +isVoicedObstruent xs | not (null xs) = X.getBFst' (False, VB.fromList $ zip ["\1073","\1075","\1076","\1076\1078","\1076\1079","\1078","\1079","\1169"] (repeat True)) xs | otherwise = False initialA :: String -> [(String, Triple)] initialA t1@(t:ts) | canChange t == O = ("1", Z):initialA ts - | canChange t == T = + | canChange t == T = if getBFst' (False, V.fromList $ zip "\1076\1085\1089\1090\1093\1094" (repeat True)) t - then let (us,vs) = splitAt 2 t1 in - if getBFst' (False, V.fromList $ zip ["\1076\1078","\1076\1079","\1085\1090","\1089\1090","\1089\1100","\1090\1089","\1090\1100","\1093\1075","\1094\1100"] (repeat True)) us + then let (us,vs) = splitAt 2 t1 in + if X.getBFst' (False, VB.fromList $ zip ["\1076\1078","\1076\1079","\1085\1090","\1089\1090","\1089\1100","\1090\1089","\1090\1100","\1093\1075","\1094\1100"] (repeat True)) us then (us, T):initialA (vs) else ([t], T):initialA ts else case (getBFst' (False, V.fromList $ zip "\1075\1078\1079\1082\1087\1092\1095\1096" (repeat True)) t) of @@ -120,10 +122,10 @@ mustBeConverted c = getBFst' (False, V.fromList $ zip "'-\700\1097\1102\1103\1108\1111\8217" (repeat True)) c convertionFst :: Char -> String -convertionFst u = getBFst' ([u], V.fromList $ zip "'-\700\1097\1102\1103\1108\1111\8217" ["0","0","0","\1096\1095","\1081\1091","\1081\1072","\1081\1077","\1081\1110","0"]) u +convertionFst u = X.getBFst' ([u], VB.fromList $ zip "'-\700\1097\1102\1103\1108\1111\8217" ["0","0","0","\1096\1095","\1081\1091","\1081\1072","\1081\1077","\1081\1110","0"]) u isConsNotJ :: Char -> Bool -isConsNotJ = getBFst' (False, V.fromList $ zip "\1073\1074\1075\1076\1078\1079\1082\1083\1084\1085\1087\1088\1089\1090\1092\1093\1094\1095\1096\1169" (repeat True)) +isConsNotJ = getBFst' (False, V.fromList $ zip "\1073\1074\1075\1076\1078\1079\1082\1083\1084\1085\1087\1088\1089\1090\1092\1093\1094\1095\1096\1097\1169" (repeat True)) changeJotted :: String -> String changeJotted (x:y:z:zs) | (getBFst' (False, V.fromList $ zip "\1072\1077\1080\1091\1110" (repeat True)) z) && (y == '\1081') && (isConsNotJ x) = x:'\1100':z:changeJotted zs @@ -132,11 +134,11 @@ changeJotted xs = xs applyChanges :: [(String, Triple)] -> [(String, Triple)] -applyChanges (z:t:zs) | snd z == T = - getBFst' ((fst z, Z), V.fromList . zip ["\1075","\1076","\1076\1079","\1078","\1079","\1082","\1085\1090", - "\1087","\1089","\1089\1090","\1089\1100","\1090","\1090\1089","\1090\1100","\1092","\1093","\1093\1075","\1094","\1094\1100","\1095","\1096"] - $ [гT (t:zs), дT (t:zs), дзT (t:zs), жT (t:zs), зT (t:zs), кT (t:zs), - нтT (t:zs), пT (t:zs), сT (t:zs), стT (t:zs), сьT (t:zs), тT (t:zs), тсT (t:zs), тьT (t:zs), +applyChanges (z:t:zs) | snd z == T = + X.getBFst' ((fst z, Z), VB.fromList . zip ["\1075","\1076","\1076\1079","\1078","\1079","\1082","\1085\1090", + "\1087","\1089","\1089\1090","\1089\1100","\1090","\1090\1089","\1090\1100","\1092","\1093","\1093\1075","\1094","\1094\1100","\1095","\1096"] + $ [гT (t:zs), дT (t:zs), дзT (t:zs), жT (t:zs), зT (t:zs), кT (t:zs), + нтT (t:zs), пT (t:zs), сT (t:zs), стT (t:zs), сьT (t:zs), тT (t:zs), тсT (t:zs), тьT (t:zs), фT (t:zs), хT (t:zs), хгT (t:zs), цT (t:zs), цьT (t:zs), чT (t:zs), шT (t:zs)]) (fst z):applyChanges (t:zs) | otherwise = z:applyChanges (t:zs) applyChanges [(xs, _)] = [(xs, Z)] @@ -146,11 +148,11 @@ -- need further processing means that there should be additional checks and may be transformations. May be they can be omitted isSoftDOrL :: [(String, Triple)] -> Bool -isSoftDOrL xs = getBFst' (False, V.fromList . zip ["\1073\1100","\1074\1100","\1076\1100","\1079\1100","\1083\1100", +isSoftDOrL xs = X.getBFst' (False, VB.fromList . zip ["\1073\1100","\1074\1100","\1076\1100","\1079\1100","\1083\1100", "\1084\1100","\1085\1100","\1087\1100","\1089\1100","\1090\1100","\1092\1100","\1094\1100"] $ (repeat True)) (takeFromFT_ 2 xs) isSoftDen :: [(String, Triple)] -> Bool -isSoftDen xs = getBFst' (False, V.fromList . zip ["\1076\1100","\1079\1100","\1083\1100","\1085\1100","\1089\1100", +isSoftDen xs = X.getBFst' (False, VB.fromList . zip ["\1076\1100","\1079\1100","\1083\1100","\1085\1100","\1089\1100", "\1090\1100","\1094\1100"] $ (repeat True)) (takeFromFT_ 2 xs) || takeFromFT_ 3 xs == "\1076\1079\1100" гT :: [(String, Triple)] -> (String, Triple) @@ -161,7 +163,7 @@ дT :: [(String, Triple)] -> (String, Triple) дT t1@(_:_) | takeFromFT_ 1 t1 `elem` ["\1078","\1095","\1096"] = ("\1076\1078", Z) -- need further processing д дж | takeFromFT_ 2 t1 `elem` ["\1089\1100","\1094\1100"] = ("\1076\1079\1100", T) -- need further processing д дзь - | takeFromFT_ 1 t1 `elem` ["\1079","\1089","\1094"] = ("\1076\1079", Z) -- need further processing д дз + | takeFromFT_ 1 t1 `elem` ["\1079","\1089","\1094"] = ("\1076\1079", Z) -- need further processing д дз | otherwise = ("\1076", Z) дT _ = ("д", Z) @@ -200,7 +202,7 @@ пT _ = ("п", Z) сT :: [(String, Triple)] -> (String, Triple) -сT t1@(_:_) | (isVoicedObstruent (takeFromFT_ 1 t1) && drop 1 (takeFromFT_ 2 t1) == "\1100") || +сT t1@(_:_) | (isVoicedObstruent (takeFromFT_ 1 t1) && drop 1 (takeFromFT_ 2 t1) == "\1100") || (isVoicedObstruent (takeFromFT_ 2 t1) && drop 2 (takeFromFT_ 3 t1) == "\1100") = ("\1079\1100", T) | isVoicedObstruent (takeFromFT_ 1 t1) || isVoicedObstruent (takeFromFT_ 2 t1) = ("\1073", Z) | isSoftDOrL t1 = ("\1089\1100", Z) @@ -222,7 +224,7 @@ сьT _ = ("сь", Z) тT :: [(String, Triple)] -> (String, Triple) -тT t1@(_:_) | (isVoicedObstruent (takeFromFT_ 1 t1) && drop 1 (takeFromFT_ 2 t1) == "\1100") || +тT t1@(_:_) | (isVoicedObstruent (takeFromFT_ 1 t1) && drop 1 (takeFromFT_ 2 t1) == "\1100") || (isVoicedObstruent (takeFromFT_ 2 t1) && drop 2 (takeFromFT_ 3 t1) == "\1100") = ("\1076\1100", T) | isVoicedObstruent (takeFromFT_ 2 t1) || isVoicedObstruent (takeFromFT_ 1 t1) = ("\1076", Z) | takeFromFT_ 2 t1 == "\1094\1100" = ("\1094\1100", Z) @@ -255,7 +257,7 @@ хгT _ = ("\1075", Z) цT :: [(String, Triple)] -> (String, Triple) -цT t1@(_:_) | (isVoicedObstruent (takeFromFT_ 1 t1) && drop 1 (takeFromFT_ 2 t1) == "\1100") || +цT t1@(_:_) | (isVoicedObstruent (takeFromFT_ 1 t1) && drop 1 (takeFromFT_ 2 t1) == "\1100") || (isVoicedObstruent (takeFromFT_ 2 t1) && drop 2 (takeFromFT_ 3 t1) == "\1100") = ("\1076\1079\1100", T) | isSoftDOrL t1 = ("\1094\1100", Z) | isVoicedObstruent (takeFromFT_ 2 t1) || isVoicedObstruent (takeFromFT_ 1 t1) = ("\1076\1079", Z) @@ -263,19 +265,19 @@ цT _ = ("ц", Z) цьT :: [(String, Triple)] -> (String, Triple) -цьT t1@(_:_) | (isVoicedObstruent (takeFromFT_ 1 t1) && drop 1 (takeFromFT_ 2 t1) == "\1100") || +цьT t1@(_:_) | (isVoicedObstruent (takeFromFT_ 1 t1) && drop 1 (takeFromFT_ 2 t1) == "\1100") || (isVoicedObstruent (takeFromFT_ 2 t1) && drop 2 (takeFromFT_ 3 t1) == "\1100") = ("\1076\1079\1100", T) | otherwise = ("\1094\1100", Z) цьT _ = ("ць", Z) чT :: [(String, Triple)] -> (String, Triple) -чT t1@(_:_) | takeFromFT_ 2 t1 `elem` ["\1089\1100","\1094\110"] = ("\1094\1100", Z) +чT t1@(_:_) | takeFromFT_ 2 t1 `elem` ["\1089\1100","\1094\1100"] = ("\1094\1100", Z) | isVoicedObstruent (takeFromFT_ 2 t1) || isVoicedObstruent (takeFromFT_ 1 t1) = ("\1076\1078", Z) | otherwise = ("\1095", Z) чT _ = ("ч", Z) шT :: [(String, Triple)] -> (String, Triple) -шT t1@(_:_) | takeFromFT_ 2 t1 `elem` ["\1089\1100","\1094\110"] = ("\1089\1100", Z) +шT t1@(_:_) | takeFromFT_ 2 t1 `elem` ["\1089\1100","\1094\1100"] = ("\1089\1100", Z) | isVoicedObstruent (takeFromFT_ 2 t1) || isVoicedObstruent (takeFromFT_ 1 t1) = ("\1078", Z) | otherwise = ("\1096", Z) шT _ = ("ш", Z) @@ -291,7 +293,7 @@ correctSomeW :: [(String, Triple)] -> [(String, Triple)] correctSomeW (x:y:z:xs) | fst x == "\1094\1100" && fst y == "\1089\1100" && fst z == "\1072" = x:("\1094\1100", Z):z:correctSomeW xs - | (fst x == "1" || fst x == "0") && fst y == "\1081" && fst z == "\1072" = + | (fst x == "1" || fst x == "0") && fst y == "\1081" && fst z == "\1072" = if takeFromFT 2 xs == "\1095\1085" then x:y:z:("\1096", Z):correctSomeW (tail xs) else x:correctSomeW (y:z:xs) @@ -321,8 +323,8 @@ takeFromFT_ :: Int -> [(String, Triple)] -> String takeFromFT_ n ts = takeFromFT n (filter (\(xs, _) -> (xs /= "1" && xs /= "0")) ts) -toVector :: [(String, Triple)] -> V.Vector String -toVector ts = V.fromList . correctB . mapI2 (\x -> not . null . fst $ x) fst (\_ -> []) $ ts +toVector :: [(String, Triple)] -> VB.Vector String +toVector ts = VB.fromList . correctB . mapI2 (\x -> not . null . fst $ x) fst (\_ -> []) $ ts isUkrainian :: Char -> Bool isUkrainian y | (y >= '\1040' && y <= '\1065') || (y >= '\1070' && y <= '\1097') = True diff --git a/mmsyn6ukr.cabal b/mmsyn6ukr.cabal --- a/mmsyn6ukr.cabal +++ b/mmsyn6ukr.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: mmsyn6ukr -version: 0.8.1.0 +version: 0.8.2.0 synopsis: A musical instrument synthesizer or a tool for Ukrainian language listening description: A program can be used as a musical instrument synthesizer or for Ukrainian speech synthesis especially for poets and writers homepage: https://hackage.haskell.org/package/mmsyn6ukr