{-# INCLUDE #-} {-# 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