module Graphics.SVGFonts.ReadFont
(triang, cycleNeighbours, displayString, AObj(..),Prop(..), Mode(..), Spacing(..), CharProp(..), makeMaps)
where

import Text.XML.Light
import System.IO.Unsafe (unsafePerformIO)
import Text.ParserCombinators.Parsec hiding (spaces)
import Text.ParserCombinators.Parsec.Expr
import qualified Text.ParserCombinators.Parsec.Token as P
import Text.ParserCombinators.Parsec.Language( javaStyle )
import Data.Char
import Data.Word
import Data.Bits
import Data.Array.Unboxed
-- import Graphics.SVGFonts.KETTriangulation ( ketTri )
import Graphics.SVGFonts.Triangulation (adaptTri, Triangle(..), cycle_n)
import Graphics.SVGFonts.RasterFont (raster,F2P,Bitmask,AA(..),createTexture,texData)
import Graphics.SVG.ReadPath
import Debug.Trace
import List(intersect,sortBy)
import Graphics.Rendering.OpenGL hiding (Triangle)
import Control.Monad
import Control.Monad.ST
import qualified Data.STRef
import Data.Maybe
import qualified Data.Map as Map
import System.Directory
import Graphics.Formats.TGA.TGA
import Data.List.Split
import Data.Tuple.Select

-- http://www.w3.org/TR/SVG/fonts.html#KernElements
type Kern = ( Map.Map Char [Int], Map.Map Char [Int], Map.Map Char [Int], Map.Map Char [Int], Array Int X)
type SvgGlyph = Map.Map Char (String, X, String)
type FontData = (SvgGlyph, Kern, String, String)
type X = Float
type Y = Float
type F2 = (X,Y)

openFont :: FilePath -> FontData
openFont file = (Map.fromList (zip4 (unicodes, glyphNames, horiz, ds)), -- sort after unicode
                   (transform u1s, transform u2s, transform g1s, transform g2s, kAr), bbox, fname file )

  where xml = onlyElems $ parseXML (unsafePerformIO (readFile file))
        selectFontface = concat $ map (findElements (unqual "font-face")) xml
        selectGlyphs   = concat $ map (findElements (unqual "glyph"))     xml
        selectKerns    = concat $ map (findElements (unqual "hkern"))     xml
        bbox        = fromMaybe "" $ head $ map (findAttr (unqual "bbox")) selectFontface
        glyphNames  = map (fromMaybe "") $ map (findAttr (unqual "glyph-name"))  selectGlyphs
        unicodes    = map (fromMaybe "") $ map (findAttr (unqual "unicode"))     selectGlyphs
        horiz       = map (fromMaybe "") $ map (findAttr (unqual "horiz-adv-x")) selectGlyphs
        ds          = map (fromMaybe "") $ map (findAttr (unqual "d"))           selectGlyphs

        u1s         = map (fromMaybe "") $ map (findAttr (unqual "u1"))  selectKerns
        u2s         = map (fromMaybe "") $ map (findAttr (unqual "u2"))  selectKerns
        g1s         = map (fromMaybe "") $ map (findAttr (unqual "g1"))  selectKerns
        g2s         = map (fromMaybe "") $ map (findAttr (unqual "g2"))  selectKerns
        ks          = map (fromMaybe "") $ map (findAttr (unqual "k"))   selectKerns
        kAr     = listArray (0,(length ks)-1) (map read ks)

        transform chars = Map.fromList $ map ch $ multiSet $ map (\(x,y) -> (x,[y])) $ sort fst $ concat $ index chars
        ch = \(x,y) -> (myHead x,y)
        -- ^ see Linlibertine.svg, there are two groups of chars: i.e.
        -- <hkern g1="f,longs,uni1E1F,f_f" g2="parenright,bracketright,braceright" k="-37" />
        -- this line means: if there is an f followed by parentright reduce the horizontal advance by 37. Therefore to quickly
        -- check if two characters need kerning assign an index to the second group (g2 or u2) and assign to every unicode in
        -- the first group (g1 or u1) this index, then sort these tuples after their name (for binary search). Because the same
        -- unicode char can appear in several g1s, reduce this 'multiset', ie all the ("name1",0) ("name1",1) to ("name1",[0,1]).
        -- Now the g2s are converted in the same way as the g1s. Whenever two consecutive chars are being printed try to find an
        -- intersection of the list assigned to the first char and second char 

        index u = addIndex (map (splitBy isColon) u) -- ^ie ["aa,b","c,d"] to [["aa","b"],["c","d"]]
                                                     --                    to [("aa",0),("b",0)],[("c",1), ("d",1)]
        isColon = (== ',')

        addIndex qs = zipWith (\x y -> (map (f x) y)) [0..] qs
        f = \index char -> (char,index)
        sort f xs = sortBy (\x y -> compare (f x) (f y) ) xs

        multiSet [] = []
        multiSet (a:[]) = [a] -- ^ example: [("n1",[0]),("n1",[1]),("n2",[1])] to [("n1",[0,1]),("n2",[1])]
        multiSet (a:b:bs) | fst a == fst b = multiSet ( (fst a, (snd a) ++ (snd b)) : bs)
                          | otherwise = a : (multiSet (b:bs))

        myHead a | length a == 0 = ' '
                 | otherwise = head a
        fname f = last $ init $ concat (map (splitOn "/") (splitOn "." f))
        zip4 (a:as, b:bs, c:cs, d:ds) = (myHead a, (b, read c, d)) : (zip4 (as,bs,cs,ds))
        zip4 _ = []
		
splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy _ [] = []
splitBy f list = first : splitBy f (dropWhile f rest) where
 (first, rest) = break f list

-- |convert path-commands to outline points, which consist of bitmaps (resolution 16x16) for subpixel rasterization
commandsToRasterPoints :: [PathCommand] -> F2 -> [[F2P]]
commandsToRasterPoints commands (dx, dy) | length result == 0 = []
                                         | otherwise = map (raster (dx, dy)) result
 where result = ctp commands [(0,0)] (0,0) True 255 (dx/2,dy)

---------------------------------------------------

data Tree = Node Int [F2] [Tree] | Nil -- c is the nesting counter and p a polygon

instance Show Tree where
         show (Node c p tree) = "Node" ++ (show c) ++ (show (length p)) ++ "[" ++ (concat(map show tree)) ++ "]"
         show (Nil) = "Nil"

-- |transform a polygon with (nested) holes into one outline.
-- I.e. the chars a,b,d,e,g,o,p,q contain holes tat have to be deleted.
-- This is useful for operations like extrusion.
deleteHoles :: [PathCommand] -> F2 -> [[F2]]
deleteHoles commands deltas = flatten trees
  where trees = generateTrees insidePoly $ commandsToPoints commands deltas
        flatten []                       = []
        flatten (Nil:ts)                 = flatten ts
        flatten ((Node c poly [Nil]):ts) = (direction c (polygonDirection poly) poly) : (flatten ts)
        flatten ((Node c poly ps)   :ts) = ( embed (flatten ps) (direction c (polygonDirection poly) poly) ) : (flatten ts)

-- |cut a polygon at a good position and insert the contained hole-polygon with opposite direction
embed :: [[F2]] -> [F2] -> [F2]
embed []            poly = poly
embed (s:sub_polys) poly = embed sub_polys ((take (n+1) poly) ++ s ++ (drop n poly))
  where n = fst (rotatePoly (head s) poly)

-- |make sure that direction (clockwise or ccw) of polygons alternates depending on the nesting number c of poly
direction :: Int -> Bool -> [F2] -> [F2]
direction c b poly | (b && (even c)) || (not b && (odd c)) = poly
                   | otherwise = reverse poly

-- |f should be the funtion to test "contains"
-- the trees then are the hierarchy of containedness of outlines
generateTrees :: ([F2]->[F2]->Bool) -> [[F2]] -> [Tree]
generateTrees f [] = []
generateTrees f ps = mergeNodes f (map (\p -> Node 0 p []) ps) []

mergeNodes :: ([F2]->[F2]->Bool) -> [Tree] -> [Tree] -> [Tree]
mergeNodes f []     result = result
mergeNodes f (v:vs) result = mergeNodes f vs (insertNode f v result)

insertNode :: ([F2]->[F2]->Bool) -> Tree -> [Tree] -> [Tree]
insertNode f (Node _ poly []) ((Node c p []):ts)|(f poly p)= (Node c p [Node (c+1) poly []]) : ts
                                                |(f p poly)= (Node c poly [Node (c+1) p []]) : ts
                                                |otherwise = (Node c p []) : ( insertNode f (Node (c+1) poly []) ts)
insertNode f (Node c poly []) [] = [(Node c poly [])]
insertNode f (Node _ poly []) ((Node c p ps):ts)|(f poly p) = (Node c p (insertNode f (Node (c+1) poly []) ps)) : ts
                                                |(f p poly) = [Node (c-1) poly ((Node c p ps) : ts)]
                                                |otherwise  = (Node c p ps): ( insertNode f (Node c poly []) ts)

-- |how many positions to rotate a polygon until the start point is nearest to some other point
-- call i.e. with nearest (3,4) [(0,0),(1,2), ... ] 0 0
rotatePoly :: F2 -> [F2] -> (Int,X)
rotatePoly p points = (fst tup, snd tup)
  where tup = nearest p points (-1) 0 0

nearest :: F2 -> [F2] -> X -> Int -> Int -> (Int,X)
nearest _       []           dist l ml = (ml,dist)
nearest (x0,y0) ((x1,y1):ps) dist l ml | (newDist < dist) || (dist < 0) = nearest (x0,y0) ps newDist (l+1) l
                                       | otherwise                      = nearest (x0,y0) ps dist    (l+1) ml
  where newDist = (x0-x1)*(x0-x1)+(y0-y1)*(y0-y1)


polygonDirection :: [F2] -> Bool
polygonDirection poly = sum (zipWith crossp l1 l2) > 0
  where l1 = map (\(a,b) -> b `sub` a) ((tail c) ++ [head c])
        l2 = map (\(a,b) -> a `sub` b) c
        c = map (\list -> (head list, last list)) (cycleNeighbours poly) -- [(p0,p1),(p1,p2),(p2,p3),..
        sub (x0,y0) (x1,y1) = (x0-x1, y0-y1)
        crossp (v0,v1) (w0,w1) = v0*w1-v1*w0

insidePoly :: [F2] -> [F2] -> Bool
insidePoly [] _ = False
insidePoly _ [] = False
insidePoly poly1 poly2 = pointInside (head poly1) poly2

-- |A point is inside a polygon if it has an odd number of intersections with the boundary (Jordan Curve theorem)
pointInside :: F2 -> [F2] -> Bool
pointInside (x,y) poly = (length intersectPairs) `mod` 2 == 1 -- trace (show intersectPairs)
  where intersectPairs = [ p | p <- allPairs, positiveXAxis p, aboveBelow p] --, specialCases p]
        allPairs = cycleNeighbours poly
        positiveXAxis p = (x0 p) > x || (x1 p) > x -- ^intersect with positive x-axis
                                                   -- only lines with one point above + one point below can intersect
        aboveBelow p = (((y0 p)> y && (y1 p)< y) || ((y0 p) < y && (y1 p) > y))
        specialCases p = (((dir1 p) > 0 && (dir2 p) <= 0) || ((dir1 p) <= 0 && (dir2 p) > 0))-- cross product for special cases
        dir1 p = cross ((x1 p)-(x0 p),(y1 p)-(y0 p)) (1,0)
        dir2 p = cross ((x1 p)-(x0 p),(y1 p)-(y0 p)) (x-(x0 p),y-(y0 p))
        cross (a0,b0) (a1,b1) = a0*b1 - a1*b0
        x0 p = fst (head p)
        x1 p = fst (last p)
        y0 p = snd (head p)
        y1 p = snd (last p)

-- |return a list containing lists of every element with its neighbour
-- i.e. [e1,e2,e3] -> [ [e1,e2], [e2,e3], [e3, e1] ]
cycleNeighbours :: [a] -> [[a]]
cycleNeighbours [] = []
cycleNeighbours xs = cycleN (head xs) xs

cycleN :: a -> [a] -> [[a]]
cycleN f (x:y:xs) = [x,y] : (cycle_n f (y:xs))
cycleN f e = [[head e, f ]] -- ^if the upper doesn't match close cycle

triang :: [(X,Y)] -> [(Int,Int,Int)]
triang poly = [] -- map indi (adaptTri poly) -- ketTri poly
  where indi (Triangle ((_,_,i0), (_,_,i1), (_,_,i2))) = (i0,i1,i2)

data F a = NotFound | Found a
fromFound (Found a) = a
instance Eq (F a) where
  NotFound == NotFound = True
  _        == _        = False

-- type Kern = ( Map.Map Char [Int], Map.Map Char [Int], Map.Map Char [Int], Map.Map Char [Int], Array Int X)
-- |horizontal advances of characters inside a string
horizontalAdvances :: [(Char,FontData)] -> Bool -> [X] -- Kern -> SvgGlyph -> [X]
horizontalAdvances strfont kerning = hlist strfont -- kern glyphData = hlist str
  where hlist :: [(Char,FontData)] -> [X]
        hlist [(ch0,fd0)] = [ha ch0 fd0]
        hlist ((ch0,fd0):(ch1,fd1):s) = ((ha ch0 fd0) + (ka ch0 ch1 fd0 fd1 (sel2 fd0))) : (hlist ((ch1,fd1):s))
        ka :: Char -> Char -> FontData -> FontData -> Kern -> Float
        ka ch0 ch1 fd0 fd1 kern | (sel4 fd0) == (sel4 fd1) && kerning =
               (kernAdvance ch0 ch1 kern True) + (kernAdvance ch0 ch1 kern False) -- no kerning when different fonts
                                | otherwise = 0
        ha ch fd = sel2 $ fromJust $ Map.lookup ch (sel1 fd)

kernAdvance :: Char -> Char -> Kern -> Bool -> X
kernAdvance ch0 ch1 kern u |     u && (length s0) > 0 = (sel5 kern)!(head s0)
                           | not u && (length s1) > 0 = (sel5 kern)!(head s1)
                           | otherwise = 0
  where s0 = intersect (s sel1 ch0) (s sel2 ch1)
        s1 = intersect (s sel3 ch0) (s sel4 ch1)
        s sel ch = concat (maybeToList (Map.lookup ch (sel kern)))

-- |extrude a 2d polygon to 3d, the same points are added again with extrusion direction v
add_points3d :: V -> Prop -> [AObj] -> [AObj]
add_points3d v pr [] = []
add_points3d v pr poly =
      poly ++                           -- bottom polygon
      ( map (add_points v pr) (map (\x -> Annotate x pr) (cycleNeighbours (de_ann(head poly)))) ) ++ --side polygons
      [ Annotate (map (add v) (de_ann(head poly))) (property (head poly)) ]  -- top polygon

property (Annotate ps pr) = pr
de_ann (Annotate ps pr) = ps

-- extrude a line to a construct a polygon
add_points :: V -> Prop -> AObj -> AObj
add_points v pr (Annotate p _)  = Annotate (p ++ (map (add v) (reverse p))) pr
-- add_points v pr _  = Annotate [] pr		


type O = V -- position vector
data Prop = RedGreenBlue (Float, Float, Float) | N |   -- N = not visible
            TexObj (TextureObject,String)  |
            Textur (Maybe TextureObject)  |
            TexFile String  |
            Triangul [(Int,Int,Int)] -- list of triangles

data CharProp = Outline V | Textured | ObjColor Int Int Int Int | Font (FontData, OutlineMap, TexMap)
data AObj = Annotate [V] Prop
type V = (Float,Float,Float) -- x,y,z
blue  = RedGreenBlue (0,0,1)

set_len (x,y,z) l = (x*c*l, y*c*l, z*c*l) where c = 1 / v_len (x,y,z)
v_len (x,y,z) = sqrt (x*x+y*y+z*z)

divide (x,y,z) c = (x/c, y/c, z/c)
mul (x,y,z) c = (x*c, y*c, z*c)
add (x0,y0,z0) (x1,y1,z1) = (x0+x1, y0+y1, z0+z1)

n = (0,0,0)
-- ------------------------
-- main library functions
--------------------------
type TexMap =  Map.Map Char (TextureObject, String)
type OutlineMap =  Map.Map Char [([F2], Prop)]
data Mode = INSIDE_V1_V2_V3 | -- the string is inside v1 v2 v3 boundaries (height/length-relation not kept)
            INSIDE_V1 |       -- stay inside v1 boundary, size of v2 adjusted to height/length-relation
			INSIDE_V2         -- stay inside v2 boundary, size of v1 adjusted to height/length-relation

data Spacing = MONO | -- use mono spacing between glyphs
               HADV | -- every glyph has a unique constant horiz. advance
               KERN   -- same as HADV but sometimes overridden by kerning: i.e. the horizontal advance in "VV" is bigger than in "VA"

mV1V2V3 INSIDE_V1_V2_V3 = True
mV1V2V3 _ = False
mV1 INSIDE_V1 = True
mV1 _ = False
mV2 INSIDE_V2 = True
mV2 _ = False

isMono MONO = True
isMono _    = False
isKern KERN = True
isKern _    = False

type FileName = String
type P = [Char] -> [(Char,[CharProp])]

displayString :: String -> (Int,Int) -> Mode -> Spacing -> O -> V -> V -> P -> [AObj]
displayString str (rx,ry) mode spacing o v1 v2 f | mV1V2V3 mode = concat (make_string v1 v2)
                                                 | mV1 mode     = concat (make_string v1 new_v2)
                                                 | mV2 mode     = concat (make_string new_v1 v2)
  where
    -- :type FontData = ([(glyph_names, unicodes, horiz_advance, ds)], Kern, bbox-string)
    make_string u1 u2 = map (getC u1 u2 (sumh,(max_x,max_y)) (rx,ry)) (zip4 str hor_pos hs properties)
    sumh | isMono spacing = max_x * (fromIntegral (length str)) -- not meant to be monospaced, so this is just a hack
         | otherwise      = sum hs                              -- maybe a very long glyph can mess up a font
    hor_pos | isMono spacing = reverse $ added (o: (replicate (length str) (v1_advance `mul` max_x)))
            | otherwise      = reverse $ added (o: stretch hs)
    hs = horizontalAdvances (zip str fontList) (isKern spacing) -- kern_list (sel1 fontD)
    properties = map snd (f str)
    fontList = map (sel1.getFont) properties
    stretch = map (v1_advance `mul`)
    added = snd.(foldl (\(h,l) (b,_) -> (h`add`b, (h`add`b):l)) ((0,0,0),[])).(map (\x->(x,[]))) -- [o,o+h0,o+h0+h1,..]
    new_v1 = set_len v1 ( (v_len v2) * (sumh/max_y) )
    new_v2 = set_len v2 ( (v_len v1) * (max_y/sumh) )
    max_x = maximum (map maximum_x fontList)
    max_y = maximum (map maximum_y fontList)  -- max height of glyph
    v1_advance | mV1V2V3 mode || mV1 mode = v1     `divide` sumh
               | mV2 mode                 = new_v1 `divide` sumh

    zip4 (a:as) (b:bs) (c:cs) (d:ds) = (a, b, c, d) : (zip4 as bs cs ds)
    zip4 _ _ _ _ = []

getC u1 u2 tri (rx,ry) (ch,h,h_ad,pr) | or (map hasTex pr)= texChar    (sel1 sfd) tm     u1 u2            tri    (ch,h,h_ad)
                                      | (length v3s) > 0 = polygonChar (sel1 sfd) om sfd u1 u2 (head v3s) tri (rx,ry) (ch,h)
                                      | otherwise = []
  where hasTex :: CharProp -> Bool
        hasTex Textured = True
        hasTex _        = False

        v3s :: [V]
        v3s = concat (map outl pr)
        outl (Outline v3) = [v3]
        outl _            = []

        sfd = sel1 fd
        fd = getFont pr
        om = sel2 fd
        tm = sel3 fd

getFont :: [CharProp] -> (FontData, OutlineMap, TexMap)
getFont pr = head $ concat (map gF pr) -- if several Fonts are given, take the first
  where gF (Font (fontD, outlMap, texMap)) = [(fontD, outlMap, texMap)]
        gF _                             = []


maximum_y fontData = read (head (drop 3 bbox)) -- bbox lower left x, lower left y, upper right x, upper right y
  where bbox = splitBy isSpace (sel3 fontData)
maximum_x fontData = read (head (drop 2 bbox))
  where bbox = splitBy isSpace (sel3 fontData)


polygonChar :: SvgGlyph -> OutlineMap -> FontData -> V -> V -> V -> (Float, F2) -> (Int,Int) -> (Char,V) -> [AObj]
polygonChar g outl fontD v1 v2 v3 (sum_of_hs, (max_x, max_y)) (rx,ry) (ch,h) = glyph_faces
  where
  glyph_faces = if (length out_tri) == 0 then [] else glyph3d -- all the triangles/quads the whole glyph has
                -- tail (init glyph3d) -- with tail and init top and bottom polygon are deleted
  glyph3d = concat ( map (\(o,t) -> add_points3d v3 blue [ Annotate (map resize o) t ] ) (out_tri) )
  resize (x,y) = h `add` (v1 `mul` (x * (fst deltas) / sum_of_hs)) `add` (v2 `mul` (y * (snd deltas)/ max_y))
  deltas = (max_x/(fromIntegral rx), max_y/(fromIntegral ry))
  out_tri = fromJust $ Map.lookup ch outl

texChar :: SvgGlyph -> TexMap -> V -> V -> (Float, F2) -> (Char,V,Float) -> [AObj]
texChar g texmap v1 v2 (sumh, (max_x, max_y)) (ch,h,h_ad) =
          [ Annotate [ res (n,v2), res (n,n), res (v1,n), res (v1,v2) ] (TexObj tex) ] -- n = (0,0,0)
  where
    res (v,w) = h `add` (v `mul` (h_ad / sumh)) `add` w
    tex = fromJust (Map.lookup ch texmap)


makeMaps :: String -> (Int,Int) -> (FontData, OutlineMap, TexMap)
makeMaps str (rx,ry) = (fontD, makeOutlMap fontD (rx,ry), makeTexMap fontD (rx,ry))
  where fontD = openFont str

-- a char like "i" has two outlines (one for the dot) and two triangulations
makeOutlMap :: FontData -> (Int,Int) -> OutlineMap -- type OutlineMap =  Map.Map Char [([F2], Prop)]
makeOutlMap fontD (rx,ry) = Map.fromList [ (ch, zip (outlines ch) (triangles ch)) | ch <- allUnicodes ]
  where
  allUnicodes = Map.keys (sel1 fontD)
  outlines ch = fst (glyph ch)
  triangles ch = map (\x -> Triangul x) (snd (glyph ch))
  max_x = maximum_x fontD
  max_y = maximum_y fontD
  deltas = (max_x/(fromIntegral rx), max_y/(fromIntegral ry)) -- [ ([F2],[ (Int,Int,Int) ]) ] 
  glyph ch = trace ("outl ch " ++ show ch) getGlyphPolygon ch (sel1 fontD) deltas

makeTexMap :: FontData -> (Int,Int) -> TexMap
makeTexMap fontD (rx,ry) = Map.fromList [ (ch, (glyph ch)) | ch <- allUnicodes ]
  where
  allUnicodes = Map.keys (sel1 fontD)
  max_x = maximum_x fontD
  max_y = maximum_y fontD
  nrx ch = fromIntegral $ round ((fromIntegral ry)*((h ch)/max_y)) -- ry/rx * (h_ad/max_y) * rx
  h ch = sel2 (fromJust (Map.lookup ch (sel1 fontD)))
  deltas ch = (max_x/(fromIntegral (nrx ch)), max_y/(fromIntegral ry))
  glyph ch = trace ("tex ch " ++ show ch) (unsafePerformIO $ getGlyphTexture ch fontD (nrx ch, fromIntegral ry) (deltas ch))


getGlyphPolygon :: Char -> SvgGlyph -> F2 -> ([[F2]], [[ (Int,Int,Int) ]])
getGlyphPolygon ch glyph deltas = (outlines, map triang outlines) -- the triangulation is a list of triangles(3 indices)
  where d = sel3 (fromJust element)                           -- ie. a letter like 'i' consists of two lists of triangles
        element = Map.lookup ch glyph
        outl = (deleteHoles commands deltas)
        outlines = map (\o -> direction 0 (polygonDirection o) o) outl
        commands | (length d) == 0 = []
                 | otherwise       = unsafePerformIO ( pathFromString d )

getGlyphTexture :: Char -> FontData -> (Int,Int) -> F2 -> IO (TextureObject,String)
getGlyphTexture ch fontD (rx,ry) (dx,dy) = trace (show fileName)
                                          (do fileExists <- doesFileExist fileName
                                              if fileExists then do tga <- (readTGA fileName)
                                                                    createTexture (rx,ry) tga fileName
                                                            else do (writeTGA fileName (texData (rx,ry) border_points))
                                                                    tga <- (readTGA fileName)
                                                                    createTexture (rx,ry) tga fileName)
  where d = sel3 (fromJust element)
        fileName = [ch] ++ "_" ++ (sel4 fontD) ++ (show rx) ++ "x" ++ (show ry) ++ ".tga"
        element = Map.lookup ch (sel1 fontD)
        border_points = (map (\(x,y, bits) -> case bits of (B b) -> (round (if x <0 then 0 else x), round (if y<0 then 0 else y), b))
                             (concat (commandsToRasterPoints commands (dx,dy))) ) -- generate border points
        texturing = True
        commands | (length d) == 0 = []
                 | otherwise       = unsafePerformIO ( pathFromString d )