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 "")