mediawiki2latex-7.6: src/FontTool.hs

module FontTool where
import MegaFont
import BaseFont
import Data.Char
import Data.Array
import Data.Map hiding ((!))
import Data.Maybe
import System.Info
 
megafont2 :: Map FontStyle (Array Int Char)
megafont2
  = Data.Map.fromList
      [(s,
        array ((0, (2 :: Int) ^ (16 :: Int) - 1) :: (Int, Int))
          (zip ([0 .. (2 :: Int) ^ (16 :: Int) - 1] :: [Int]) f))
       | (s, f) <- megafont]
 
getFont :: FontStyle -> Char -> Font
getFont fontStyle c
  = fromMaybe GnuUnifont
      ((Data.Map.lookup fontStyle megafont2) >>=
         return . fromCharToFont . (! (ord c)))
 
fontsetter :: Font -> [Char]
fontsetter f
  = if os == "linux" then
      "\\setmainfont" ++ inner ++ "\\setmonofont" ++ innermono else ""
  where filename
          = reverse ((takeWhile (/= '/')) (reverse (getttf f)))
        pathname = reverse ((dropWhile (/= '/')) (reverse (getttf f)))
        inner = "[Path=" ++ pathname ++ (mid f) ++ "]{" ++ filename ++ "}"
        innermono
          = "[Path=" ++ pathname ++ (midmono f) ++ "]{" ++ filename ++ "}"
        mid i
          | i `elem`
              [ComputerModernRoman, ComputerModernRomanBold,
               ComputerModernRomanItalic, ComputerModernRomanBoldItalic,
               ComputerModernTypeWriter, ComputerModernTypeWriterBold,
               ComputerModernTypeWriterItalic, ComputerModernTypeWriterBoldItalic]
            =
            ",UprightFont=cmunrm.ttf,BoldFont=cmunbx.ttf" ++
              ",ItalicFont=cmunti.ttf,BoldItalicFont=cmunbi.ttf"
        mid i
          | i `elem`
              [FreeSerif, FreeSerifBold, FreeSerifBoldItalic, FreeSerifItalic,
               FreeMono, FreeMonoOblique, FreeMonoBold, FreeMonoBoldOblique]
            =
            ",UprightFont=FreeSerif.ttf,BoldFont=FreeSerifBold.ttf," ++
              "ItalicFont=FreeSerifItalic.ttf,BoldItalicFont=FreeSerifBoldItalic.ttf"
        mid _ = ""
        midmono i
          | i `elem`
              [ComputerModernRoman, ComputerModernRomanBold,
               ComputerModernRomanItalic, ComputerModernRomanBoldItalic,
               ComputerModernTypeWriter, ComputerModernTypeWriterBold,
               ComputerModernTypeWriterItalic, ComputerModernTypeWriterBoldItalic]
            =
            ",UprightFont=cmuntt.ttf,BoldFont=cmuntb.ttf" ++
              ",ItalicFont=cmunit.ttf,BoldItalicFont=cmuntx.ttf"
        midmono i
          | i `elem`
              [FreeSerif, FreeSerifBold, FreeSerifBoldItalic, FreeSerifItalic,
               FreeMono, FreeMonoOblique, FreeMonoBold, FreeMonoBoldOblique]
            =
            ",UprightFont=FreeMono.ttf,BoldFont=FreeMonoBold.ttf," ++
              "ItalicFont=FreeMonoOblique.ttf,BoldItalicFont=FreeMonoBoldOblique.ttf"
        midmono _ = ""
 
fontstyler :: FontStyle -> [Char]
fontstyler s
  = (if (stylebase s) == Mono then "\\ttfamily " else "") ++
      (if (bold s) == True then "\\bfseries " else "") ++
        (if (italic s) == True then "\\itshape " else "")