module Graphics.Rendering.FTGL
where
import Foreign (unsafePerformIO)
import Foreign.C
import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Data.Bits
import Data.Char (ord)
import qualified Graphics.Rendering.OpenGL.GL as GL
import Control.Applicative ((<$>))
foreign import ccall unsafe "ftglCreateBitmapFont" fcreateBitmapFont :: CString -> IO Font
createBitmapFont :: String -> IO Font
createBitmapFont file = withCString file $ \p -> fcreateBitmapFont p
foreign import ccall unsafe "ftglCreateBufferFont" fcreateBufferFont :: CString -> IO Font
createBufferFont :: String -> IO Font
createBufferFont file = withCString file $ \p -> fcreateBufferFont p
foreign import ccall unsafe "ftglCreateOutlineFont" fcreateOutlineFont :: CString -> IO Font
createOutlineFont :: String -> IO Font
createOutlineFont file = withCString file $ \p -> fcreateOutlineFont p
foreign import ccall unsafe "ftglCreatePixmapFont" fcreatePixmapFont :: CString -> IO Font
createPixmapFont :: String -> IO Font
createPixmapFont file = withCString file $ \p -> fcreatePixmapFont p
foreign import ccall unsafe "ftglCreatePolygonFont" fcreatePolygonFont :: CString -> IO Font
createPolygonFont :: String -> IO Font
createPolygonFont file = withCString file $ \p -> fcreatePolygonFont p
foreign import ccall unsafe "ftglCreateTextureFont" fcreateTextureFont :: CString -> IO Font
createTextureFont :: String -> IO Font
createTextureFont file = withCString file $ \p -> fcreateTextureFont p
foreign import ccall unsafe "ftglCreateExtrudeFont" fcreateExtrudeFont :: CString -> IO Font
createExtrudeFont :: String -> IO Font
createExtrudeFont file = withCString file $ \p -> fcreateExtrudeFont p
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
getLayoutFont f = fgetLayoutFont f
foreign import ccall unsafe "ftglSetLayoutLineLength" setLayoutLineLength :: Layout -> CFloat -> IO ()
foreign import ccall unsafe "ftglGetLayoutLineLength" fgetLayoutLineLength :: Layout -> IO CFloat
getLayoutLineLength :: Layout -> IO Float
getLayoutLineLength f = realToFrac <$> fgetLayoutLineLength f
foreign import ccall unsafe "ftglSetLayoutAlignment" fsetLayoutAlignment :: Layout -> CInt -> IO ()
setLayoutAlignment layout alignment = fsetLayoutAlignment layout (marshalTextAlignment alignment)
foreign import ccall unsafe "ftglGetLayoutAlignement" fgetLayoutAlignment :: Layout -> IO CInt
getLayoutAlignment f = readTextAlignment <$> fgetLayoutAlignment f
foreign import ccall unsafe "ftglSetLayoutLineSpacing" fsetLayoutLineSpacing :: Layout -> CFloat -> IO ()
setLayoutLineSpacing :: Layout -> Float -> IO ()
setLayoutLineSpacing layout spacing = setLayoutLineSpacing layout (realToFrac spacing)
foreign import ccall unsafe "ftglDestroyFont" destroyFont :: Font -> IO ()
foreign import ccall unsafe "ftglAttachFile" fattachFile :: Font -> CString -> IO ()
attachFile :: Font -> String -> IO ()
attachFile font str = withCString str $ \p -> fattachFile font p
foreign import ccall unsafe "ftglAttachData" attachData :: Font -> Ptr () -> IO ()
foreign import ccall unsafe "ftglSetFontCharMap" fsetFontCharMap :: Font -> CInt -> IO ()
setCharMap :: Font -> CharMap -> IO ()
setCharMap font charmap = fsetFontCharMap font (marshalCharMap charmap)
foreign import ccall unsafe "ftglGetFontCharMapCount" fgetFontCharMapCount :: Font -> IO CInt
getFontCharMapCount :: Font -> Int
getFontCharMapCount f = fromIntegral . unsafePerformIO $ fgetFontCharMapCount f
foreign import ccall unsafe "ftglGetFontCharMapList" fgetFontCharMapList :: Font -> IO (Ptr CInt)
getFontCharMapList f = unsafePerformIO $ fgetFontCharMapList f
foreign import ccall unsafe "ftglSetFontFaceSize" fsetFontFaceSize :: Font -> CInt -> CInt -> IO CInt
setFontFaceSize :: Font -> Int -> Int -> IO CInt
setFontFaceSize f s x = fsetFontFaceSize f (fromIntegral s) (fromIntegral x)
foreign import ccall unsafe "ftglGetFontFaceSize" fgetFontFaceSize :: Font -> IO CInt
getFontFaceSize :: Font -> IO Int
getFontFaceSize f = fromIntegral <$> fgetFontFaceSize f
foreign import ccall unsafe "ftglSetFontDepth" fsetFontDepth :: Font -> CFloat -> IO ()
setFontDepth :: Font -> Float -> IO ()
setFontDepth font depth = fsetFontDepth font (realToFrac depth)
foreign import ccall unsafe "ftglSetFontOutset" fsetFontOutset :: Font -> CFloat -> CFloat -> IO ()
setFontOutset :: Font -> Float -> Float -> IO ()
setFontOutset font d o = fsetFontOutset font (realToFrac d) (realToFrac o)
foreign import ccall unsafe "ftglGetFontBBox" fgetFontBBox :: Font -> CString -> Int -> Ptr CFloat -> IO ()
getFontBBox :: Font -> String -> IO [Float]
getFontBBox f s = allocaBytes 24 $ \pf ->
withCString s $ \ps -> do
fgetFontBBox f ps (1) pf
map realToFrac <$> peekArray 6 pf
foreign import ccall unsafe "ftglGetFontAscender" fgetFontAscender :: Font -> CFloat
getFontAscender :: Font -> Float
getFontAscender = realToFrac . fgetFontAscender
foreign import ccall unsafe "ftglGetFontDescender" fgetFontDescender :: Font -> CFloat
getFontDescender :: Font -> Float
getFontDescender = realToFrac . fgetFontDescender
foreign import ccall unsafe "ftglGetFontLineHeight" fgetFontLineHeight :: Font -> CFloat
getFontLineHeight :: Font -> Float
getFontLineHeight = realToFrac . fgetFontLineHeight
foreign import ccall unsafe "ftglGetFontAdvance" fgetFontAdvance :: Font -> CString -> IO CFloat
getFontAdvance :: Font -> String -> IO Float
getFontAdvance font str = realToFrac <$> (withCString str $ \p -> fgetFontAdvance font p )
foreign import ccall unsafe "ftglRenderFont" frenderFont :: Font -> CString -> CInt -> IO ()
renderFont :: Font -> String -> RenderMode -> IO ()
renderFont font str mode = withCString str $ \p -> do
frenderFont font p (marshalRenderMode mode)
foreign import ccall unsafe "ftglGetFontError" fgetFontError :: Font -> IO CInt
getFontError :: Font -> IO Int
getFontError f = fromIntegral <$> fgetFontError f
foreign import ccall unsafe "ftglDestroyLayout" destroyLayout :: Layout -> IO ()
foreign import ccall unsafe "ftglRenderLayout" frenderLayout :: Layout -> CString -> IO ()
renderLayout layout str = withCString str $ \strPtr -> do frenderLayout layout strPtr
foreign import ccall unsafe "ftglGetLayoutError" fgetLayoutError :: Layout -> IO CInt
getLayoutError f = fgetLayoutError f
data RenderMode = Front | Back | Side | All
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
data Glyph_Opaque
data Font_Opaque
data Layout_Opaque
type Glyph = Ptr Glyph_Opaque
type Font = Ptr Font_Opaque
type Layout = Ptr Layout_Opaque
data CharMap =
EncodingNone
| EncodingMSSymbol
| EncodingUnicode
| EncodingSJIS
| EncodingGB2312
| EncodingBig5
| EncodingWanSung
| EncodingJohab
| EncodingAdobeStandard
| EncodingAdobeExpert
| EncodingAdobeCustom
| EncodingAdobeLatin1
| EncodingOldLatin2
| EncodingAppleRoman
encodeTag :: Char -> Char -> Char -> Char -> CInt
encodeTag a b c d =
(fromIntegral (ord a) `shift` 24)
.|. (fromIntegral (ord b) `shift` 16)
.|. (fromIntegral (ord c) `shift` 8)
.|. (fromIntegral (ord d))
marshalCharMap EncodingNone = 0
marshalCharMap EncodingMSSymbol = encodeTag 's' 'y' 'm' 'b'
marshalCharMap EncodingUnicode =encodeTag 'u' 'n' 'i' 'c'
marshalCharMap EncodingSJIS = encodeTag 's' 'j' 'i' 's'
marshalCharMap EncodingGB2312 = encodeTag 'g' 'b' ' ' ' '
marshalCharMap EncodingBig5= encodeTag 'b' 'i' 'g' '5'
marshalCharMap EncodingWanSung= encodeTag 'w' 'a' 'n' 's'
marshalCharMap EncodingJohab= encodeTag 'j' 'o' 'h' 'a'
marshalCharMap EncodingAdobeStandard= encodeTag 'A' 'D' 'O' 'B'
marshalCharMap EncodingAdobeExpert= encodeTag 'A' 'D' 'B' 'E'
marshalCharMap EncodingAdobeCustom= encodeTag 'A' 'D' 'B' 'C'
marshalCharMap EncodingAdobeLatin1= encodeTag 'l' 'a' 't' '1'
marshalCharMap EncodingOldLatin2= encodeTag 'l' 'a' 't' '2'
marshalCharMap EncodingAppleRoman= encodeTag 'a' 'r' 'm' 'n'