diff --git a/FTGL.cabal b/FTGL.cabal --- a/FTGL.cabal +++ b/FTGL.cabal @@ -1,10 +1,10 @@ Name: FTGL -Version: 1.4 -Cabal-Version: >= 1.6 +Version: 1.333 +Cabal-Version: >= 1.2 License: BSD3 License-File: LICENSE Author: J.R. Heard -Maintainer: Santtu Keskinen +Maintainer: J.R. Heard Category: Graphics Description: A Haskell binding for the portable TrueType to OpenGL font rendering library FTGL. @@ -14,14 +14,8 @@ Build-Type: Simple Library - Build-Depends: base >= 4 && < 5 - Exposed-Modules: - Graphics.Rendering.FTGL - extra-libraries: ftgl - other-extensions: ForeignFunctionInterface, EmptyDataDecls - ghc-options: -Wall -O2 - -source-repository head - type: git - location: https://github.com/Laquendi/FTGL.git + Build-Depends: OpenGL, base + Exposed-Modules: + Graphics.Rendering.FTGL + extra-libraries: ftgl diff --git a/Graphics/Rendering/FTGL.hs b/Graphics/Rendering/FTGL.hs --- a/Graphics/Rendering/FTGL.hs +++ b/Graphics/Rendering/FTGL.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} +{-# 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 > @@ -21,11 +23,10 @@ -- -- 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 where -import System.IO.Unsafe(unsafePerformIO) +import Foreign (unsafePerformIO) import Foreign.C import Foreign.Ptr import Foreign.Marshal.Alloc @@ -33,6 +34,8 @@ 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 @@ -48,7 +51,7 @@ -- | 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 = withCString file fcreateBufferFont +createBufferFont file = withCString file $ \p -> fcreateBufferFont p foreign import ccall unsafe "ftglCreateOutlineFont" fcreateOutlineFont :: CString -> IO Font @@ -56,7 +59,7 @@ -- | and will scale independently without loss of quality. Faster than polygons -- | but slower than texture or buffer fonts. createOutlineFont :: String -> IO Font -createOutlineFont file = withCString file fcreateOutlineFont +createOutlineFont file = withCString file $ \p -> fcreateOutlineFont p foreign import ccall unsafe "ftglCreatePixmapFont" fcreatePixmapFont :: CString -> IO Font @@ -64,7 +67,7 @@ -- | font without losing any performance. Use this if you don't mind using -- | set and get RasterPosition. createPixmapFont :: String -> IO Font -createPixmapFont file = withCString file fcreatePixmapFont +createPixmapFont file = withCString file $ \p -> fcreatePixmapFont p foreign import ccall unsafe "ftglCreatePolygonFont" fcreatePolygonFont :: CString -> IO Font @@ -74,7 +77,7 @@ -- | 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 = withCString file fcreatePolygonFont +createPolygonFont file = withCString file $ \p -> fcreatePolygonFont p foreign import ccall unsafe "ftglCreateTextureFont" fcreateTextureFont :: CString -> IO Font @@ -84,7 +87,7 @@ -- | 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 = withCString file fcreateTextureFont +createTextureFont file = withCString file $ \p -> fcreateTextureFont p foreign import ccall unsafe "ftglCreateExtrudeFont" fcreateExtrudeFont :: CString -> IO Font @@ -93,7 +96,7 @@ -- | 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 = withCString file fcreateExtrudeFont +createExtrudeFont file = withCString file $ \p -> fcreateExtrudeFont p @@ -107,8 +110,7 @@ foreign import ccall unsafe "ftglGetLayoutFont" fgetLayoutFont :: Layout -> IO Font -- | Get the embedded font from the Layout -getLayoutFont :: Layout -> IO Font -getLayoutFont = fgetLayoutFont +getLayoutFont f = fgetLayoutFont f -- | Set the line length, I believe in OpenGL units, although I'm not sure. @@ -123,14 +125,12 @@ foreign import ccall unsafe "ftglSetLayoutAlignment" fsetLayoutAlignment :: Layout -> CInt -> IO () -- | Set the layout alignment -setLayoutAlignment :: Layout -> TextAlignment -> IO () setLayoutAlignment layout alignment = fsetLayoutAlignment layout (marshalTextAlignment alignment) foreign import ccall unsafe "ftglGetLayoutAlignement" fgetLayoutAlignment :: Layout -> IO CInt -- | Get the alignment of text in this layout. -getLayoutAlignment :: Layout -> IO TextAlignment -getLayoutAlignment f = readTextAlignment <$> fgetLayoutAlignment f +getLayoutAlignment f = readTextAlignment <$> fgetLayoutAlignment f foreign import ccall unsafe "ftglSetLayoutLineSpacing" fsetLayoutLineSpacing :: Layout -> CFloat -> IO () @@ -167,7 +167,6 @@ foreign import ccall unsafe "ftglGetFontCharMapList" fgetFontCharMapList :: Font -> IO (Ptr CInt) -- | Get the different character mappings available in this font. -getFontCharMapList :: Font -> Ptr CInt getFontCharMapList f = unsafePerformIO $ fgetFontCharMapList f @@ -219,13 +218,14 @@ -- | Get the horizontal span of a string of text using the current font. Input as the xcoord -- | in any translate operation getFontAdvance :: Font -> String -> IO Float -getFontAdvance font str = realToFrac <$> withCString str (fgetFontAdvance font) +getFontAdvance font str = realToFrac <$> (withCString str $ \p -> fgetFontAdvance font p ) foreign import ccall unsafe "ftglRenderFont" frenderFont :: Font -> CString -> CInt -> IO () -- | Render a string of text in the current font. renderFont :: Font -> String -> RenderMode -> IO () -renderFont font str mode = withCString str $ \p -> frenderFont font p (marshalRenderMode mode) +renderFont font str mode = withCString str $ \p -> do + frenderFont font p (marshalRenderMode mode) foreign import ccall unsafe "ftglGetFontError" fgetFontError :: Font -> IO CInt @@ -241,14 +241,12 @@ foreign import ccall unsafe "ftglRenderLayout" frenderLayout :: Layout -> CString -> IO () -- | Render a string of text within a layout. -renderLayout :: Layout -> String -> IO () -renderLayout layout str = withCString str $ \strPtr -> frenderLayout layout strPtr +renderLayout layout str = withCString str $ \strPtr -> do frenderLayout layout strPtr foreign import ccall unsafe "ftglGetLayoutError" fgetLayoutError :: Layout -> IO CInt -- | Get any errors associated with a layout. -getLayoutError :: Layout -> IO CInt -getLayoutError = fgetLayoutError +getLayoutError f = fgetLayoutError f @@ -278,20 +276,19 @@ readTextAlignment 1 = AlignCenter readTextAlignment 2 = AlignRight readTextAlignment 3 = Justify -readTextAlignment _ = undefined -- | An opaque type encapsulating a glyph in C. Currently the glyph functions are unimplemented in Haskell. -data GlyphOpaque +data Glyph_Opaque -- | An opaque type encapsulating a font in C. -data FontOpaque +data Font_Opaque -- | An opaque type encapsulating a layout in C -data LayoutOpaque +data Layout_Opaque -type Glyph = Ptr GlyphOpaque -type Font = Ptr FontOpaque -type Layout = Ptr LayoutOpaque +type Glyph = Ptr Glyph_Opaque +type Font = Ptr Font_Opaque +type Layout = Ptr Layout_Opaque data CharMap = @@ -315,9 +312,8 @@ (fromIntegral (ord a) `shift` 24) .|. (fromIntegral (ord b) `shift` 16) .|. (fromIntegral (ord c) `shift` 8) - .|. fromIntegral (ord d) + .|. (fromIntegral (ord d)) -marshalCharMap :: CharMap -> CInt marshalCharMap EncodingNone = 0 marshalCharMap EncodingMSSymbol = encodeTag 's' 'y' 'm' 'b' marshalCharMap EncodingUnicode =encodeTag 'u' 'n' 'i' 'c'