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}