FTGL.hs

{-# INCLUDE <FTGL/ftgl.h> #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# OPTIONS_GHC -O2 -fglasgow-exts #-}
-- | * Author: Jefferson Heard (jefferson.r.heard at gmail.com)
--
--   * Copyright 2008 Renaissance Computing Institute < http://www.renci.org > 
--   
--   * License: GNU LGPL 
--
--   * Compatibility GHC (I could change the data declarations to not be empty and that would make it more generally compatible, I believe)
--
--   * Description: 
--
--  Use FreeType 2 Fonts in OpenGL.  Requires the FTGL library and FreeType libraries.
--  available at < http://ftgl.wiki.sourceforge.net/ > . The most important functions for
--  everyday use are renderFont and the create*Font family of functions.  To render a 
--  simple string inside OpenGL, assuming you have OpenGL initialized and a current 
--  pen color, all you need is:
-- 
-- > do font <- createTextureFont "Font.ttf"
-- >   setFontFaceSize font 24 72
-- >   renderFont font "Hello world!"
--
-- Fonts are rendered so that a single point is an OpenGL unit, and a point is 1:72 of
-- an inch.
module Graphics.Rendering.FTGL ( 
              createBitmapFont
            , createBufferFont
            , createOutlineFont
            , createPixmapFont
            , createPolygonFont
            , createTextureFont
            , createExtrudeFont
            , Glyph
            , Font
            , Layout
            , createSimpleLayout
            , getLayoutFont
            , setLayoutFont
            , getLayoutAlignment
            , setLayoutAlignment 
            , getLayoutLineLength
            , setLayoutLineLength
            , setLayoutLineSpacing
            , destroyFont
            , attachData
            , attachFile
            , setFontCharMap 
            , setFontFaceSize
            , getFontFaceSize
            , setFontFaceDepth
            , getFontBBox
            , getFontAdvance
            , renderFont
            , getFontError 
            , destroyLayout
            , renderLayout
            , getLayoutError
	    , RenderMode(All,Back,Front,Side)
            , TextAlignment(AlignLeft,AlignRight,AlignCenter,Justify)
            )
where

import Foreign (unsafePerformIO)
import Foreign.C
import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array

import qualified Graphics.Rendering.OpenGL.GL as GL

import Control.Applicative ((<$>))

foreign import ccall unsafe "ftglCreateBitmapFont" fcreateBitmapFont :: CString -> IO Font
foreign import ccall unsafe "ftglCreateBufferFont" fcreateBufferFont :: CString -> IO Font
foreign import ccall unsafe "ftglCreateOutlineFont" fcreateOutlineFont :: CString -> IO Font
foreign import ccall unsafe "ftglCreatePixmapFont" fcreatePixmapFont  :: CString -> IO Font
foreign import ccall unsafe "ftglCreatePolygonFont" fcreatePolygonFont :: CString -> IO Font
foreign import ccall unsafe "ftglCreateTextureFont" fcreateTextureFont :: CString -> IO Font
foreign import ccall unsafe "ftglCreateExtrudeFont" fcreateExtrudeFont :: CString -> IO Font

foreign import ccall unsafe "ftglCreateSimpleLayout" createSimpleLayout :: IO Layout
foreign import ccall unsafe "ftglSetLayoutFont" setLayoutFont :: Layout -> Font -> IO ()
foreign import ccall unsafe "ftglGetLayoutFont" fgetLayoutFont :: Layout -> IO Font
foreign import ccall unsafe "ftglSetLayoutLineLength" setLayoutLineLength :: Layout -> CFloat -> IO ()
foreign import ccall unsafe "ftglGetLayoutLineLength" fgetLayoutLineLength :: Layout -> IO CFloat
foreign import ccall unsafe "ftglSetLayoutAlignment" setLayoutAlignment :: Layout -> CInt -> IO ()
foreign import ccall unsafe "ftglGetLayoutAlignement" fgetLayoutAlignment :: Layout -> IO CInt
foreign import ccall unsafe "ftglSetLayoutLineSpacing" setLayoutLineSpacing :: Layout -> CFloat -> IO ()

foreign import ccall unsafe "ftglDestroyFont" destroyFont :: Font -> IO ()
foreign import ccall unsafe "ftglAttachFile" fattachFile  :: Font -> CString -> IO ()
foreign import ccall unsafe "ftglAttachData" attachData :: Font -> Ptr () -> IO () 
foreign import ccall unsafe "ftglSetFontCharMap" setFontCharMap :: Font -> CInt -> IO ()
foreign import ccall unsafe "ftglGetFontCharMapCount" fgetFontCharMapCount :: Font -> IO CInt
foreign import ccall unsafe "ftglGetFontCharMapList" fgetFontCharMapList  :: Font -> IO (Ptr CInt)
foreign import ccall unsafe "ftglSetFontFaceSize" fsetFontFaceSize  :: Font -> CInt -> CInt -> IO CInt
foreign import ccall unsafe "ftglGetFontFaceSize" fgetFontFaceSize :: Font -> IO CInt
foreign import ccall unsafe "ftglSetFontDepth" setFontFaceDepth :: Font -> CInt -> IO ()
foreign import ccall unsafe "ftglSetFontOutset" setFontOutset :: Font -> CInt -> CInt -> IO ()
foreign import ccall unsafe "ftglGetFontBBox" fgetFontBBox :: Font -> CString -> Ptr CFloat -> IO () 
foreign import ccall unsafe "ftglGetFontAdvance" fgetFontAdvance :: Font -> CString -> IO CFloat
foreign import ccall unsafe "ftglRenderFont" frenderFont :: Font -> CString -> CInt -> IO ()
foreign import ccall unsafe "ftglGetFontError" fgetFontError :: Font -> IO CInt

foreign import ccall unsafe "ftglDestroyLayout" destroyLayout :: Layout -> IO ()
foreign import ccall unsafe "ftglRenderLayout" renderLayout_foreign :: Layout -> CString -> IO ()
foreign import ccall unsafe "ftglGetLayoutError" fgetLayoutError :: Layout -> IO CInt

setFontFaceSize :: Font -> Int -> Int -> IO CInt
setFontFaceSize f s x = fsetFontFaceSize f (fromIntegral s) (fromIntegral x)


-- | Whether or not in polygonal or extrusion mode, the font will render equally front and back
data RenderMode = Front | Back | Side | All

-- | In a Layout directed render, the layout mode of the text
data TextAlignment = AlignLeft | AlignCenter | AlignRight | Justify

marshalRenderMode :: RenderMode -> CInt
marshalRenderMode Front = 0x0001
marshalRenderMode Back = 0x0002
marshalRenderMode Side = 0x004
marshalRenderMode All = 0xffff

marshalTextAlignment :: TextAlignment -> CInt
marshalTextAlignment AlignLeft = 0
marshalTextAlignment AlignCenter = 1
marshalTextAlignment AlignRight = 2 
marshalTextAlignment Justify = 3

readTextAlignment :: CInt -> TextAlignment
readTextAlignment 0 = AlignLeft
readTextAlignment 1 = AlignCenter
readTextAlignment 2 = AlignRight
readTextAlignment 3 = Justify

-- | An opaque type encapsulating a glyph in C.  Currently the glyph functions are unimplemented in Haskell.
data Glyph_Opaque 

-- | An opaque type encapsulating a font in C.
data Font_Opaque

-- | An opaque type encapsulating a layout in C
data Layout_Opaque

type Glyph = Ptr Glyph_Opaque
type Font = Ptr Font_Opaque
type Layout = Ptr Layout_Opaque

-- | Create a bitmapped version of a TrueType font.  Bitmapped versions will not
-- | respond to matrix transformations, but rather must be transformed using the
-- | raster positioning functions in OpenGL
createBitmapFont :: String -> IO Font
createBitmapFont file = withCStringLen file $ \(p,l) -> fcreateBitmapFont p

-- | Create a buffered version of a TrueType font. This stores the entirety of
-- | a string in a texture, "buffering" it before rendering.  Very fast if you
-- | will be repeatedly rendering the same strings over and over.
createBufferFont :: String -> IO Font
createBufferFont file = withCStringLen file $ \(p,l) -> fcreateBufferFont p

-- | Create an outline version of a TrueType font. This uses actual geometry
-- | and will scale independently without loss of quality.  Faster than polygons
-- | but slower than texture or buffer fonts.
createOutlineFont :: String -> IO Font
createOutlineFont file = withCStringLen file $ \(p,l) -> fcreateOutlineFont p

-- | Create a pixmap version of a TrueType font.  Higher quality than the bitmap
-- | font without losing any performance.  Use this if you don't mind using
-- | set and get RasterPosition.
createPixmapFont :: String -> IO Font
createPixmapFont file = withCStringLen file $ \(p,l) -> fcreatePixmapFont p

-- | Create polygonal display list fonts.  These scale independently without
-- | losing quality, unlike texture or buffer fonts, but can be impractical
-- | for large amounts of text because of the high number of polygons needed.
-- | Additionally, they do not, unlike the textured fonts, create artifacts
-- | within the square formed at the edge of each character.
createPolygonFont :: String -> IO Font
createPolygonFont file = withCStringLen file $ \(p,l) -> fcreatePolygonFont p

-- | Create textured display list fonts.  These can scale somewhat well, 
-- | but lose quality quickly.  They are much faster than polygonal fonts, 
-- | though, so are suitable for large quantities of text.  Especially suited
-- | well to text that changes with most frames, because it doesn't incur the
-- | (normally helpful) overhead of buffering.
createTextureFont :: String -> IO Font
createTextureFont file = withCStringLen file $ \(p,l) -> fcreateTextureFont p

-- | Create a 3D extruded font.  This is the only way of creating 3D fonts 
-- | within FTGL.  Could be fun to use a geometry shader to get different
-- | effects by warping the otherwise square nature of the font.  Polygonal.
-- | Scales without losing quality.  Slower than all other fonts.
createExtrudeFont :: String -> IO Font
createExtrudeFont file = withCStringLen file $ \(p,l) -> fcreateExtrudeFont p

-- | Get the embedded font from the Layout
getLayoutFont f = unsafePerformIO $ fgetLayoutFont f 

-- | Get the line length in points (1:72in) of lines in the layout
getLayoutLineLength :: Layout -> Float
getLayoutLineLength f = realToFrac . unsafePerformIO $ fgetLayoutLineLength f

-- | Get the alignment of text in this layout.
getLayoutAlignment :: Layout -> TextAlignment
getLayoutAlignment f = readTextAlignment . unsafePerformIO $ fgetLayoutAlignment f

-- | Get the number of characters loaded into the current charmap for the font.
getFontCharMapCount :: Font -> Int
getFontCharMapCount f = fromIntegral . unsafePerformIO $ fgetFontCharMapCount f

-- | Get the different character mappings available in this font.
getFontCharMapList f = unsafePerformIO $ fgetFontCharMapList f

-- | Get the current font face size in points.
getFontFaceSize :: Font -> Int
getFontFaceSize f = fromIntegral . unsafePerformIO $ fgetFontFaceSize f

-- | Get any errors associated with loading a font. FIXME return should be a type, not an Int.
getFontError :: Font -> Int
getFontError f = fromIntegral . unsafePerformIO $ fgetFontError f

-- | Attach a metadata file to a font.
attachFile :: Font -> String -> IO () 
attachFile font str = withCString str $ \p -> fattachFile font p

-- | Get the horizontal span of a string of text using the current font.  Input as the xcoord
-- | in any translate operation
getFontAdvance :: Font -> String -> Float
getFontAdvance font str = realToFrac . unsafePerformIO $ withCString str $ \p -> fgetFontAdvance font p 

-- | Render a string of text in the current font.
renderFont :: Font -> String -> RenderMode -> IO ()
renderFont font str mode = withCString str $ \p -> do 
	frenderFont font p (marshalRenderMode mode)

-- | Get the text extents of a string as a list of (lower-left,lower-right,upper-left,upper-right)
getFontBBox :: Font -> String -> [Float]
getFontBBox f s = unsafePerformIO $ 
                   allocaBytes 16 $ \pf -> 
                     withCString s $ \ps -> do 
                       fgetFontBBox f ps pf
                       map realToFrac <$> peekArray 4 pf

-- | Get any errors associated with a layout.
getLayoutError f = unsafePerformIO $ fgetLayoutError f

-- | Render a string of text within a layout.
renderLayout layout str = withCString str $ \strPtr -> do renderLayout_foreign layout strPtr