diff options
Diffstat (limited to 'src/GF/Text/Greek.hs')
| -rw-r--r-- | src/GF/Text/Greek.hs | 172 |
1 files changed, 0 insertions, 172 deletions
diff --git a/src/GF/Text/Greek.hs b/src/GF/Text/Greek.hs deleted file mode 100644 index 6b9361a29..000000000 --- a/src/GF/Text/Greek.hs +++ /dev/null @@ -1,172 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : Greek --- Maintainer : (Maintainer) --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/04/21 16:23:37 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.5 $ --- --- (Description of the module) ------------------------------------------------------------------------------ - -module GF.Text.Greek (mkGreek) where - -mkGreek :: String -> String -mkGreek = unwords . (map mkGreekWord) . mkGravis . words - ---- TODO : optimize character formation by factorizing the case expressions - -type GreekChar = Char - -mkGreekWord :: String -> [GreekChar] -mkGreekWord = map (toEnum . mkGreekChar) . mkGreekSpec - -mkGravis :: [String] -> [String] -mkGravis [] = [] -mkGravis [w] = [w] -mkGravis (w1:w2:ws) - | stressed w2 = mkG w1 : mkGravis (w2:ws) - | otherwise = w1 : w2 : mkGravis ws - where - stressed w = any (`elem` "'~`") w - mkG :: String -> String - mkG w = let (w1,w2) = span (/='\'') w in - case w2 of - '\'':v:cs | not (any isVowel cs) -> w1 ++ "`" ++ [v] ++ cs - '\'':'!':v:cs | not (any isVowel cs) -> w1 ++ "`!" ++ [v] ++ cs - _ -> w - isVowel c = elem c "aehiouw" - -mkGreekSpec :: String -> [(Char,Int)] -mkGreekSpec str = case str of - [] -> [] - '(' :'\'': '!' : c : cs -> (c,25) : mkGreekSpec cs - '(' :'~' : '!' : c : cs -> (c,27) : mkGreekSpec cs - '(' :'`' : '!' : c : cs -> (c,23) : mkGreekSpec cs - '(' : '!' : c : cs -> (c,21) : mkGreekSpec cs - ')' :'\'': '!' : c : cs -> (c,24) : mkGreekSpec cs - ')' :'~' : '!' : c : cs -> (c,26) : mkGreekSpec cs - ')' :'`' : '!' : c : cs -> (c,22) : mkGreekSpec cs - ')' : '!' : c : cs -> (c,20) : mkGreekSpec cs - '\'': '!' : c : cs -> (c,30) : mkGreekSpec cs - '~' : '!' : c : cs -> (c,31) : mkGreekSpec cs - '`' : '!' : c : cs -> (c,32) : mkGreekSpec cs - '!' : c : cs -> (c,33) : mkGreekSpec cs - '(' :'\'': c : cs -> (c,5) : mkGreekSpec cs - '(' :'~' : c : cs -> (c,7) : mkGreekSpec cs - '(' :'`' : c : cs -> (c,3) : mkGreekSpec cs - '(' : c : cs -> (c,1) : mkGreekSpec cs - ')' :'\'': c : cs -> (c,4) : mkGreekSpec cs - ')' :'~' : c : cs -> (c,6) : mkGreekSpec cs - ')' :'`' : c : cs -> (c,2) : mkGreekSpec cs - ')' : c : cs -> (c,0) : mkGreekSpec cs - '\'': c : cs -> (c,10) : mkGreekSpec cs - '~' : c : cs -> (c,11) : mkGreekSpec cs - '`' : c : cs -> (c,12) : mkGreekSpec cs - c : cs -> (c,-1) : mkGreekSpec cs - -mkGreekChar (c,-1) = case lookup c cc of Just c' -> c' ; _ -> fromEnum c - where - cc = zip "abgdezhqiklmnxoprjstyfcuw" allGreekMin -mkGreekChar (c,n) = case (c,n) of - ('a',10) -> 0x03ac - ('a',11) -> 0x1fb6 - ('a',12) -> 0x1f70 - ('a',30) -> 0x1fb4 - ('a',31) -> 0x1fb7 - ('a',32) -> 0x1fb2 - ('a',33) -> 0x1fb3 - ('a',n) | n >19 -> 0x1f80 + n - 20 - ('a',n) -> 0x1f00 + n - ('e',10) -> 0x03ad -- ' --- ('e',11) -> 0x1fb6 -- ~ can't happen - ('e',12) -> 0x1f72 -- ` - ('e',n) -> 0x1f10 + n - ('h',10) -> 0x03ae -- ' - ('h',11) -> 0x1fc6 -- ~ - ('h',12) -> 0x1f74 -- ` - - ('h',30) -> 0x1fc4 - ('h',31) -> 0x1fc7 - ('h',32) -> 0x1fc2 - ('h',33) -> 0x1fc3 - ('h',n) | n >19 -> 0x1f90 + n - 20 - - ('h',n) -> 0x1f20 + n - ('i',10) -> 0x03af -- ' - ('i',11) -> 0x1fd6 -- ~ - ('i',12) -> 0x1f76 -- ` - ('i',n) -> 0x1f30 + n - ('o',10) -> 0x03cc -- ' --- ('o',11) -> 0x1fb6 -- ~ can't happen - ('o',12) -> 0x1f78 -- ` - ('o',n) -> 0x1f40 + n - ('y',10) -> 0x03cd -- ' - ('y',11) -> 0x1fe6 -- ~ - ('y',12) -> 0x1f7a -- ` - ('y',n) -> 0x1f50 + n - ('w',10) -> 0x03ce -- ' - ('w',11) -> 0x1ff6 -- ~ - ('w',12) -> 0x1f7c -- ` - - ('w',30) -> 0x1ff4 - ('w',31) -> 0x1ff7 - ('w',32) -> 0x1ff2 - ('w',33) -> 0x1ff3 - ('w',n) | n >19 -> 0x1fa0 + n - 20 - - ('w',n) -> 0x1f60 + n - ('r',1) -> 0x1fe5 - _ -> mkGreekChar (c,-1) --- should not happen - -allGreekMin :: [Int] -allGreekMin = [0x03b1 .. 0x03c9] - - -{- -encoding of Greek writing. Those hard to guess are marked with --- - - maj min -A a Alpha 0391 03b1 -B b Beta 0392 03b2 -G g Gamma 0393 03b3 -D d Delta 0394 03b4 -E e Epsilon 0395 03b5 -Z z Zeta 0396 03b6 -H h Eta --- 0397 03b7 -Q q Theta --- 0398 03b8 -I i Iota 0399 03b9 -K k Kappa 039a 03ba -L l Lambda 039b 03bb -M m My 039c 03bc -N n Ny 039d 03bd -X x Xi 039e 03be -O o Omikron 039f 03bf -P p Pi 03a0 03c0 -R r Rho 03a1 03c1 - j Sigma --- 03c2 -S s Sigma 03a3 03c3 -T t Tau 03a4 03c4 -Y y Ypsilon 03a5 03c5 -F f Phi 03a6 03c6 -C c Khi --- 03a7 03c7 -U u Psi 03a8 03c8 -W w Omega --- 03a9 03c9 - -( spiritus asper -) spiritus lenis -! iota subscriptum - -' acutus -~ circumflexus -` gravis - --} - - - - - |