FTGL-bytestring (empty) → 2.0
raw patch · 4 files changed
+455/−0 lines, 4 filesdep +StateVar-transformerdep +basedep +bytestringsetup-changed
Dependencies added: StateVar-transformer, base, bytestring, transformers
Files
- FTGL-bytestring.cabal +35/−0
- Graphics/Rendering/FTGL.hs +394/−0
- LICENSE +24/−0
- Setup.hs +2/−0
+ FTGL-bytestring.cabal view
@@ -0,0 +1,35 @@+Name: FTGL-bytestring+Version: 2.0+Cabal-Version: >= 1.10+License: BSD3+License-File: LICENSE+Author: J.R. Heard, HIROKI,HATTORI+Maintainer: HIROKI,HATTORI <seagull.kamome@gmail.com>+Category: Graphics+Description: + A Haskell binding for the portable TrueType to OpenGL font rendering library FTGL.+ This package provides OpenGL with polygonal, texture mapped, and extruded fonts using+ Freetype2 and any truetype font. +Synopsis: Portable TrueType font rendering for OpenGL using the Freetype2 library+Build-Type: Simple++source-repository head+ type: git+ location: git@github.com:seagull-kamome/haskell-FTGL.git++Library+ Build-Depends: base >= 3 && < 5,+ bytestring >= 0.10,+ transformers >= 0.3,+ StateVar-transformer >= 1.0.0+ Exposed-Modules: Graphics.Rendering.FTGL+ extra-libraries: ftgl+ ghc-options: -Wall+ default-language: Haskell2010++--Executable ex1+-- Build-Depends: base >= 3 && <5, text >= 0.11, FTGL-bytestring, OpenGL, GLFW-b+-- main-is: ex1.hs+-- hs-source-dirs: examples+-- ghc-options: -Wall+-- default-language: Haskell2010
+ Graphics/Rendering/FTGL.hs view
@@ -0,0 +1,394 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE EmptyDataDecls #-}+-- | * 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 where++import Control.Monad.IO.Class+import System.IO.Unsafe (unsafePerformIO)+import Foreign.C+import Foreign.Ptr+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Data.Bits +import Data.Char (ord)+import qualified Data.ByteString.Char8 as BS8+import Data.StateVar.Trans++import Control.Applicative ((<$>))++foreign import ccall unsafe "ftglCreateBitmapFont" fcreateBitmapFont :: CString -> IO Font+{-# INLINE fcreateBitmapFont #-}++-- | 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 :: BS8.ByteString -> IO Font+createBitmapFont = flip BS8.useAsCString $ fcreateBitmapFont+{-# INLINE createBitmapFont #-}++foreign import ccall unsafe "ftglCreateBufferFont" fcreateBufferFont :: CString -> IO Font+{-# INLINE fcreateBufferFont #-}++-- | 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 :: BS8.ByteString -> IO Font+createBufferFont = flip BS8.useAsCString fcreateBufferFont+{-# INLINE createBufferFont #-}++foreign import ccall unsafe "ftglCreateOutlineFont" fcreateOutlineFont :: CString -> IO Font+{-# INLINE fcreateOutlineFont #-}++-- | 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 :: BS8.ByteString -> IO Font+createOutlineFont = flip BS8.useAsCString fcreateOutlineFont+{-# INLINE createOutlineFont #-}++foreign import ccall unsafe "ftglCreatePixmapFont" fcreatePixmapFont :: CString -> IO Font+{-# INLINE fcreatePixmapFont #-}++-- | 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 :: BS8.ByteString -> IO Font+createPixmapFont = flip BS8.useAsCString fcreatePixmapFont+{-# INLINE createPixmapFont #-}++foreign import ccall unsafe "ftglCreatePolygonFont" fcreatePolygonFont :: CString -> IO Font+{-# INLINE fcreatePolygonFont #-}++-- | 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 :: BS8.ByteString -> IO Font+createPolygonFont = flip BS8.useAsCString fcreatePolygonFont+{-# INLINE createPolygonFont #-}++foreign import ccall unsafe "ftglCreateTextureFont" fcreateTextureFont :: CString -> IO Font+{-# INLINE fcreateTextureFont #-}++-- | 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 :: BS8.ByteString -> IO Font+createTextureFont = flip BS8.useAsCString fcreateTextureFont+{-# INLINE createTextureFont #-}++foreign import ccall unsafe "ftglCreateExtrudeFont" fcreateExtrudeFont :: CString -> IO Font+{-# INLINE fcreateExtrudeFont #-}++-- | 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 :: BS8.ByteString -> IO Font+createExtrudeFont = flip BS8.useAsCString fcreateExtrudeFont+{-# INLINE createExtrudeFont #-}++++-- | Create a simple layout+foreign import ccall unsafe "ftglCreateSimpleLayout" createSimpleLayout :: IO Layout+{-# INLINE createSimpleLayout #-}++-- | Set the layout's font.+foreign import ccall unsafe "ftglSetLayoutFont" setLayoutFont :: Layout -> Font -> IO ()+{-# INLINE setLayoutFont #-}++-- | Get the embedded font from the Layout+foreign import ccall unsafe "ftglGetLayoutFont" getLayoutFont :: Layout -> IO Font+{-# INLINE getLayoutFont #-}++layoutFont :: MonadIO m => Layout -> StateVar m Font+layoutFont l = makeStateVar (liftIO $ getLayoutFont l) (liftIO . setLayoutFont l)+{-# INLINE layoutFont #-}++-- | Set the line length, I believe in OpenGL units, although I'm not sure.+foreign import ccall unsafe "ftglSetLayoutLineLength" setLayoutLineLength :: Layout -> CFloat -> IO ()+{-# INLINE setLayoutLineLength #-}++foreign import ccall unsafe "ftglGetLayoutLineLength" fgetLayoutLineLength :: Layout -> IO CFloat+{-# INLINE fgetLayoutLineLength #-}++layoutLineLength :: MonadIO m => Layout -> StateVar m CFloat+layoutLineLength l = makeStateVar+ (liftIO $ realToFrac <$> fgetLayoutLineLength l)+ (liftIO . setLayoutLineLength l)+{-# INLINE layoutLineLength #-}+++foreign import ccall unsafe "ftglSetLayoutAlignment" fsetLayoutAlignment :: Layout -> CInt -> IO ()+{-# INLINE fsetLayoutAlignment #-}+foreign import ccall unsafe "ftglGetLayoutAlignement" fgetLayoutAlignment :: Layout -> IO CInt+{-# INLINE fgetLayoutAlignment #-}++layoutAlignment :: MonadIO m => Layout -> StateVar m TextAlignment+layoutAlignment l = makeStateVar+ (liftIO $ toEnum . fromIntegral <$> fgetLayoutAlignment l)+ (liftIO . fsetLayoutAlignment l . fromIntegral . fromEnum)+{-# INLINE layoutAlignment #-}++++foreign import ccall unsafe "ftglSetLayoutLineSpacing" fsetLayoutLineSpacing :: Layout -> CFloat -> IO ()+{-# INLINE fsetLayoutLineSpacing #-}++layoutLineSpacing :: MonadIO m => Layout -> SettableStateVar m Float+layoutLineSpacing l = makeSettableStateVar $ liftIO . fsetLayoutLineSpacing l . realToFrac+{-# INLINE layoutLineSpacing #-}++-- | Destroy a font+foreign import ccall unsafe "ftglDestroyFont" destroyFont :: Font -> IO ()+{-# INLINE destroyFont #-}++foreign import ccall unsafe "ftglAttachFile" fattachFile :: Font -> CString -> IO ()+{-# INLINE fattachFile #-}++-- | Attach a metadata file to a font.+attachFile :: Font -> BS8.ByteString -> IO () +attachFile font str = BS8.useAsCString str $ fattachFile font+{-# INLINE attachFile #-}++-- | Attach some external data (often kerning) to the font+foreign import ccall unsafe "ftglAttachData" attachData :: Font -> Ptr () -> IO () +{-# INLINE attachData #-}++-- | Set the font's character map+foreign import ccall unsafe "ftglSetFontCharMap" fsetFontCharMap :: Font -> CInt -> IO ()+{-# INLINE fsetFontCharMap #-}++charMap :: MonadIO m => Font -> SettableStateVar m CharMap+charMap font = makeSettableStateVar $ \charmap -> liftIO $ fsetFontCharMap font (marshalCharMap charmap)+{-# INLINE charMap #-}++foreign import ccall unsafe "ftglGetFontCharMapCount" fgetFontCharMapCount :: Font -> IO CInt+{-# INLINE fgetFontCharMapCount #-}++-- | Get the number of characters loaded into the current charmap for the font.+getFontCharMapCount :: Font -> Int+getFontCharMapCount f = fromIntegral . unsafePerformIO $ fgetFontCharMapCount f+{-# INLINE getFontCharMapCount #-}++foreign import ccall unsafe "ftglGetFontCharMapList" fgetFontCharMapList :: Font -> IO (Ptr CInt)+{-# INLINE fgetFontCharMapList #-}++-- | Get the different character mappings available in this font.+getFontCharMapList :: Font -> Ptr CInt+getFontCharMapList f = unsafePerformIO $ fgetFontCharMapList f+{-# INLINE getFontCharMapList #-}++foreign import ccall unsafe "ftglSetFontFaceSize" fsetFontFaceSize :: Font -> CInt -> CInt -> IO CInt+{-# INLINE fsetFontFaceSize #-}++setFontFaceSize :: Font -> Int -> Int -> IO CInt+setFontFaceSize f s x = fsetFontFaceSize f (fromIntegral s) (fromIntegral x)+{-# INLINE setFontFaceSize #-}++foreign import ccall unsafe "ftglGetFontFaceSize" fgetFontFaceSize :: Font -> IO CInt+{-# INLINE fgetFontFaceSize #-}++-- | Get the current font face size in points.+fontFaceSize :: MonadIO m => Font -> GettableStateVar m Int+fontFaceSize f = makeGettableStateVar $ liftIO $ fromIntegral <$> fgetFontFaceSize f+{-# INLINE fontFaceSize #-}++foreign import ccall unsafe "ftglSetFontDepth" fsetFontDepth :: Font -> CFloat -> IO ()+{-# INLINE fsetFontDepth #-}++fontDepth :: MonadIO m => Font -> SettableStateVar m Float+fontDepth font = makeSettableStateVar $ \depth -> liftIO $ fsetFontDepth font (realToFrac depth)+{-# INLINE fontDepth #-}++foreign import ccall unsafe "ftglSetFontOutset" fsetFontOutset :: Font -> CFloat -> CFloat -> IO ()+{-# INLINE fsetFontOutset #-}++setFontOutset :: Font -> Float -> Float -> IO ()+setFontOutset font d o = fsetFontOutset font (realToFrac d) (realToFrac o)+{-# INLINE setFontOutset #-}++foreign import ccall unsafe "ftglGetFontBBox" fgetFontBBox :: Font -> CString -> Int -> Ptr CFloat -> IO ()+{-# INLINE fgetFontBBox #-}++-- | Get the text extents of a string as a list of (llx,lly,lly,urx,ury,urz)+getFontBBox :: Font -> BS8.ByteString -> IO [Float]+getFontBBox f s = allocaBytes 24 $ \pf -> do+ BS8.useAsCString s $ \ps -> fgetFontBBox f ps (-1) pf+ map realToFrac <$> peekArray 6 pf+{-# INLINE getFontBBox #-}++foreign import ccall unsafe "ftglGetFontAscender" fgetFontAscender :: Font -> CFloat+{-# INLINE fgetFontAscender #-}++-- | Get the global ascender height for the face. +getFontAscender :: Font -> Float+getFontAscender = realToFrac . fgetFontAscender +{-# INLINE getFontAscender #-}++foreign import ccall unsafe "ftglGetFontDescender" fgetFontDescender :: Font -> CFloat+{-# INLINE fgetFontDescender #-}++-- | Gets the global descender height for the face. +getFontDescender :: Font -> Float+getFontDescender = realToFrac . fgetFontDescender +{-# INLINE getFontDescender #-}++foreign import ccall unsafe "ftglGetFontLineHeight" fgetFontLineHeight :: Font -> CFloat+{-# INLINE fgetFontLineHeight #-}++-- | Gets the global line spacing for the face. +getFontLineHeight :: Font -> Float+getFontLineHeight = realToFrac . fgetFontLineHeight+{-# INLINE getFontLineHeight #-}++foreign import ccall unsafe "ftglGetFontAdvance" fgetFontAdvance :: Font -> CString -> IO CFloat+{-# INLINE fgetFontAdvance #-}++-- | Get the horizontal span of a string of text using the current font. Input as the xcoord+-- | in any translate operation+getFontAdvance :: Font -> BS8.ByteString -> IO Float+getFontAdvance font str = realToFrac <$> (BS8.useAsCString str $ fgetFontAdvance font)+{-# INLINE getFontAdvance #-}++foreign import ccall unsafe "ftglRenderFont" frenderFont :: Font -> CString -> CInt -> IO ()+{-# INLINE frenderFont #-}++-- | Render a string of text in the current font.+renderFont :: Font -> RenderMode -> BS8.ByteString -> IO ()+renderFont font mode str = BS8.useAsCString str $ \p -> frenderFont font p (fromIntegral $ fromEnum mode)+{-# INLINE renderFont #-}++foreign import ccall unsafe "ftglGetFontError" fgetFontError :: Font -> IO CInt+{-# INLINE fgetFontError #-}++-- | Get any errors associated with loading a font. FIXME return should be a type, not an Int.+fontError :: MonadIO m => Font -> GettableStateVar m Int+fontError f = makeGettableStateVar $ liftIO $ fromIntegral <$> fgetFontError f+{-# INLINE fontError #-}++++foreign import ccall unsafe "ftglDestroyLayout" destroyLayout :: Layout -> IO ()+{-# INLINE destroyLayout #-}++foreign import ccall unsafe "ftglRenderLayout" frenderLayout :: Layout -> CString -> IO ()+{-# INLINE frenderLayout #-}++-- | Render a string of text within a layout.+renderLayout :: Layout -> BS8.ByteString -> IO ()+renderLayout layout str = BS8.useAsCString str $ frenderLayout layout+{-# INLINE renderLayout #-}++foreign import ccall unsafe "ftglGetLayoutError" fgetLayoutError :: Layout -> IO CInt+{-# INLINE fgetLayoutError #-}++-- | Get any errors associated with a layout.+layoutError :: MonadIO m => Layout -> GettableStateVar m CInt+layoutError f = makeGettableStateVar $ liftIO $ fgetLayoutError f+{-# INLINE layoutError #-}+++++++-- | Whether or not in polygonal or extrusion mode, the font will render equally front and back+data RenderMode = Front | Back | Side | All deriving (Show, Eq)+instance Enum RenderMode where+ fromEnum Front = 0x0001+ fromEnum Back = 0x0002+ fromEnum Side = 0x0004+ fromEnum All = 0xffff+ {-# INLINE fromEnum #-}+ toEnum 0x0001 = Front+ toEnum 0x0002 = Back+ toEnum 0x0004 = Side+ toEnum 0xffff = All+ toEnum x = error $ "Unknown RenderMode as " ++ show x+ {-# INLINE toEnum #-}++-- | In a Layout directed render, the layout mode of the text+data TextAlignment = AlignLeft | AlignCenter | AlignRight | Justify+ deriving (Show, Eq, Enum)++-- | 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+++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 :: CharMap -> CInt+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' ++
+ LICENSE view
@@ -0,0 +1,24 @@+Copyright 2008, Jeff Heard. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR+BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN+IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain