{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Phladiprelio.Ukrainian.PropertiesSyllablesG2H -- Copyright : (c) Oleksandr Zhabenko 2020-2023 -- License : MIT -- Stability : Experimental -- Maintainer : oleksandr.zhabenko@yahoo.com -- -- Generalization and extension of the functionality of the DobutokO.Poetry.Norms -- and DobutokO.Poetry.Norms.Extended modules -- from the @dobutokO-poetry@ package. Uses syllables information. -- Instead of the vector-related, uses just arrays. {-# LANGUAGE NoImplicitPrelude, BangPatterns, MultiWayIf #-} module Phladiprelio.Ukrainian.PropertiesSyllablesG2H ( -- * General parseChRhEndMaybe -- * Extended general , rhythmicityTup ) where import Data.Tuple (uncurry) import GHC.Base import GHC.List import GHC.Real (rem) import Phladiprelio.Ukrainian.Common import Phladiprelio.Ukrainian.SyllableDouble import Phladiprelio.Ukrainian.Melodics (Sound8,FlowSound) import Phladiprelio.Ukrainian.Syllable import Data.Maybe (fromMaybe) import Text.Read (readMaybe) import Phladiprelio.Rhythmicity.TwoFourth import Phladiprelio.Rhythmicity.PolyRhythm import Phladiprelio.Ukrainian.PropertiesSyllablesG201 import GHC.Arr (Array) import GHC.Int (Int8) import Phladiprelio.Ukrainian.Emphasis import Phladiprelio.Coeffs import qualified Logical.OrdConstraints as LO import Phladiprelio.Rhythmicity.Factor helperF4 :: Int -> [[[Sound8]]] -> [[Double]] helperF4 n | n == 1 = syllableDurationsD | n == 2 = syllableDurationsD2 | n == 3 = syllableDurationsD3 | otherwise = syllableDurationsD4 ---------------------------------------------------------------- rhythmicityTup :: Factors -> Double -> String -> Coeffs2 -> Array Int (Int8, Bool) -> Array Int (Int8, Bool) -> Array Int (Int8, Bool) -> Array Int (Int8, Bool) -> Array Int ([Int8], Bool) -> Array Int ([Int8], Int8) -> Array Int (Int8, FlowSound -> Sound8) -> Array Int (Int8, Bool) -> Array Int ([Int8], Bool) -> Array Int ([Int8], Bool) -> Array Int ([Int8], Bool) -> Array Int (Int8, [Int8]) -> Array Int (Char,Int8) -> Array Int (Int8,[Int8]) -> Array Int (Char, Bool) -> Array Int (Char, Bool) -> Array Int (Int8,Bool) -> ReadyForConstructionUkr -> Double rhythmicityTup ff k choice@(t1:t2@(t3:t4@(t5:jis))) CF0 tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt@(Str tttts) | LO.ordCs2HPred1 [LO.O "cMN", LO.C "AF"] t1 = let just_probe = readRhythmicity choice in case just_probe of Just (P1 ch rh n) -> rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . -- the latter one is to be interchanged with weights2SyllableDurationsD (helperF4 n) . createSyllablesUkrSTup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 $ tttts Just (P2 ch rh r n) -> (case t1 of 'A' -> rhythmicityPolyWeightedLEF2 'D' -> rhythmicityPolyWeightedLF2 'E' -> rhythmicityPolyWeightedLEF3 'F' -> rhythmicityPolyWeightedLF3 'B' -> rhythmicityPolyWeightedEF2 'C' -> rhythmicityPolyWeightedF2 'M' -> rhythmicityPolyWeightedEF3 'N' -> rhythmicityPolyWeightedF3 'c' -> rhythmicityPoly) 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrSTup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 $ tttts _ -> rhythmicity04Tup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt | t1 == '0' = (case t2 of "2y" -> rhythmicity02Tup "3y" -> rhythmicity03Tup "2f" -> rhythmicity02FTup ff k "3f" -> rhythmicity03FTup ff k "4f" -> rhythmicity04FTup ff k _ -> rhythmicity04Tup) tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt | t1 `elem` "wx" = if | t5 >= '1' && t5 <= '4' -> if t3 >= '0' && t3 <= '3' then uncurry (wwF t4 tttts) (case t3 of '0' -> (Ch 1 1 4, Rhythm 1 1 2) '1' -> (Ch 1 0 4, Rhythm 2 1 1) '2' -> (Ch 0 1 4, Rhythm 1 2 1) '3' -> (Ch 0 0 4, Rhythm 1 1 2)) else rhythmicity04Tup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt | otherwise -> rhythmicity04Tup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt | LO.ordCs2HPred1 [LO.O "bz", LO.C "degvIZ"] t1 && t5 >= '1' && t5 <= '4' = (case t1 of 'b' -> g rhythmicityPolyWeightedLEF3 5 1 'd' -> g rhythmicityPolyWeightedLEF30 5 1 'e' -> g rhythmicityPolyWeightedLEF3 6 2 'g' -> g rhythmicityPolyWeightedLEF2 5 1 'h' -> g rhythmicityPolyWeightedLEF20 5 1 'i' -> g rhythmicityPolyWeightedLEF2 6 2 'j' -> g rhythmicityPolyWeightedLEF20 6 2 'k' -> g rhythmicityPolyWeightedLF3 5 1 'l' -> g rhythmicityPolyWeightedLF30 5 1 'm' -> g rhythmicityPolyWeightedLF3 6 2 'n' -> g rhythmicityPolyWeightedLF30 6 2 'o' -> g rhythmicityPolyWeightedLF2 5 1 'p' -> g rhythmicityPolyWeightedLF20 5 1 'q' -> g rhythmicityPolyWeightedLF2 6 2 'r' -> g rhythmicityPolyWeightedLF20 6 2 'I' -> g rhythmicityPolyWeightedEF3 5 1 'J' -> g rhythmicityPolyWeightedEF30 5 1 'K' -> g rhythmicityPolyWeightedEF3 6 2 'L' -> g rhythmicityPolyWeightedEF30 6 2 'O' -> g rhythmicityPolyWeightedEF2 5 1 'P' -> g rhythmicityPolyWeightedEF20 5 1 'Q' -> g rhythmicityPolyWeightedEF2 6 2 'R' -> g rhythmicityPolyWeightedEF20 6 2 'W' -> g rhythmicityPolyWeightedF3 5 1 'X' -> g rhythmicityPolyWeightedF30 5 1 'Y' -> g rhythmicityPolyWeightedF3 6 2 'Z' -> g rhythmicityPolyWeightedF30 6 2 'U' -> g rhythmicityPolyWeightedF2 5 1 'V' -> g rhythmicityPolyWeightedF20 5 1 'S' -> g rhythmicityPolyWeightedF2 6 2 'T' -> g rhythmicityPolyWeightedF20 6 2 'u' -> g rhythmicityPoly 5 1 'v' -> g rhythmicityPoly0 5 1 's' -> g rhythmicityPoly 6 2 't' -> g rhythmicityPoly0 6 2 'z' -> g rhythmicityPolyWeightedLEF30 6 2) tttts | otherwise = rhythmicity04Tup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt where h1 f ts xs m n = f 1.0 4 (PolyCh xs m) (PolyRhythm [1,2,1,n]) . mconcat . (case readMaybe ts::Maybe Int of { Just 1 -> syllableDurationsD ; Just 2 -> syllableDurationsD2 ; Just 3 -> syllableDurationsD3 ; Just 4 -> syllableDurationsD4 }) . createSyllablesUkrSTup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 h2 f ts xs m n = f 1.0 4 (PolyCh xs m) (PolyRhythm [2,1,1,n]) . mconcat . (case readMaybe ts::Maybe Int of { Just 1 -> syllableDurationsD ; Just 2 -> syllableDurationsD2 ; Just 3 -> syllableDurationsD3 ; Just 4 -> syllableDurationsD4 }) . createSyllablesUkrSTup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 g f m n | t3 >= '0' && t3 <= '3' && t5 >= '1' && t5 <= '4' = h1 f t4 (case t3 of '0' -> [True,True,True] '1' -> [True,True,False] '2' -> [True,False,True] '3' -> [True,False,False]) m n | t3 >= '4' && t3 <= '7' && t5 >= '1' && t5 <= '4' = h2 f t4 (case t3 of '4' -> [False,False,True] '5' -> [False,True,False] '6' -> [False,True,True] '7' -> [False,False,False]) m n | otherwise = \_ -> rhythmicity04Tup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt w1F f tttts ch rh = (if t1 == 'w' then rhythmicityABC else rhythmicityABC0) 1.0 2.0 0.125 ch rh . mconcat . f . createSyllablesUkrSTup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 $ tttts wwF2 g2 xs = let (Just n) = readMaybe xs::Maybe Int in g2 (case n `rem` 4 of 1 -> syllableDurationsD 2 -> syllableDurationsD2 3 -> syllableDurationsD3 _ -> syllableDurationsD4) wwF = wwF2 w1F {-# INLINE w1F #-} {-# INLINE wwF2 #-} {-# INLINE wwF #-} rhythmicityTup ff k choice@(t1:t2@(t3:t4@(t5:jis))) (CF2 x y) tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt@(Str tttts) | t1 == '0' = (case t2 of "2y" -> rhythmicityK2Tup "3y" -> rhythmicityK3Tup "2f" -> rhythmicityKF2Tup ff k "3f" -> rhythmicityKF3Tup ff k "4f" -> rhythmicityKF4Tup ff k _ -> rhythmicityK4Tup) (fromMaybe 1.0 x) (fromMaybe 1.0 y) tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt | t1 `elem` "wx" = if t5 >= '1' && t5 <= '4' then if t3 >= '0' && t3 <= '3' then uncurry (wwF t4 tttts) (case t3 of '0' -> (Ch 1 1 4, Rhythm 1 1 2) '1' -> (Ch 1 0 4, Rhythm 2 1 1) '2' -> (Ch 0 1 4, Rhythm 1 2 1) '3' -> (Ch 0 0 4, Rhythm 1 1 2)) else rhythmicity04Tup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt else rhythmicity04Tup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt | LO.ordCs2HPred1 [LO.O "bz", LO.C "begvAFIZ" ] t1 = rhythmicityTup ff k choice CF0 tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt | otherwise = rhythmicityK4Tup (fromMaybe 1.0 x) (fromMaybe 1.0 y) tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt where w1F f tttts ch rh = (if t1 == 'w' then rhythmicityABC else rhythmicityABC0) 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) ch rh . mconcat . f . createSyllablesUkrSTup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 $ tttts wwF xs = let (Just n) = readMaybe xs::Maybe Int in w1F (case n `rem` 4 of 1 -> syllableDurationsD 2 -> syllableDurationsD2 3 -> syllableDurationsD3 _ -> syllableDurationsD4) {-# INLINE w1F #-} {-# INLINE wwF #-} rhythmicityTup ff k choice@(t1:t2@(t3:jis)) CF0 tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt@(Str tttts) | t1 == '0' = (case t2 of "y" -> rhythmicity0Tup "f" -> rhythmicity0FTup ff k _ -> rhythmicity04Tup) tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt | otherwise = rhythmicity04Tup tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt rhythmicityTup ff k choice@(t1:t2@(t3:jis)) (CF2 x y) tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt@(Str tttts) | t1 == '0' = (case t2 of "y" -> rhythmicityKTup "f" -> rhythmicityKFTup ff k _ -> rhythmicityK4Tup) (fromMaybe 1.0 x) (fromMaybe 1.0 y) tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt | otherwise = rhythmicityK4Tup (fromMaybe 1.0 x) (fromMaybe 1.0 y) tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 tttt rhythmicityTup ff k choice tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 _ _ = -1.0