-----------------------------------------------------------------------------
-- |
-- Module      :  FRP.UISF.Graphics.Text
-- Copyright   :  (c) Daniel Winograd-Cort 2015
-- License     :  see the LICENSE file in the distribution
--
-- Maintainer  :  dwc@cs.yale.edu
-- Stability   :  experimental

{-# LANGUAGE BangPatterns, FlexibleInstances, TypeSynonymInstances #-}
module FRP.UISF.Graphics.Text (
  UIText(..), UITexty(..),
  uitextToString, splitUIText, takeUIText, dropUIText, uitextLen,
  pureUIText, appendUIText, coloredUIText, rgbUIText, fontUIText,
  textWidth, textWithinPixels, textHeight,
  WrapSetting(..), prepText,
  textWidth', textWithinPixels', textHeight',
  uitextLines, uitextWords,
  BitmapFont(..),
  ) where

import Graphics.UI.GLUT.Fonts
import Data.Array.IArray
import Data.List (foldl')
import Data.Char (isSpace)
import Data.String (IsString(..))

import FRP.UISF.Graphics.Color
import FRP.UISF.Graphics.Types

import Control.DeepSeq

-- FIXME: I hate having an orphan instance here, but I'm not sure what to do about it.
instance NFData BitmapFont where
  rnf f = seq f ()

defaultFont = Fixed9By15

------------------------------------------------------------
-- UI Text
------------------------------------------------------------

-- | Text in UISF can be rendered in multiple fonts and colors, 
--  so we need a more powerful data type to encode it.  The UIText 
--  data type does this.
newtype UIText = UIText {unwrapUIT :: [(Maybe RGB, BitmapFont, String)]}
  deriving (Eq, Show)
instance NFData UIText where
  rnf (UIText lst) = rnf lst
instance IsString UIText where
  fromString = pureUIText

-- | To retain easy compatibility with Strings (or other text 
--  representations), we also provide the UITexty class, which is 
--  how all widgets that accept UIText should do so.
class UITexty a where
  toUIText :: a -> UIText

instance UITexty UIText where
  toUIText = id
instance UITexty String where
  toUIText = pureUIText
--instance UITexty Text where
--  toUIText = PureText . unpack

-- | The empty string in UIText.
emptyUIText :: UIText
emptyUIText = UIText []

-- | Returns True when given an empty string and False otherwise.
isEmptyUIText :: UIText -> Bool
isEmptyUIText uit = go (unwrapUIT uit) where
  go [] = True
  go ((_,_,[]):rest) = go rest
  go _ = False

-- | Removes all font and color formatting from a UIText, returning 
--  its underlying String representation.
uitextToString :: UIText -> String
uitextToString (UIText lst) = concatMap (\(_,_,s) -> s) lst

-- | Returns the number of characters in a UIText.
uitextLen :: UIText -> Int
uitextLen = length . uitextToString

-- | Take a certain number of characters off of a UIText
takeUIText :: Int -> UIText -> UIText
takeUIText n = fst . splitUIText n
--takeUIText n (UIText uit) = UIText $ go n uit where
--  go 0 uit = uit
--  go n [] = []
--  go n ((c,f,s):rest) = let n' = n - length s in
--    if n' < 0 then (c,f,drop n s):rest else go n' rest

-- | Drop a certain number of characters from a UIText
dropUIText :: Int -> UIText -> UIText
dropUIText n = snd . splitUIText n

-- | Split a UIText at the given character point.
splitUIText :: Int -> UIText -> (UIText, UIText)
splitUIText n (UIText uit) = let (u1,u2) = go n [] uit in (UIText u1, UIText u2) where
  go 0 taken rest = (reverse taken, rest)
  go n taken [] = (reverse taken, [])
  go n taken ((c,f,s):rest) = let n' = n - length s in
    if n' >= 0 then go n' ((c,f,s):taken) rest
    else let (t,d) = splitAt n s in (reverse ((c,f,t):taken), (c,f,d):rest)

-- | A convenience function for taking a UITexty object directly to the 
--  underlying (RGB,Font,String) list.
unwrapUITexty :: UITexty s => s -> [(Maybe RGB, BitmapFont, String)]
unwrapUITexty = unwrapUIT . toUIText

-- | Lifts a String to a UIText (with default color and font).
pureUIText :: String -> UIText
pureUIText s = UIText [(Nothing, defaultFont, s)]

-- | Appends two UITexty objects together.
appendUIText :: (UITexty s1, UITexty s2) => s1 -> s2 -> UIText
appendUIText s1 s2 = UIText $ unwrapUITexty s1 ++ unwrapUITexty s2

-- | Colors a UITexty object.
coloredUIText :: UITexty s => Color -> s -> UIText
coloredUIText c s = UIText $ map (\(_,f,str) -> (newC,f,str)) (unwrapUITexty s)
 where newC = Just $ colorToRGB c

-- | Colors a UITexty object with an exact RGB value.
rgbUIText c s = UIText $ map (\(_,f,str) -> (c,f,str)) (unwrapUITexty s)

-- | Converts the UITexty object to the given font.
fontUIText f s = UIText $ map (\(c,_,str) -> (c,f,str)) (unwrapUITexty s)


-- | Returns the width of the String in pixels as it will be rendered
textWidth :: UITexty s => s -> Int
textWidth s = sum $ map (\(_,f,str) -> textWidth' f str) (unwrapUITexty s)

-- | Given a String and a number of pixels, returns the leading 
--  substring that fits within the horizontal number of pixels along 
--  with the remaining text of the String.
textWithinPixels :: UITexty s => Int -> s -> (UIText, UIText)
textWithinPixels i s = let (s1,s2) = go i (unwrapUITexty s) []
  in (UIText s1, UIText s2) where
  go i [] sofar = (reverse sofar, [])
  go i ((c,f,str):rest) sofar = let i' = i - (textWidth' f str)
    in if i' >= 0
       then go i' rest ((c,f,str):sofar)
       else let (s1,s2) = textWithinPixels' f i str
            in (reverse $ (c,f,s1):sofar, (c,f,s2):rest)

-- | Returns the height of the String in pixels as it will be rendered
textHeight :: UITexty s => s -> Int
textHeight s = go (unwrapUITexty s) where
  go [] = textHeight' defaultFont ""
  go lst = maximum $ map (\(_,f,str) -> textHeight' f str) lst

-- | The Wrap Setting is used to determine how to split up a long piece 
--  of text.
data WrapSetting = NoWrap | CharWrap | WordWrap
  deriving (Eq, Show)

-- | Turn the given String into a list of Strings.  If the wrap setting 
--  is NoWrap, then this is basically just the lines function.  If it 
--  is CharWrap or WordWrap, then no string in the list will be wider 
--  than the width of the bounding box.  The returned list of points 
--  indicate each Point where a line should be drawn.  Note that this 
--  list may not be the same length as the list of strings.
--
--  Typically, this will be used in conjunction with zip and textLines 
--  to produce text graphics.
prepText :: (UITexty s)
         => WrapSetting -- ^ Whether we prefer newer or older text
         -> Double      -- ^ Line spacing
         -> Rect        -- ^ Bounding Box
         -> s           -- ^ The text to print (which is allowed to have new lines)
         -> ([Point], [UIText])
prepText wrap spacing ((x,y),(w,h)) s = (pts, outStrs) where
  lineHeight = round (fromIntegral (textHeight s) * spacing)
  numLines = h `div` lineHeight
  pts = zip (replicate numLines x) [y, y+lineHeight..]
  outStrs = concatMap (wrapText wrap w) (uitextLines' $ toUIText s)

-- | wrapText takes a wrap setting, a width, and a string, and turns 
--  it into a list of strings representing each wrapped line.  Strings 
--  are assumed to have no line breaks in them.  Calling unlines on the 
--  output will create a String that is wrapped.
wrapText :: UITexty s => WrapSetting -> Int -> s -> [UIText]
wrapText NoWrap _ s = [toUIText s]
wrapText CharWrap i s = if isEmptyUIText $ toUIText s
    then []
    else let (t,d) = textWithinPixels i s in t:wrapText CharWrap i d
wrapText WordWrap i s = f i emptyUIText (uitextWords' $ toUIText s) where
  f :: Int -> UIText -> [UIText] -> [UIText]
  f _ sofar [] = if isEmptyUIText sofar then [] else [sofar]
  f j sofar (w:ws) = case isEmptyUIText sofar of
    True  -> if textWidth w > i 
             then let (t,d) = textWithinPixels i w in t:f i emptyUIText (d:ws)
             else f (i-textWidth w) w ws
    False -> if textWidth w > j 
             then sofar:f i emptyUIText (w:ws)
             else f (j-textWidth w) (appendUIText sofar w) ws

-- | The common String 'words' function applicable to UIText.
uitextWords :: UIText -> [UIText]
uitextWords = uitSplitter isSpace (\x -> ([], dropWhile isSpace x))

-- | The common String 'lines' function applicable to UIText.
uitextLines :: UIText -> [UIText]
uitextLines = uitSplitter (== '\n') (\x -> ([], drop 1 x))

-- | A variant of uitextLines that keeps the newline characters at the 
--  ends of the output.
uitextLines' :: UIText -> [UIText]
uitextLines' = uitSplitter (== '\n') (splitAt 1)

-- | A variant of uitextWords that keeps the whitespace characters at 
--  the ends of the output.
uitextWords' :: UIText -> [UIText]
uitextWords' = uitSplitter isSpace (span isSpace)

-- | A convenience function for writing functions like lines and words.
uitSplitter :: (Char -> Bool) -> (String -> (String,String)) -> UIText -> [UIText]
uitSplitter checker splitter (UIText lst) = map UIText $ uitSplitter' lst where
  uitSplitter' [] = []
  uitSplitter' uitext = go uitext [] where
    go [] sofar = [reverse sofar]
    go ((c,f,s):rest) sofar = case break checker s of
      (_, "") -> go rest ((c,f,s):sofar)
      (l,s') -> reverse ((c,f,l++s1):sofar) : uitSplitter' ((c,f,s2):rest)
        where (s1,s2) = splitter s'


-- | Returns the text height of a String rendered in the given bitmap font.
textHeight' :: BitmapFont -> String -> Int
textHeight' f _ = getFontHeight f

-- | Returns the text width of a String rendered in the given bitmap font.
textWidth' :: BitmapFont -> String -> Int
textWidth' f str = foldl' (\acc c -> acc + (getFontArray f ! c)) 0 str

-- | Splits a String based on what can fit within the given number of 
--  pixels (the fst of the result) and what's left over (the snd).
textWithinPixels' :: BitmapFont -> Int -> String -> (String, String)
textWithinPixels' f i str = go f i str "" where
  go _ _ [] sofar = (reverse sofar, "")
  go f i (c:s) sofar = let i' = i - (getFontArray f ! c)
    in if i' >= 0 then go f i' s (c:sofar) else (reverse sofar, c:s)

-- | Returns the font height for a given font.
getFontHeight :: BitmapFont -> Int
getFontHeight Fixed8By13    = 14
getFontHeight Fixed9By15    = 16
getFontHeight TimesRoman10  = 14
getFontHeight TimesRoman24  = 29
getFontHeight Helvetica10   = 14
getFontHeight Helvetica12   = 16
getFontHeight Helvetica18   = 23
--getFontHeight Roman         = 153
--getFontHeight MonoRoman     = 153

-- | Returns the font array for a given font.
getFontArray :: BitmapFont -> Array Char Int
getFontArray Fixed8By13     = fixed8By13
getFontArray Fixed9By15     = fixed9By15
getFontArray TimesRoman10   = timesRoman10
getFontArray TimesRoman24   = timesRoman24
getFontArray Helvetica10    = helvetica10
getFontArray Helvetica12    = helvetica12
getFontArray Helvetica18    = helvetica18
--getFontArray Roman          = roman
--getFontArray MonoRoman      = monoRoman



-- | Makes Char width arrays for fonts.
makeCharArray :: [(Char, Int)] -> Array Char Int
makeCharArray = array (toEnum 0 :: Char, toEnum 255 :: Char)

fixed8By13, fixed9By15, timesRoman10, timesRoman24, helvetica10, helvetica12, helvetica18, roman, monoRoman :: Array Char Int
fixed8By13   = makeCharArray [('\NUL',0),('\SOH',8),('\STX',8),('\ETX',8),('\EOT',8),('\ENQ',8),('\ACK',8),('\a',8),('\b',8),('\t',8),('\n',0),('\v',8),('\f',8),('\r',8),('\SO',8),('\SI',8),('\DLE',8),('\DC1',8),('\DC2',8),('\DC3',8),('\DC4',8),('\NAK',8),('\SYN',8),('\ETB',8),('\CAN',8),('\EM',8),('\SUB',8),('\ESC',8),('\FS',8),('\GS',8),('\RS',8),('\US',8),(' ',8),('!',8),('"',8),('#',8),('$',8),('%',8),('&',8),('\'',8),('(',8),(')',8),('*',8),('+',8),(',',8),('-',8),('.',8),('/',8),('0',8),('1',8),('2',8),('3',8),('4',8),('5',8),('6',8),('7',8),('8',8),('9',8),(':',8),(';',8),('<',8),('=',8),('>',8),('?',8),('@',8),('A',8),('B',8),('C',8),('D',8),('E',8),('F',8),('G',8),('H',8),('I',8),('J',8),('K',8),('L',8),('M',8),('N',8),('O',8),('P',8),('Q',8),('R',8),('S',8),('T',8),('U',8),('V',8),('W',8),('X',8),('Y',8),('Z',8),('[',8),('\\',8),(']',8),('^',8),('_',8),('`',8),('a',8),('b',8),('c',8),('d',8),('e',8),('f',8),('g',8),('h',8),('i',8),('j',8),('k',8),('l',8),('m',8),('n',8),('o',8),('p',8),('q',8),('r',8),('s',8),('t',8),('u',8),('v',8),('w',8),('x',8),('y',8),('z',8),('{',8),('|',8),('}',8),('~',8),('\DEL',8),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',8),('\161',8),('\162',8),('\163',8),('\164',0),('\165',8),('\166',0),('\167',0),('\168',0),('\169',0),('\170',8),('\171',8),('\172',8),('\173',0),('\174',0),('\175',0),('\176',8),('\177',8),('\178',8),('\179',0),('\180',0),('\181',8),('\182',0),('\183',8),('\184',0),('\185',0),('\186',8),('\187',8),('\188',8),('\189',8),('\190',0),('\191',8),('\192',0),('\193',0),('\194',0),('\195',0),('\196',8),('\197',8),('\198',8),('\199',8),('\200',0),('\201',8),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',8),('\210',0),('\211',0),('\212',0),('\213',0),('\214',8),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',8),('\221',0),('\222',0),('\223',8),('\224',8),('\225',8),('\226',8),('\227',0),('\228',8),('\229',8),('\230',8),('\231',8),('\232',8),('\233',8),('\234',8),('\235',8),('\236',8),('\237',8),('\238',8),('\239',8),('\240',0),('\241',8),('\242',8),('\243',8),('\244',8),('\245',0),('\246',8),('\247',8),('\248',0),('\249',8),('\250',8),('\251',8),('\252',8),('\253',0),('\254',0),('\255',8)]
fixed9By15   = makeCharArray [('\NUL',0),('\SOH',9),('\STX',9),('\ETX',9),('\EOT',9),('\ENQ',9),('\ACK',9),('\a',9),('\b',9),('\t',9),('\n',0),('\v',9),('\f',9),('\r',9),('\SO',9),('\SI',9),('\DLE',9),('\DC1',9),('\DC2',9),('\DC3',9),('\DC4',9),('\NAK',9),('\SYN',9),('\ETB',9),('\CAN',9),('\EM',9),('\SUB',9),('\ESC',9),('\FS',9),('\GS',9),('\RS',9),('\US',9),(' ',9),('!',9),('"',9),('#',9),('$',9),('%',9),('&',9),('\'',9),('(',9),(')',9),('*',9),('+',9),(',',9),('-',9),('.',9),('/',9),('0',9),('1',9),('2',9),('3',9),('4',9),('5',9),('6',9),('7',9),('8',9),('9',9),(':',9),(';',9),('<',9),('=',9),('>',9),('?',9),('@',9),('A',9),('B',9),('C',9),('D',9),('E',9),('F',9),('G',9),('H',9),('I',9),('J',9),('K',9),('L',9),('M',9),('N',9),('O',9),('P',9),('Q',9),('R',9),('S',9),('T',9),('U',9),('V',9),('W',9),('X',9),('Y',9),('Z',9),('[',9),('\\',9),(']',9),('^',9),('_',9),('`',9),('a',9),('b',9),('c',9),('d',9),('e',9),('f',9),('g',9),('h',9),('i',9),('j',9),('k',9),('l',9),('m',9),('n',9),('o',9),('p',9),('q',9),('r',9),('s',9),('t',9),('u',9),('v',9),('w',9),('x',9),('y',9),('z',9),('{',9),('|',9),('}',9),('~',9),('\DEL',9),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',9),('\161',9),('\162',9),('\163',9),('\164',0),('\165',9),('\166',0),('\167',0),('\168',0),('\169',0),('\170',9),('\171',9),('\172',9),('\173',0),('\174',0),('\175',0),('\176',9),('\177',9),('\178',9),('\179',0),('\180',0),('\181',9),('\182',0),('\183',9),('\184',0),('\185',0),('\186',9),('\187',9),('\188',9),('\189',9),('\190',0),('\191',9),('\192',0),('\193',0),('\194',0),('\195',0),('\196',9),('\197',9),('\198',9),('\199',9),('\200',0),('\201',9),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',9),('\210',0),('\211',0),('\212',0),('\213',0),('\214',9),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',9),('\221',0),('\222',0),('\223',9),('\224',9),('\225',9),('\226',9),('\227',0),('\228',9),('\229',9),('\230',9),('\231',9),('\232',9),('\233',9),('\234',9),('\235',9),('\236',9),('\237',9),('\238',9),('\239',9),('\240',0),('\241',9),('\242',9),('\243',9),('\244',9),('\245',0),('\246',9),('\247',9),('\248',0),('\249',9),('\250',9),('\251',9),('\252',9),('\253',0),('\254',0),('\255',9)]
timesRoman10 = makeCharArray [('\NUL',0),('\SOH',2),('\STX',2),('\ETX',2),('\EOT',2),('\ENQ',2),('\ACK',2),('\a',2),('\b',2),('\t',2),('\n',0),('\v',2),('\f',2),('\r',2),('\SO',2),('\SI',2),('\DLE',2),('\DC1',2),('\DC2',2),('\DC3',2),('\DC4',2),('\NAK',2),('\SYN',2),('\ETB',2),('\CAN',2),('\EM',2),('\SUB',2),('\ESC',2),('\FS',2),('\GS',2),('\RS',2),('\US',2),(' ',2),('!',3),('"',4),('#',5),('$',5),('%',8),('&',8),('\'',3),('(',4),(')',4),('*',5),('+',6),(',',3),('-',7),('.',3),('/',3),('0',5),('1',5),('2',5),('3',5),('4',5),('5',5),('6',5),('7',5),('8',5),('9',5),(':',3),(';',3),('<',5),('=',6),('>',5),('?',4),('@',9),('A',8),('B',6),('C',7),('D',7),('E',6),('F',6),('G',7),('H',8),('I',4),('J',4),('K',7),('L',6),('M',10),('N',8),('O',7),('P',6),('Q',7),('R',7),('S',5),('T',6),('U',8),('V',8),('W',10),('X',8),('Y',8),('Z',6),('[',3),('\\',3),(']',3),('^',5),('_',5),('`',3),('a',4),('b',5),('c',4),('d',5),('e',4),('f',4),('g',5),('h',5),('i',3),('j',3),('k',5),('l',4),('m',8),('n',5),('o',5),('p',5),('q',5),('r',4),('s',4),('t',4),('u',5),('v',5),('w',8),('x',6),('y',5),('z',5),('{',4),('|',2),('}',4),('~',7),('\DEL',2),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',5),('\161',4),('\162',2),('\163',2),('\164',0),('\165',2),('\166',0),('\167',0),('\168',0),('\169',0),('\170',2),('\171',9),('\172',4),('\173',0),('\174',0),('\175',0),('\176',5),('\177',5),('\178',5),('\179',0),('\180',0),('\181',6),('\182',0),('\183',5),('\184',0),('\185',0),('\186',5),('\187',4),('\188',7),('\189',5),('\190',0),('\191',5),('\192',0),('\193',0),('\194',0),('\195',0),('\196',2),('\197',2),('\198',2),('\199',2),('\200',0),('\201',2),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',5),('\210',0),('\211',0),('\212',0),('\213',0),('\214',2),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',2),('\221',0),('\222',0),('\223',4),('\224',2),('\225',2),('\226',2),('\227',0),('\228',2),('\229',2),('\230',2),('\231',2),('\232',2),('\233',2),('\234',2),('\235',2),('\236',2),('\237',3),('\238',2),('\239',2),('\240',0),('\241',5),('\242',2),('\243',5),('\244',2),('\245',0),('\246',2),('\247',5),('\248',0),('\249',2),('\250',5),('\251',2),('\252',2),('\253',0),('\254',0),('\255',2)]
timesRoman24 = makeCharArray [('\NUL',0),('\SOH',6),('\STX',6),('\ETX',6),('\EOT',6),('\ENQ',6),('\ACK',6),('\a',6),('\b',6),('\t',6),('\n',0),('\v',6),('\f',6),('\r',6),('\SO',6),('\SI',6),('\DLE',6),('\DC1',6),('\DC2',6),('\DC3',6),('\DC4',6),('\NAK',6),('\SYN',6),('\ETB',6),('\CAN',6),('\EM',6),('\SUB',6),('\ESC',6),('\FS',6),('\GS',6),('\RS',6),('\US',6),(' ',6),('!',8),('"',10),('#',13),('$',12),('%',19),('&',18),('\'',8),('(',8),(')',8),('*',12),('+',14),(',',7),('-',14),('.',6),('/',7),('0',12),('1',12),('2',12),('3',12),('4',12),('5',12),('6',12),('7',12),('8',12),('9',12),(':',6),(';',7),('<',13),('=',14),('>',13),('?',11),('@',22),('A',17),('B',16),('C',16),('D',17),('E',15),('F',14),('G',18),('H',19),('I',8),('J',11),('K',17),('L',14),('M',22),('N',18),('O',18),('P',15),('Q',18),('R',16),('S',13),('T',16),('U',18),('V',17),('W',23),('X',18),('Y',16),('Z',15),('[',8),('\\',7),(']',8),('^',11),('_',13),('`',7),('a',11),('b',12),('c',11),('d',12),('e',11),('f',7),('g',12),('h',13),('i',6),('j',6),('k',12),('l',6),('m',20),('n',13),('o',12),('p',12),('q',12),('r',8),('s',10),('t',7),('u',13),('v',11),('w',17),('x',13),('y',11),('z',10),('{',10),('|',6),('}',10),('~',13),('\DEL',6),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',11),('\161',9),('\162',6),('\163',6),('\164',0),('\165',6),('\166',0),('\167',0),('\168',0),('\169',0),('\170',6),('\171',19),('\172',8),('\173',0),('\174',0),('\175',0),('\176',12),('\177',13),('\178',11),('\179',0),('\180',0),('\181',16),('\182',0),('\183',13),('\184',0),('\185',0),('\186',12),('\187',8),('\188',14),('\189',13),('\190',0),('\191',8),('\192',0),('\193',0),('\194',0),('\195',0),('\196',6),('\197',6),('\198',6),('\199',6),('\200',0),('\201',6),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',14),('\210',0),('\211',0),('\212',0),('\213',0),('\214',6),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',6),('\221',0),('\222',0),('\223',11),('\224',6),('\225',6),('\226',6),('\227',0),('\228',6),('\229',6),('\230',6),('\231',6),('\232',6),('\233',6),('\234',6),('\235',6),('\236',6),('\237',8),('\238',6),('\239',6),('\240',0),('\241',13),('\242',6),('\243',12),('\244',6),('\245',0),('\246',6),('\247',12),('\248',0),('\249',6),('\250',12),('\251',6),('\252',6),('\253',0),('\254',0),('\255',6)]
helvetica10  = makeCharArray [('\NUL',0),('\SOH',3),('\STX',3),('\ETX',3),('\EOT',3),('\ENQ',3),('\ACK',3),('\a',3),('\b',3),('\t',3),('\n',0),('\v',3),('\f',3),('\r',3),('\SO',3),('\SI',3),('\DLE',3),('\DC1',3),('\DC2',3),('\DC3',3),('\DC4',3),('\NAK',3),('\SYN',3),('\ETB',3),('\CAN',3),('\EM',3),('\SUB',3),('\ESC',3),('\FS',3),('\GS',3),('\RS',3),('\US',3),(' ',3),('!',3),('"',4),('#',6),('$',6),('%',9),('&',8),('\'',3),('(',4),(')',4),('*',4),('+',6),(',',3),('-',7),('.',3),('/',3),('0',6),('1',6),('2',6),('3',6),('4',6),('5',6),('6',6),('7',6),('8',6),('9',6),(':',3),(';',3),('<',6),('=',5),('>',6),('?',6),('@',11),('A',7),('B',7),('C',8),('D',8),('E',7),('F',6),('G',8),('H',8),('I',3),('J',5),('K',7),('L',6),('M',9),('N',8),('O',8),('P',7),('Q',8),('R',7),('S',7),('T',5),('U',8),('V',7),('W',9),('X',7),('Y',7),('Z',7),('[',3),('\\',3),(']',3),('^',6),('_',6),('`',3),('a',5),('b',6),('c',5),('d',6),('e',5),('f',4),('g',6),('h',6),('i',2),('j',2),('k',5),('l',2),('m',8),('n',6),('o',6),('p',6),('q',6),('r',4),('s',5),('t',4),('u',5),('v',6),('w',8),('x',6),('y',5),('z',5),('{',3),('|',3),('}',3),('~',7),('\DEL',3),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',5),('\161',4),('\162',3),('\163',3),('\164',0),('\165',3),('\166',0),('\167',0),('\168',0),('\169',0),('\170',3),('\171',9),('\172',4),('\173',0),('\174',0),('\175',0),('\176',6),('\177',5),('\178',5),('\179',0),('\180',0),('\181',8),('\182',0),('\183',5),('\184',0),('\185',0),('\186',6),('\187',3),('\188',7),('\189',6),('\190',0),('\191',3),('\192',0),('\193',0),('\194',0),('\195',0),('\196',3),('\197',3),('\198',3),('\199',3),('\200',0),('\201',3),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',6),('\210',0),('\211',0),('\212',0),('\213',0),('\214',3),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',3),('\221',0),('\222',0),('\223',5),('\224',3),('\225',3),('\226',3),('\227',0),('\228',3),('\229',3),('\230',3),('\231',3),('\232',3),('\233',3),('\234',3),('\235',3),('\236',3),('\237',3),('\238',3),('\239',3),('\240',0),('\241',5),('\242',3),('\243',6),('\244',3),('\245',0),('\246',3),('\247',6),('\248',0),('\249',3),('\250',6),('\251',3),('\252',3),('\253',0),('\254',0),('\255',3)]
helvetica12  = makeCharArray [('\NUL',0),('\SOH',4),('\STX',4),('\ETX',4),('\EOT',4),('\ENQ',4),('\ACK',4),('\a',4),('\b',4),('\t',4),('\n',0),('\v',4),('\f',4),('\r',4),('\SO',4),('\SI',4),('\DLE',4),('\DC1',4),('\DC2',4),('\DC3',4),('\DC4',4),('\NAK',4),('\SYN',4),('\ETB',4),('\CAN',4),('\EM',4),('\SUB',4),('\ESC',4),('\FS',4),('\GS',4),('\RS',4),('\US',4),(' ',4),('!',3),('"',5),('#',7),('$',7),('%',11),('&',9),('\'',3),('(',4),(')',4),('*',5),('+',7),(',',4),('-',8),('.',3),('/',4),('0',7),('1',7),('2',7),('3',7),('4',7),('5',7),('6',7),('7',7),('8',7),('9',7),(':',3),(';',3),('<',7),('=',7),('>',7),('?',7),('@',12),('A',9),('B',8),('C',9),('D',9),('E',8),('F',8),('G',9),('H',9),('I',3),('J',7),('K',8),('L',7),('M',11),('N',9),('O',10),('P',8),('Q',10),('R',8),('S',8),('T',7),('U',8),('V',9),('W',11),('X',9),('Y',9),('Z',9),('[',3),('\\',4),(']',3),('^',6),('_',7),('`',3),('a',7),('b',7),('c',7),('d',7),('e',7),('f',3),('g',7),('h',7),('i',3),('j',3),('k',6),('l',3),('m',9),('n',7),('o',7),('p',7),('q',7),('r',4),('s',6),('t',3),('u',7),('v',7),('w',9),('x',6),('y',7),('z',6),('{',4),('|',3),('}',4),('~',7),('\DEL',4),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',7),('\161',5),('\162',4),('\163',4),('\164',0),('\165',4),('\166',0),('\167',0),('\168',0),('\169',0),('\170',3),('\171',11),('\172',5),('\173',0),('\174',0),('\175',0),('\176',7),('\177',7),('\178',7),('\179',0),('\180',0),('\181',11),('\182',0),('\183',7),('\184',0),('\185',0),('\186',6),('\187',4),('\188',8),('\189',7),('\190',0),('\191',3),('\192',0),('\193',0),('\194',0),('\195',0),('\196',4),('\197',4),('\198',4),('\199',4),('\200',0),('\201',4),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',7),('\210',0),('\211',0),('\212',0),('\213',0),('\214',4),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',4),('\221',0),('\222',0),('\223',7),('\224',4),('\225',4),('\226',4),('\227',0),('\228',4),('\229',4),('\230',4),('\231',4),('\232',4),('\233',4),('\234',4),('\235',4),('\236',4),('\237',3),('\238',4),('\239',4),('\240',0),('\241',7),('\242',4),('\243',7),('\244',4),('\245',0),('\246',4),('\247',7),('\248',0),('\249',4),('\250',7),('\251',4),('\252',4),('\253',0),('\254',0),('\255',4)]
helvetica18  = makeCharArray [('\NUL',0),('\SOH',5),('\STX',5),('\ETX',5),('\EOT',5),('\ENQ',5),('\ACK',5),('\a',5),('\b',5),('\t',5),('\n',0),('\v',5),('\f',5),('\r',5),('\SO',5),('\SI',5),('\DLE',5),('\DC1',5),('\DC2',5),('\DC3',5),('\DC4',5),('\NAK',5),('\SYN',5),('\ETB',5),('\CAN',5),('\EM',5),('\SUB',5),('\ESC',5),('\FS',5),('\GS',5),('\RS',5),('\US',5),(' ',5),('!',6),('"',5),('#',10),('$',10),('%',16),('&',13),('\'',4),('(',6),(')',6),('*',7),('+',10),(',',5),('-',11),('.',5),('/',5),('0',10),('1',10),('2',10),('3',10),('4',10),('5',10),('6',10),('7',10),('8',10),('9',10),(':',5),(';',5),('<',10),('=',11),('>',10),('?',10),('@',18),('A',12),('B',13),('C',14),('D',13),('E',11),('F',11),('G',14),('H',13),('I',6),('J',10),('K',13),('L',10),('M',16),('N',13),('O',15),('P',12),('Q',15),('R',12),('S',13),('T',12),('U',13),('V',14),('W',18),('X',13),('Y',14),('Z',12),('[',5),('\\',5),(']',5),('^',9),('_',10),('`',4),('a',9),('b',11),('c',10),('d',11),('e',10),('f',6),('g',11),('h',10),('i',4),('j',4),('k',9),('l',4),('m',14),('n',10),('o',11),('p',11),('q',11),('r',6),('s',9),('t',6),('u',10),('v',10),('w',14),('x',10),('y',10),('z',9),('{',6),('|',4),('}',6),('~',10),('\DEL',5),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',10),('\161',7),('\162',5),('\163',5),('\164',0),('\165',5),('\166',0),('\167',0),('\168',0),('\169',0),('\170',4),('\171',14),('\172',7),('\173',0),('\174',0),('\175',0),('\176',11),('\177',10),('\178',10),('\179',0),('\180',0),('\181',15),('\182',0),('\183',10),('\184',0),('\185',0),('\186',10),('\187',5),('\188',11),('\189',9),('\190',0),('\191',6),('\192',0),('\193',0),('\194',0),('\195',0),('\196',5),('\197',5),('\198',5),('\199',5),('\200',0),('\201',5),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',10),('\210',0),('\211',0),('\212',0),('\213',0),('\214',5),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',5),('\221',0),('\222',0),('\223',9),('\224',5),('\225',5),('\226',5),('\227',0),('\228',5),('\229',5),('\230',5),('\231',5),('\232',5),('\233',5),('\234',5),('\235',5),('\236',5),('\237',6),('\238',5),('\239',5),('\240',0),('\241',10),('\242',5),('\243',10),('\244',5),('\245',0),('\246',5),('\247',11),('\248',0),('\249',5),('\250',10),('\251',5),('\252',5),('\253',0),('\254',0),('\255',5)]
roman        = makeCharArray [('\NUL',0),('\SOH',0),('\STX',0),('\ETX',0),('\EOT',0),('\ENQ',0),('\ACK',0),('\a',0),('\b',0),('\t',0),('\n',0),('\v',0),('\f',0),('\r',0),('\SO',0),('\SI',0),('\DLE',0),('\DC1',0),('\DC2',0),('\DC3',0),('\DC4',0),('\NAK',0),('\SYN',0),('\ETB',0),('\CAN',0),('\EM',0),('\SUB',0),('\ESC',0),('\FS',0),('\GS',0),('\RS',0),('\US',0),(' ',105),('!',27),('"',51),('#',79),('$',76),('%',97),('&',102),('\'',14),('(',47),(')',48),('*',59),('+',97),(',',26),('-',101),('.',26),('/',82),('0',77),('1',67),('2',78),('3',77),('4',80),('5',78),('6',74),('7',77),('8',78),('9',74),(':',26),(';',26),('<',82),('=',97),('>',82),('?',74),('@',74),('A',80),('B',84),('C',84),('D',85),('E',78),('F',79),('G',90),('H',89),('I',21),('J',60),('K',79),('L',71),('M',97),('N',89),('O',89),('P',86),('Q',88),('R',82),('S',81),('T',72),('U',89),('V',82),('W',101),('X',72),('Y',80),('Z',74),('[',46),('\\',78),(']',46),('^',90),('_',104),('`',84),('a',67),('b',70),('c',69),('d',70),('e',69),('f',39),('g',71),('h',71),('i',29),('j',36),('k',63),('l',19),('m',124),('n',71),('o',72),('p',71),('q',71),('r',49),('s',62),('t',39),('u',71),('v',61),('w',80),('x',56),('y',66),('z',62),('{',42),('|',24),('}',41),('~',91),('\DEL',67),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',0),('\161',0),('\162',0),('\163',0),('\164',0),('\165',0),('\166',0),('\167',0),('\168',0),('\169',0),('\170',0),('\171',0),('\172',0),('\173',0),('\174',0),('\175',0),('\176',0),('\177',0),('\178',0),('\179',0),('\180',0),('\181',0),('\182',0),('\183',0),('\184',0),('\185',0),('\186',0),('\187',0),('\188',0),('\189',0),('\190',0),('\191',0),('\192',0),('\193',0),('\194',0),('\195',0),('\196',0),('\197',0),('\198',0),('\199',0),('\200',0),('\201',0),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',0),('\210',0),('\211',0),('\212',0),('\213',0),('\214',0),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',0),('\221',0),('\222',0),('\223',0),('\224',0),('\225',0),('\226',0),('\227',0),('\228',0),('\229',0),('\230',0),('\231',0),('\232',0),('\233',0),('\234',0),('\235',0),('\236',0),('\237',0),('\238',0),('\239',0),('\240',0),('\241',0),('\242',0),('\243',0),('\244',0),('\245',0),('\246',0),('\247',0),('\248',0),('\249',0),('\250',0),('\251',0),('\252',0),('\253',0),('\254',0),('\255',0)]
monoRoman    = makeCharArray [('\NUL',0),('\SOH',0),('\STX',0),('\ETX',0),('\EOT',0),('\ENQ',0),('\ACK',0),('\a',0),('\b',0),('\t',0),('\n',0),('\v',0),('\f',0),('\r',0),('\SO',0),('\SI',0),('\DLE',0),('\DC1',0),('\DC2',0),('\DC3',0),('\DC4',0),('\NAK',0),('\SYN',0),('\ETB',0),('\CAN',0),('\EM',0),('\SUB',0),('\ESC',0),('\FS',0),('\GS',0),('\RS',0),('\US',0),(' ',105),('!',105),('"',105),('#',105),('$',105),('%',105),('&',105),('\'',105),('(',105),(')',105),('*',105),('+',105),(',',105),('-',105),('.',105),('/',105),('0',105),('1',105),('2',105),('3',105),('4',105),('5',105),('6',105),('7',105),('8',105),('9',105),(':',105),(';',105),('<',105),('=',105),('>',105),('?',105),('@',105),('A',105),('B',105),('C',105),('D',105),('E',105),('F',105),('G',105),('H',105),('I',105),('J',105),('K',105),('L',105),('M',105),('N',105),('O',105),('P',105),('Q',105),('R',105),('S',105),('T',105),('U',105),('V',105),('W',105),('X',105),('Y',105),('Z',105),('[',105),('\\',105),(']',105),('^',105),('_',105),('`',105),('a',105),('b',105),('c',105),('d',105),('e',105),('f',105),('g',105),('h',105),('i',105),('j',105),('k',105),('l',105),('m',105),('n',105),('o',105),('p',105),('q',105),('r',105),('s',105),('t',105),('u',105),('v',105),('w',105),('x',105),('y',105),('z',105),('{',105),('|',105),('}',105),('~',105),('\DEL',105),('\128',0),('\129',0),('\130',0),('\131',0),('\132',0),('\133',0),('\134',0),('\135',0),('\136',0),('\137',0),('\138',0),('\139',0),('\140',0),('\141',0),('\142',0),('\143',0),('\144',0),('\145',0),('\146',0),('\147',0),('\148',0),('\149',0),('\150',0),('\151',0),('\152',0),('\153',0),('\154',0),('\155',0),('\156',0),('\157',0),('\158',0),('\159',0),('\160',0),('\161',0),('\162',0),('\163',0),('\164',0),('\165',0),('\166',0),('\167',0),('\168',0),('\169',0),('\170',0),('\171',0),('\172',0),('\173',0),('\174',0),('\175',0),('\176',0),('\177',0),('\178',0),('\179',0),('\180',0),('\181',0),('\182',0),('\183',0),('\184',0),('\185',0),('\186',0),('\187',0),('\188',0),('\189',0),('\190',0),('\191',0),('\192',0),('\193',0),('\194',0),('\195',0),('\196',0),('\197',0),('\198',0),('\199',0),('\200',0),('\201',0),('\202',0),('\203',0),('\204',0),('\205',0),('\206',0),('\207',0),('\208',0),('\209',0),('\210',0),('\211',0),('\212',0),('\213',0),('\214',0),('\215',0),('\216',0),('\217',0),('\218',0),('\219',0),('\220',0),('\221',0),('\222',0),('\223',0),('\224',0),('\225',0),('\226',0),('\227',0),('\228',0),('\229',0),('\230',0),('\231',0),('\232',0),('\233',0),('\234',0),('\235',0),('\236',0),('\237',0),('\238',0),('\239',0),('\240',0),('\241',0),('\242',0),('\243',0),('\244',0),('\245',0),('\246',0),('\247',0),('\248',0),('\249',0),('\250',0),('\251',0),('\252',0),('\253',0),('\254',0),('\255',0)]