module BaseFont where
import Data.Char
import Data.Array
import Data.Tuple
data FontStyleBase = Normal
| Mono
| Smallcaps
deriving (Eq, Ord, Show)
data FontStyle = FontStyle{stylebase :: FontStyleBase,
bold :: Bool, italic :: Bool}
deriving (Eq, Ord, Show)
data Font = GnuUnifont
| WenQuanYiZenHei
| FreeMono
| FreeMonoOblique
| FreeMonoBold
| FreeMonoBoldOblique
| FreeSerif
| FreeSerifBold
| FreeSerifBoldItalic
| FreeSerifItalic
| ComputerModernTypeWriter
| ComputerModernTypeWriterBold
| ComputerModernTypeWriterItalic
| ComputerModernTypeWriterBoldItalic
| ComputerModernRoman
| ComputerModernRomanBold
| ComputerModernRomanItalic
| ComputerModernRomanBoldItalic
deriving (Eq, Ord, Show, Ix)
fonts :: [Font]
fonts
= reverse
[GnuUnifont, WenQuanYiZenHei, FreeMono, FreeMonoOblique,
FreeMonoBold, FreeMonoBoldOblique, FreeSerif, FreeSerifBold,
FreeSerifBoldItalic, FreeSerifItalic, ComputerModernTypeWriter,
ComputerModernTypeWriterBold, ComputerModernTypeWriterItalic,
ComputerModernTypeWriterBoldItalic, ComputerModernRoman,
ComputerModernRomanBold, ComputerModernRomanItalic,
ComputerModernRomanBoldItalic]
fontList :: [(Font, Int)]
fontList = zip fonts [(ord 'A') ..]
fromFontToChar :: Font -> Char
fromFontToChar f
= chr
((array (GnuUnifont, ComputerModernRomanBoldItalic) fontList) ! f)
fromCharToFont :: Char -> Font
fromCharToFont c
= (array (ord ('A'), ord ('A') + (length fontList) - 1)
(map swap fontList))
! (ord c)
getttf :: Font -> [Char]
getttf ComputerModernTypeWriter
= "/usr/share/fonts/truetype/cmu/cmuntt.ttf"
getttf ComputerModernTypeWriterBoldItalic
= "/usr/share/fonts/truetype/cmu/cmuntx.ttf"
getttf ComputerModernTypeWriterItalic
= "/usr/share/fonts/truetype/cmu/cmunit.ttf"
getttf ComputerModernTypeWriterBold
= "/usr/share/fonts/truetype/cmu/cmuntb.ttf"
getttf ComputerModernRoman
= "/usr/share/fonts/truetype/cmu/cmunrm.ttf"
getttf ComputerModernRomanBold
= "/usr/share/fonts/truetype/cmu/cmunbx.ttf"
getttf ComputerModernRomanItalic
= "/usr/share/fonts/truetype/cmu/cmunti.ttf"
getttf ComputerModernRomanBoldItalic
= "/usr/share/fonts/truetype/cmu/cmunbi.ttf"
getttf FreeMono = "/usr/share/fonts/truetype/freefont/FreeMono.ttf"
getttf FreeMonoOblique
= "/usr/share/fonts/truetype/freefont/FreeMonoOblique.ttf"
getttf FreeMonoBold
= "/usr/share/fonts/truetype/freefont/FreeMonoBold.ttf"
getttf FreeMonoBoldOblique
= "/usr/share/fonts/truetype/freefont/FreeMonoBoldOblique.ttf"
getttf FreeSerif
= "/usr/share/fonts/truetype/freefont/FreeSerif.ttf"
getttf FreeSerifBold
= "/usr/share/fonts/truetype/freefont/FreeSerifBold.ttf"
getttf FreeSerifBoldItalic
= "/usr/share/fonts/truetype/freefont/FreeSerifBoldItalic.ttf"
getttf FreeSerifItalic
= "/usr/share/fonts/truetype/freefont/FreeSerifItalic.ttf"
getttf GnuUnifont = "/usr/share/fonts/truetype/unifont/unifont.ttf"
getttf WenQuanYiZenHei
= "/usr/share/fonts/truetype/wqy/wqy-zenhei.ttc"
getstyle :: Font -> FontStyle
getstyle GnuUnifont
= FontStyle{stylebase = Normal, bold = False, italic = False}
getstyle WenQuanYiZenHei
= FontStyle{stylebase = Normal, bold = False, italic = False}
getstyle FreeMono
= FontStyle{stylebase = Mono, bold = False, italic = False}
getstyle FreeMonoOblique
= FontStyle{stylebase = Mono, bold = False, italic = True}
getstyle FreeMonoBold
= FontStyle{stylebase = Mono, bold = True, italic = False}
getstyle FreeMonoBoldOblique
= FontStyle{stylebase = Mono, bold = True, italic = True}
getstyle FreeSerif
= FontStyle{stylebase = Normal, bold = False, italic = False}
getstyle FreeSerifBold
= FontStyle{stylebase = Normal, bold = True, italic = False}
getstyle FreeSerifBoldItalic
= FontStyle{stylebase = Normal, bold = True, italic = True}
getstyle FreeSerifItalic
= FontStyle{stylebase = Normal, bold = False, italic = True}
getstyle ComputerModernTypeWriter
= FontStyle{stylebase = Mono, bold = False, italic = False}
getstyle ComputerModernTypeWriterBold
= FontStyle{stylebase = Mono, bold = True, italic = False}
getstyle ComputerModernTypeWriterItalic
= FontStyle{stylebase = Mono, bold = False, italic = True}
getstyle ComputerModernTypeWriterBoldItalic
= FontStyle{stylebase = Mono, bold = True, italic = True}
getstyle ComputerModernRoman
= FontStyle{stylebase = Normal, bold = False, italic = False}
getstyle ComputerModernRomanBold
= FontStyle{stylebase = Normal, bold = True, italic = False}
getstyle ComputerModernRomanItalic
= FontStyle{stylebase = Normal, bold = False, italic = True}
getstyle ComputerModernRomanBoldItalic
= FontStyle{stylebase = Normal, bold = True, italic = True}