FreeTypeGL 0.0.1 → 0.0.2
raw patch · 6 files changed
+155/−85 lines, 6 files
Files
- FreeTypeGL.cabal +8/−8
- Graphics/Rendering/FreeTypeGL.hsc +76/−12
- Graphics/Rendering/FreeTypeGL/Internal/Markup.hsc +16/−22
- Graphics/Rendering/FreeTypeGL/Internal/Shader.hsc +3/−0
- LICENSE +30/−30
- demos/hellobye.hs +22/−13
FreeTypeGL.cabal view
@@ -1,22 +1,22 @@ Name: FreeTypeGL-Version: 0.0.1-Synopsis: Haskell fonts with OpenGL+Version: 0.0.2+Synopsis: Loadable texture fonts for OpenGL. Description: Based on the freetype-gl library, with large modifications.-- This is similar to the FTGL library, but avoids- C++, which makes it easier to wrap and work with+ .+ This is similar to the FTGL (<http://hackage.haskell.org/package/FTGL>)+ library, but avoids C++, which makes it easier to wrap and work with in Haskell-land.-+ . This library is completely stand-alone (comes with the required C sources), so you don't need to install any C library prior to installing this. cabal intall FreeTypeGL should work fine.-+ . Unfortunately, it seems not to perform as well as FTGL on some setups.-+ . NOTE: Most of the demos and C-side documentation are out-of-date, as the C side was heavily modified, without updating many of the demos or
Graphics/Rendering/FreeTypeGL.hsc view
@@ -1,17 +1,32 @@ {-# LANGUAGE ForeignFunctionInterface #-}--- | A higher-level interface wrapping the low-level C API +-------------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.FreeTypeGL+-- Copyright : (C) 2012 Eyal Lotem+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Eyal Lotem <eyal.lotem@gmail.com>+-- Stability : experimental+-- Portability : Haskell2010+--+-- FreeTypeGL lets one load and use texture fonts in an OpenGL+-- context. You can use it with GLFW-b+-- (<http://hackage.haskell.org/package/GLFW-b>), GLUT+-- (<http://hackage.haskell.org/package/GLUT>), or any other GL context+-- you wish. The main benefit of this library is that it can be+-- installed with a pure "cabal install", no need to manually install+-- any C bits.+-------------------------------------------------------------------------------+ module Graphics.Rendering.FreeTypeGL ( FontDesc(..), fontDescFindFileName , Shader, newShader , Font, loadFont, textSize- , Vector2(..)- , Markup(..), noMarkup, Color4(..)+ , Markup(..), noMarkup , TextRenderer, textRenderer, textRendererSize, renderText- , initialize+ , Vector2(..), Color4(..) ) where -import Control.Applicative import Foreign.C.String (withCString) import Foreign.C.Types (CInt(..)) import Foreign.ForeignPtr (ForeignPtr)@@ -31,6 +46,13 @@ -- FontDesc: +-- | A 'FontDesc' describes the desired properties of a system font.+-- It's only purpose is querying the font_config library for the+-- desired font.+--+-- NOTE: This functionality is only available if the+-- package was configured with the use_font_config flag (e.g: cabal+-- install -f use_font_config). data FontDesc = FontDesc { fdFamily :: String , fdSize :: Float@@ -38,7 +60,12 @@ , fdItalic :: Bool } -fontDescFindFileName :: FontDesc -> IO String+-- | Look up a system font file.+--+-- NOTE: This functionality is only available if the package was+-- configured with the use_font_config flag+-- (e.g: @cabal install -f use_font_config@).+fontDescFindFileName :: FontDesc -> IO FilePath fontDescFindFileName (FontDesc family size bold italic) = withCString family $ \familyPtr -> IFD.fontDescFindFileName $ IFD.FontDesc familyPtr size bold italic@@ -50,10 +77,11 @@ foreign import ccall "freetypegl_init" c_freetypegl_init :: IO CInt + initialize :: IO () initialize = throwIf_ (/= 0) (("freetypegl_init returned" ++) . show) c_freetypegl_init --- TODO: Use Paths_module+-- | Make a 'Shader' needed for 'loadFont'. newShader :: IO Shader newShader = do initialize@@ -63,38 +91,74 @@ -- Font: +-- | Represents a loaded font file with a configured face-size.+--+-- For different face sizes, you must load different fonts. data Font = Font { _fShader :: Shader , fFont :: ForeignPtr ITF.TextureFont } -loadFont :: Shader -> FilePath -> Float -> IO Font+-- | Load a 'Font' with a given size.+loadFont+ :: Shader -- ^ A shader created with 'newShader'+ -> FilePath -- ^ The font filename (e.g: \"foo.ttf\")+ -> Float -- ^ The desired face-size+ -> IO Font -- ^ The result loaded font loadFont shader fileName size = do textureFont <- ITF.new NotLCD fileName size return $ Font shader textureFont +-- | A 'TextRenderer' is an intermediate representation of all font+-- renderings. It represents the GL program to render the font, and+-- may be re-used multiple times. Re-using a TextRenderer is faster+-- than computing the same renderer multiple times. data TextRenderer = TextRenderer { trBuffer :: ForeignPtr ITB.TextBuffer , trSize :: Vector2 Float } -textRenderer :: Vector2 Float -> Markup -> Font -> String -> TextRenderer-textRenderer pos markup (Font shader font) str = unsafePerformIO $+-- | Make a 'TextRenderer' for a given font.+textRenderer :: Markup -> Font -> String -> TextRenderer+textRenderer markup (Font shader font) str = unsafePerformIO $ alloca $ \pen -> alloca $ \markupPtr -> do- poke pen pos+ poke pen (Vector2 0 0) poke markupPtr markup textBuffer <- ITB.new shader (Vector2 512 512) 1 ITB.addText textBuffer markupPtr font pen str newPos <- peek pen- return $ TextRenderer textBuffer ((-) <$> newPos <*> pos)+ return $ TextRenderer textBuffer newPos +-- | Render a 'TextRenderer' to the GL context+--+-- NOTE: This will have the following side effects:+--+-- * GL's blend will be enabled+--+-- * GL's Texture2D will be enabled+--+-- * GL's color will be changed+--+-- * GL's color_material will be disabled+--+-- * GL's blend_func will be set to (SRC_ALPHA, ONE_MINUS_SRC_ALPHA)+--+-- * GL's blend_color will be modified renderText :: TextRenderer -> IO () renderText = ITB.render . trBuffer +-- | Get the size of a 'TextRenderer'+--+-- NOTE: If you don't need to also render the text, it is better to+-- use the faster 'textSize' function. textRendererSize :: TextRenderer -> Vector2 Float textRendererSize = trSize +-- | Compute the text size of a given text in a given font+--+-- NOTE: If you also need to render the text, it is better to make a+-- 'TextRenderer'. textSize :: Font -> String -> Vector2 Float textSize font str = unsafePerformIO $ ITF.textSize (fFont font) str
Graphics/Rendering/FreeTypeGL/Internal/Markup.hsc view
@@ -17,27 +17,29 @@ where p (off, val) = pokeElemOff ptr off val -+-- | A Markup record defines what text effects to combine when+-- rendering text data Markup = Markup- { rise :: Float- , spacing :: Float- , gamma :: Float+ { gamma :: Float+ -- ^ Not implemented yet. Set to 1.0 , foreground_color :: Color4 Float+ -- ^ Foreground color , background_color :: Color4 Float- , outline :: Maybe (Color4 Float)+ -- ^ Background color , underline :: Maybe (Color4 Float)+ -- ^ Optional underline color , overline :: Maybe (Color4 Float)+ -- ^ Optional overline color , strikethrough :: Maybe (Color4 Float)+ -- ^ Optional strikethrough color } +-- | Default no-markup (White text on transparent background) noMarkup :: Markup noMarkup = Markup- { rise = 0.0- , spacing = 0.0- , gamma = 1.0+ { gamma = 1.0 , foreground_color = Color4 1 1 1 1 , background_color = Color4 0 0 0 0- , outline = Nothing , underline = Nothing , overline = Nothing , strikethrough = Nothing@@ -48,9 +50,7 @@ applyTuple :: (a -> b, a -> c) -> a -> (b, c) applyTuple (fx, fy) arg = (fx arg, fy arg) -outlinePtrs, underlinePtrs, overlinePtrs, strikethroughPtrs ::- Ptr Markup -> (Ptr CInt, Ptr Float)-outlinePtrs = applyTuple ((#ptr markup_t, outline ), (#ptr markup_t, outline_color))+underlinePtrs, overlinePtrs, strikethroughPtrs :: Ptr Markup -> (Ptr CInt, Ptr Float) underlinePtrs = applyTuple ((#ptr markup_t, underline ), (#ptr markup_t, underline_color)) overlinePtrs = applyTuple ((#ptr markup_t, overline ), (#ptr markup_t, overline_color)) strikethroughPtrs = applyTuple ((#ptr markup_t, strikethrough), (#ptr markup_t, strikethrough_color))@@ -61,8 +61,6 @@ sizeOf _ = #size markup_t alignment _ = #alignment markup_t peek ptr = do- rise' <- (#peek markup_t, rise) ptr- spacing' <- (#peek markup_t, spacing) ptr gamma' <- (#peek markup_t, gamma) ptr foreground_color' <- peekColor $ (#ptr markup_t, foreground_color) ptr background_color' <- peekColor $ (#ptr markup_t, background_color) ptr@@ -73,20 +71,17 @@ case b of 0 -> return Nothing _ -> Just <$> peekColor colorPtr- outline' <- peekAnnotation outlinePtrs underline' <- peekAnnotation underlinePtrs overline' <- peekAnnotation overlinePtrs strikethrough' <- peekAnnotation strikethroughPtrs return $- Markup rise' spacing' gamma'+ Markup gamma' foreground_color' background_color'- outline' underline' overline' strikethrough'+ underline' overline' strikethrough' poke ptr- (Markup rise' spacing' gamma'+ (Markup gamma' foreground_color' background_color'- outline' underline' overline' strikethrough') = do- (#poke markup_t, rise) ptr rise'- (#poke markup_t, spacing) ptr spacing'+ underline' overline' strikethrough') = do (#poke markup_t, gamma) ptr gamma' pokeColor ((#ptr markup_t, foreground_color) ptr) foreground_color' pokeColor ((#ptr markup_t, background_color) ptr) background_color'@@ -99,7 +94,6 @@ pokeColor colorPtr color where (boolPtr, colorPtr) = ptrs ptr- pokeAnnotation outlinePtrs outline' pokeAnnotation underlinePtrs underline' pokeAnnotation overlinePtrs overline' pokeAnnotation strikethroughPtrs strikethrough'
Graphics/Rendering/FreeTypeGL/Internal/Shader.hsc view
@@ -4,6 +4,9 @@ import Foreign.C.String (CString, withCString) import Foreign.C.Types (CUInt(..)) +-- | A 'Shader' represents a GL program to render text. Needs to be+-- loaded just once for all fonts. Use+-- 'Graphics.Rendering.FreeTypeGL.newShader' to make one. newtype Shader = Shader CUInt foreign import ccall "shader_load"
LICENSE view
@@ -1,30 +1,30 @@-Copyright (c)2011, Jason Dagit <dagitj@gmail.com> - -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. - - * Neither the name of Jason Dagit <dagitj@gmail.com> nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"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 -OWNER OR CONTRIBUTORS 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. +Copyright (c)2011, Eyal Lotem <eyal.lotem@gmail.com>++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.++ * Neither the name of Eyal Lotem <eyal.lotem@gmail.com> nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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+OWNER OR CONTRIBUTORS 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.
demos/hellobye.hs view
@@ -28,36 +28,45 @@ GL.ortho 0 resX 0 resY (-1) 1 GL.matrixMode $= GL.Modelview 0 -markup :: FGL.Markup-markup = FGL.Markup- { FGL.rise = 0- , FGL.spacing = 0- , FGL.gamma = 1.0+helloMarkup :: FGL.Markup+helloMarkup = FGL.Markup+ { FGL.gamma = 1.0 , FGL.foreground_color = Color4 1 0 0 1 , FGL.background_color = Color4 0.3 0.3 0.3 0.3- , FGL.outline = Just $ Color4 0.1 0.1 0.1 0.8 , FGL.underline = Just $ Color4 0.8 0.3 0.2 0.3 , FGL.overline = Just $ Color4 0.1 0.5 0.1 1- , FGL.strikethrough = Just $ Color4 0 0 0.8 1+ , FGL.strikethrough = Nothing } +byeMarkup :: FGL.Markup+byeMarkup = FGL.noMarkup+ { FGL.strikethrough = Just $ Color4 0 0 0.8 1+ }+ main :: IO () main = do [ttfFilename] <- getArgs initScreen GLFW.setWindowCloseCallback $ fail "Quit" + let+ fontSize :: Fractional a => a+ fontSize = 72.0 shader <- FGL.newShader- font <- FGL.loadFont shader ttfFilename 72.0- let hello = FGL.textRenderer (GL.Vector2 100 100) markup font "Hello world"- bye = FGL.textRenderer (GL.Vector2 100 200) FGL.noMarkup font "Bye world"+ font <- FGL.loadFont shader ttfFilename fontSize+ let hello = FGL.textRenderer helloMarkup font "Hello world"+ bye = FGL.textRenderer byeMarkup font "Bye world" forever $ do reshape- GL.clearColor $= GL.Color4 0.2 0 0 0+ GL.clearColor $= GL.Color4 0 0 0 0 GL.clear [GL.ColorBuffer, GL.DepthBuffer] GL.texture GL.Texture2D $= GL.Disabled- FGL.renderText hello- FGL.renderText bye+ let+ drawAt (GL.Vector2 x y) r = GL.preservingMatrix $ do+ GL.translate (GL.Vector3 x y (0 :: GL.GLfloat))+ FGL.renderText r+ drawAt (GL.Vector2 0 (fontSize + 2)) hello+ drawAt (GL.Vector2 0 resY) bye GLFW.swapBuffers GLFW.pollEvents