diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2013 Ömer Sinan Ağacan + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies +of the Software, and to permit persons to whom the Software is furnished to do +so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cbits/rendering.c b/cbits/rendering.c new file mode 100644 --- /dev/null +++ b/cbits/rendering.c @@ -0,0 +1,37 @@ +#include "rendering.h" + +extern DECLSPEC SDL_Surface * SDLCALL TTF_RenderText_Solid1(TTF_Font *font, + const char *text, SDL_Color *fg) +{ + return TTF_RenderText_Solid(font, text, *fg); +} + +extern DECLSPEC SDL_Surface * SDLCALL TTF_RenderText_Shaded1(TTF_Font *font, + const char *text, SDL_Color *fg, SDL_Color *bg) +{ + return TTF_RenderText_Shaded(font, text, *fg, *bg); +} + +extern DECLSPEC SDL_Surface * SDLCALL TTF_RenderText_Blended1(TTF_Font *font, + const char *text, SDL_Color *fg) +{ + return TTF_RenderText_Blended(font, text, *fg); +} + +extern DECLSPEC SDL_Surface * SDLCALL TTF_RenderUTF8_Solid1(TTF_Font *font, + const char *text, SDL_Color *fg) +{ + return TTF_RenderUTF8_Solid(font, text, *fg); +} + +extern DECLSPEC SDL_Surface * SDLCALL TTF_RenderUTF8_Shaded1(TTF_Font *font, + const char *text, SDL_Color *fg, SDL_Color *bg) +{ + return TTF_RenderUTF8_Shaded(font, text, *fg, *bg); +} + +extern DECLSPEC SDL_Surface * SDLCALL TTF_RenderUTF8_Blended1(TTF_Font *font, + const char *text, SDL_Color *fg) +{ + return TTF_RenderUTF8_Blended(font, text, *fg); +} diff --git a/sdl2-ttf.cabal b/sdl2-ttf.cabal new file mode 100644 --- /dev/null +++ b/sdl2-ttf.cabal @@ -0,0 +1,35 @@ +Cabal-Version: >= 1.8 +Name: sdl2-ttf +Version: 0.2.0 +Maintainer: Sean Chalmers (sclhiannan@gmail.com) +Author: Ömer Sinan Ağacan (omeragacan@gmail.com) +License-File: LICENSE +License: MIT +Build-Type: Simple +Category: Foreign binding +Synopsis: Binding to libSDL2-ttf +Description: TODO +Data-files: + +Library + Hs-source-dirs: src + Build-Depends: base >= 3 && < 5, sdl2 + Extensions: ForeignFunctionInterface + Exposed-Modules: Graphics.UI.SDL.TTF.Types, + Graphics.UI.SDL.TTF.FFI + Graphics.UI.SDL.TTF + GHC-Options: -Wall + include-dirs: cbits + C-sources: cbits/rendering.c + extra-libraries: SDL2, SDL2_ttf + +test-suite test + type: exitcode-stdio-1.0 + main-is: font_test.hs + hs-source-dirs: test + build-depends: base >= 3 && <5, sdl2, sdl2-ttf + GHC-Options: -Wall + +source-repository head + type: git + location: https://github.com/mankyKitty/sdl2-ttf diff --git a/src/Graphics/UI/SDL/TTF.hsc b/src/Graphics/UI/SDL/TTF.hsc new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/SDL/TTF.hsc @@ -0,0 +1,366 @@ +----------------------------------------------------------------------- +-- | +-- Module : Graphics.UI.SDL.TTF +-- +-- Introduction from SDL_ttf documentation at: +-- +-- +-- This library is a wrapper around the excellent FreeType 1.2 library, +-- available at: Freetype Homepage +-- +-- WARNING: There may be patent issues with using the FreeType library. +-- Check the FreeType website for up-to-date details. +-- +-- This library allows you to use TrueType fonts to render text in SDL +-- applications. +-- +-- Be careful when including fonts with your application, as many of them +-- are copyrighted. The Microsoft fonts, for example, are not freely +-- redistributable and even the free "web" fonts they provide are only +-- redistributable in their special executable installer form (May 1998). +-- There are plenty of freeware and shareware fonts available on the +-- Internet though, which may suit your purposes. +-- +-- Enjoy! -Sam Lantinga slouken@devolution.com (5/1/98) +----------------------------------------------------------------------- +module Graphics.UI.SDL.TTF where + +import Foreign.C.String +import Foreign.C.Types (CInt) +import Foreign.Marshal.Alloc +import Foreign.Marshal.Utils +import Foreign.Storable +import Foreign.Ptr +import Control.Monad +import Data.Int + +import Graphics.UI.SDL.TTF.FFI (TTFFont) + +import qualified Graphics.UI.SDL.TTF.FFI as FFI +import Graphics.UI.SDL.TTF.Types +import Graphics.UI.SDL.Types + +import Prelude hiding (init) + +-- | Initialize the truetype font API. +-- This must be called before using other functions in this library, +-- except TTF_WasInit. +-- +-- SDL does not have to be initialized before this call. +-- Returns: 0 on success, -1 on any error. +init :: IO CInt +init = FFI.init + +-- | Query if TTF API has been initialised. +-- Query the initilization status of the truetype font API. +-- You may, of course, use this before TTF_Init to avoid +-- initializing twice in a row. Or use this to determine if you +-- need to call TTF_Quit. +wasInit :: IO Bool +wasInit = FFI.init >>= return . (==1) + +-- | Shut down the TTF system. +-- Shutdown and cleanup the truetype font API. +-- After calling this the SDL_ttf functions should not be used, +-- excepting TTF_WasInit. You may, of course, use TTF_Init to use +-- the functionality again. +quit :: IO () +quit = FFI.quit + +-- | Initialise the TTF system, run the given action(s), then quit TTF. +-- This function handles the initialisation and shut down of the TTF system +-- however if the initialisation fails an exception will be thrown and +-- your program will crash. +withInit :: IO a -> IO a +withInit a = do + ret <- init >> a + quit + return ret + +-- | Load file for use as a font, at ptsize size. +-- +-- This basically translates to pixel height. Equivalent to TTF_OpenFontIndex(file, ptsize, 0). +-- It can also can load TTF and FON files. +-- +openFont :: String -- ^ File name to load font from. + -> Int -- ^ Point size (based on 72DPI) to load font as. + -> IO TTFFont -- ^ Pointer to the font as a TTF_Font. NULL is returned on errors. +openFont file ptsize = withCString file $ \cstr -> + FFI.openFont cstr (fromIntegral ptsize) + +-- | Free the memory used by font, and free font itself as well. +-- +-- @Do not use font after this without loading a new font to it.@ +closeFont :: TTFFont -- ^ Font to be freed. + -> IO () +closeFont fontPtr = FFI.closeFont fontPtr + +-- | Load file, face index, for use as a font, at ptsize size. +-- +-- This is equivalent to TTF_OpenFontIndexRW(SDL_RWFromFile(file), ptsize, index), +-- but checks that the RWops it creates is not NULL. This can load TTF and FON files. +-- +openFontIndex :: String -- ^ File name to load font from. + -> Int -- ^ Point size (based on 72DPI) to load font as. + -> Int -- ^ Font face index. The first face is always index 0. + -> IO TTFFont -- ^ Pointer to the font as a TTF_Font. +openFontIndex file ptsize index = withCString file $ \cstr -> + FFI.openFontIndex cstr (fromIntegral ptsize) (fromIntegral index) + +-- | Get the rendering style of the loaded font. +-- +-- If no style is set then TTF_STYLE_NORMAL is returned. +-- +-- @Extra pointers: @ +getFontStyle :: TTFFont -- ^ Font + -> IO TTFStyle -- ^ Current style bitmask of the font. +getFontStyle fontPtr = liftM (toEnum . fromIntegral) $ FFI.getFontStyle fontPtr + +-- | Set the rendering style of the loaded font. +-- +-- This will flush the internal cache of previously rendered glyphs, +-- even if there is no change in style, so it may be best to check +-- the current style using TTF_GetFontStyle first. +-- +-- @Extra pointers: @ +setFontStyle :: TTFFont -- ^ Font + -> TTFStyle -- ^ The style as a bitmask + -> IO () +setFontStyle fontPtr style = FFI.setFontStyle fontPtr (fromIntegral $ fromEnum style) + +-- | Get the current hinting setting of the loaded font. +-- +-- If no hinting is set then TTF_HINTING_NORMAL is returned. +getFontHinting :: TTFFont -- ^ Font + -> IO TTFHinting -- ^ The current hinting setting of the loaded font. +getFontHinting fontPtr = liftM (toEnum . fromIntegral) $ FFI.getFontHinting fontPtr + +-- | Set the hinting of the loaded font. +-- +-- You should experiment with this setting if you know which font you +-- are using beforehand, especially when using smaller sized fonts. +-- If the user is selecting a font, you may wish to let them select the +-- hinting mode for that font as well. +setFontHinting :: TTFFont -- ^ Font + -> TTFHinting -- ^ The hinting setting desired. + -> IO () +setFontHinting fontPtr hinting = FFI.setFontHinting fontPtr (fromIntegral $ fromEnum hinting) + +-- | Get the maximum pixel height of all glyphs of the loaded font. +-- +-- You may use this height for rendering text as close together vertically +-- as possible, though adding at least one pixel height to it will space it +-- so they can't touch. Remember that SDL_ttf doesn't handle multiline +-- printing, so you are responsible for line spacing, see the TTF_FontLineSkip as well. +getFontHeight :: TTFFont -- ^ Font + -> IO Int -- ^ Maximum pixel height of all glyphs in the font. +getFontHeight fontPtr = liftM fromIntegral $ FFI.getFontHeight fontPtr + +-- | Get the maximum pixel ascent of all glyphs of the loaded font. +-- +-- This can also be interpreted as the distance from the top of the font +-- to the baseline. It could be used when drawing an individual glyph +-- relative to a top point, by combining it with the glyph's maxy metric +-- to resolve the top of the rectangle used when blitting the glyph on the screen. +-- +-- Warning: C code (ewwwww) +-- +-- @rect.y = top + TTF_FontAscent(font) - glyph_metric.maxy;@ +getFontAscent :: TTFFont -- ^ Font + -> IO Int -- ^ Maximum pixel ascent of all glyphs in the font. +getFontAscent fontPtr = liftM fromIntegral $ FFI.getFontAscent fontPtr + +-- | Get the maximum pixel descent of all glyphs of the loaded font. +-- +-- This can also be interpreted as the distance from the baseline to the bottom of the font. +-- It could be used when drawing an individual glyph relative to a bottom point, +-- by combining it with the glyph's maxy metric to resolve the top of the rectangle +-- used when blitting the glyph on the screen. +getFontDescent :: TTFFont -- ^ Font + -> IO Int -- ^ Maximum pixel height of all glyphs in the font. +getFontDescent fontPtr = liftM fromIntegral $ FFI.getFontDescent fontPtr + +-- | Get the current kerning setting of the loaded font. +-- +-- The default for a newly loaded font is enabled(True). +fontKerningEnabled :: TTFFont -- ^ Font + -> IO KerningStatus -- ^ Current Kerning status. +fontKerningEnabled fontPtr = FFI.getFontKerning fontPtr >>= return . toKS + where + toKS 1 = KerningOn + toKS _ = KerningOff + +-- | Set whther to use kerning when rendering the loaded font. +-- +-- This has no effect on individual glyphs, but rather when rendering whole +-- strings of characters, at least a word at a time. Perhaps the only time +-- to disable this is when kerning is not working for a specific font, +-- resulting in overlapping glyphs or abnormal spacing within words. +setFontKerning :: TTFFont -- ^ Font + -> KerningStatus -- ^ Desired Kerning status. + -> IO () +setFontKerning fontPtr KerningOn = FFI.setFontKerning fontPtr 1 +setFontKerning fontPtr KerningOff = FFI.setFontKerning fontPtr 0 + +-- | Get the number of faces ("sub-fonts") available in the loaded font. +-- +-- This is a count of the number of specific fonts (based on size and +-- style and other typographical features perhaps) contained in the +-- font itself. It seems to be a useless fact to know, since it can't +-- be applied in any other SDL_ttf functions. +fontFaces :: TTFFont -- ^ Font + -> IO Int64 -- ^ The number of faces in the font. +fontFaces fontPtr = liftM fromIntegral $ FFI.fontFaces fontPtr + +-- | Test if the current font face of the loaded font is a fixed width font. +-- +-- Fixed width fonts are monospace, meaning every character that exists in +-- the font is the same width, thus you can assume that a rendered string's +-- width is going to be the result of a simple calculation: +-- +-- @glyph_width * string_length@ +-- +fontFaceIsFixedWidth :: TTFFont -- ^ Font + -> IO Bool -- ^ If font is a fixed width font. +fontFaceIsFixedWidth fontPtr = liftM (== 0) $ FFI.fontFaceIsFixedWidth fontPtr + +-- | Get the current font face family name from the loaded font. +-- +-- This function may return a NULL pointer, in which case the information +-- is not available. +fontFaceFamilyName :: TTFFont -- ^ Font + -> IO String -- ^ The current family name of of the face of the font, or NULL perhaps. +fontFaceFamilyName fontPtr = FFI.fontFaceFamilyName fontPtr >>= peekCString + +-- | Get the current font face style name from the loaded font. +-- +-- This function may return a NULL pointer, in which case the information +-- is not available. +fontFaceStyleName :: TTFFont -- ^ Font + -> IO String -- ^ The current style name of of the face of the font, or NULL perhaps. +fontFaceStyleName fontPtr = FFI.fontFaceStyleName fontPtr >>= peekCString + +-- | Calculate the resulting surface size of the LATIN1 encoded text rendered using font. +-- +-- No actual rendering is done, however correct kerning is done to get the actual +-- width. The height returned in h is the same as you can get using @getFontHeight@. +sizeText :: TTFFont -- ^ Font + -> String -- ^ The LATIN1 null terminated string to size up. + -> IO (Int, Int) -- ^ (Width,Height) +sizeText = peekInts FFI.sizeText + +-- | Calculate the resulting surface size of the UTF8 encoded text rendered using font. +-- +-- No actual rendering is done, however correct kerning is done to get the actual width. +-- The height returned in h is the same as you can get using @getFontHeight@. +sizeUTF8 :: TTFFont -- ^ Font + -> String -- ^ The UTF8 null terminated string to size up. + -> IO (Int, Int) -- ^ (Width,Height) +sizeUTF8 = peekInts FFI.sizeUTF8 + +-- | Calculate the resulting surface size of the UNICODE encoded text rendered using font. +-- +-- No actual rendering is done, however correct kerning is done to get the actual width. +-- The height returned in h is the same as you can get using @getFontHeight@. +sizeUNICODE :: TTFFont -- ^ Font + -> String -- ^ The UNICODE null terminated string to size up. + -> IO (Int, Int) -- ^ (Width,Height) +sizeUNICODE = peekInts FFI.sizeUNICODE + +-- | Render the LATIN1 encoded text, using the Solid mode +-- +-- Render the LATIN1 encoded text using font with fg color onto a new surface, +-- using the Solid mode. +-- +-- @The caller (you!) is responsible for freeing any returned surface.@ +renderTextSolid :: TTFFont -- ^ Font + -> String -- ^ The LATIN1 null terminated string to render. + -> Color -- ^ The color to render the text in. Colormap index 1. + -> IO (Ptr Surface) -- ^ Pointer to a new SDL_Surface. NULL is returned on errors. +renderTextSolid fontPtr text fg = withCString text $ \cstr -> do + with fg $ \colorPtr -> FFI.renderTextSolid fontPtr cstr colorPtr + +-- | Render the LATIN1 encoded text, using the Shaded mode +-- +-- Render the LATIN1 encoded text using font with fg color onto a new surface, +-- using the Shaded mode. +-- +-- @The caller (you!) is responsible for freeing any returned surface.@ +renderTextShaded :: TTFFont -- ^ Font + -> String -- ^ The LATIN1 null terminated string to render. + -> Color -- ^ The color to render the text in. Colormap index 1. + -> Color -- ^ The color to render the background box in. Colormap index 0. + -> IO (Ptr Surface) -- ^ Pointer to a new SDL_Surface. NULL is returned on errors. +renderTextShaded fontPtr text fg bg = withCString text $ \cstr -> + with fg $ \fgColorPtr -> + with bg $ \bgColorPtr -> + FFI.renderTextShaded fontPtr cstr fgColorPtr bgColorPtr + +-- | Render the LATIN1 encoded text, using the Blended mode +-- +-- Render the LATIN1 encoded text using font with fg color onto a new surface, +-- using the Blended mode. +-- +-- @The caller (you!) is responsible for freeing any returned surface.@ +renderTextBlended :: TTFFont -- ^ Font + -> String -- ^ The LATIN1 null terminated string to render. + -> Color -- ^ The color to render the text in. Colormap index 1. + -> IO (Ptr Surface) -- ^ Pointer to a new SDL_Surface. NULL is returned on errors. +renderTextBlended fontPtr text color = withCString text $ \cstr -> + with color $ \colorPtr -> FFI.renderTextBlended fontPtr cstr colorPtr + +-- | Render the UTF8 encoded text, using the Solid mode +-- +-- Render the UTF8 encoded text using font with fg color onto a new surface, +-- using the Solid mode. +-- +-- @The caller (you!) is responsible for freeing any returned surface.@ +renderUTF8Solid :: TTFFont -- ^ Font + -> String -- ^ The UTF8 null terminated string to render. + -> Color -- ^ The color to render the text in. Colormap index 1. + -> IO (Ptr Surface) -- ^ Pointer to a new SDL_Surface. NULL is returned on errors. +renderUTF8Solid fontPtr text fg = withCString text $ \cstr -> do + with fg $ \colorPtr -> FFI.renderUTF8Solid fontPtr cstr colorPtr + +-- | Render the UTF8 encoded text, using the Shaded mode +-- +-- Render the UTF8 encoded text using font with fg color onto a new surface, +-- using the Shaded mode. +-- +-- @The caller (you!) is responsible for freeing any returned surface.@ +renderUTF8Shaded :: TTFFont -- ^ Font + -> String -- ^ The UTF8 null terminated string to render. + -> Color -- ^ The color to render the text in. Colormap index 1. + -> Color -- ^ The color to render the background box in. Colormap index 0. + -> IO (Ptr Surface) -- ^ Pointer to a new SDL_Surface. NULL is returned on errors. +renderUTF8Shaded fontPtr text fg bg = withCString text $ \cstr -> + with fg $ \fgColorPtr -> + with bg $ \bgColorPtr -> + FFI.renderUTF8Shaded fontPtr cstr fgColorPtr bgColorPtr + +-- | Render the UTF8 encoded text, using the Blended mode +-- +-- Render the UTF8 encoded text using font with fg color onto a new surface, +-- using the Blended mode. +-- +-- @The caller (you!) is responsible for freeing any returned surface.@ +renderUTF8Blended :: TTFFont -- ^ Font + -> String -- ^ The UTF8 null terminated string to render. + -> Color -- ^ The color to render the text in. Colormap index 1. + -> IO (Ptr Surface) -- ^ Pointer to a new SDL_Surface. NULL is returned on errors. +renderUTF8Blended fontPtr text color = withCString text $ \cstr -> + with color $ \colorPtr -> FFI.renderUTF8Blended fontPtr cstr colorPtr + +peekInts + :: (FFI.TTFFont -> CString -> Ptr CInt -> Ptr CInt -> IO CInt) + -> TTFFont + -> String + -> IO (Int,Int) +peekInts fn fontPtr text = do + alloca $ \wPtr -> + alloca $ \hPtr -> do + -- TODO: handle errors + void $ withCString text $ \cstr -> fn fontPtr cstr wPtr hPtr + w <- peek wPtr + h <- peek hPtr + return (fromIntegral w, fromIntegral h) diff --git a/src/Graphics/UI/SDL/TTF/FFI.hsc b/src/Graphics/UI/SDL/TTF/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/SDL/TTF/FFI.hsc @@ -0,0 +1,94 @@ +#include "SDL2/SDL_ttf.h" +module Graphics.UI.SDL.TTF.FFI where + +import Foreign.C +import Foreign.Ptr + +import qualified Graphics.UI.SDL.Types as SDL +import Graphics.UI.SDL.Types (Color) + +type TTFFont = Ptr () + +foreign import ccall unsafe "TTF_Init" + init :: IO CInt + +foreign import ccall unsafe "TTF_WasInit" + wasInit :: IO CInt + +foreign import ccall unsafe "TTF_Quit" + quit :: IO () + +foreign import ccall unsafe "TTF_OpenFont" + openFont :: CString -> CInt -> IO TTFFont + +foreign import ccall unsafe "TTF_CloseFont" + closeFont :: TTFFont -> IO () + +foreign import ccall unsafe "TTF_OpenFontIndex" + openFontIndex :: CString -> CInt -> CInt -> IO TTFFont + +foreign import ccall unsafe "TTF_GetFontStyle" + getFontStyle :: TTFFont -> IO CInt + +foreign import ccall unsafe "TTF_SetFontStyle" + setFontStyle :: TTFFont -> CInt -> IO () + +foreign import ccall unsafe "TTF_GetFontHinting" + getFontHinting :: TTFFont -> IO CInt + +foreign import ccall unsafe "TTF_SetFontHinting" + setFontHinting :: TTFFont -> CInt -> IO () + +foreign import ccall unsafe "TTF_FontHeight" + getFontHeight :: TTFFont -> IO CInt + +foreign import ccall unsafe "TTF_FontAscent" + getFontAscent :: TTFFont -> IO CInt + +foreign import ccall unsafe "TTF_FontDescent" + getFontDescent :: TTFFont -> IO CInt + +foreign import ccall unsafe "TTF_GetFontKerning" + getFontKerning :: TTFFont -> IO CInt + +foreign import ccall unsafe "TTF_SetFontKerning" + setFontKerning :: TTFFont -> CInt -> IO () + +foreign import ccall unsafe "TTF_FontFaces" + fontFaces :: TTFFont -> IO CLong + +foreign import ccall unsafe "TTF_FontFaceIsFixedWidth" + fontFaceIsFixedWidth :: TTFFont -> IO CInt + +foreign import ccall unsafe "TTF_FontFaceFamilyName" + fontFaceFamilyName :: TTFFont -> IO CString + +foreign import ccall unsafe "TTF_FontFaceStyleName" + fontFaceStyleName :: TTFFont -> IO CString + +foreign import ccall unsafe "TTF_SizeText" + sizeText :: TTFFont -> CString -> Ptr CInt -> Ptr CInt -> IO CInt + +foreign import ccall unsafe "TTF_SizeUTF8" + sizeUTF8 :: TTFFont -> CString -> Ptr CInt -> Ptr CInt -> IO CInt + +foreign import ccall unsafe "TTF_SizeUNICODE" + sizeUNICODE :: TTFFont -> CString -> Ptr CInt -> Ptr CInt -> IO CInt + +foreign import ccall unsafe "TTF_RenderText_Solid1" + renderTextSolid :: TTFFont -> CString -> Ptr Color -> IO (Ptr SDL.Surface) + +foreign import ccall unsafe "TTF_RenderText_Shaded1" + renderTextShaded :: TTFFont -> CString -> Ptr Color -> Ptr Color -> IO (Ptr SDL.Surface) + +foreign import ccall unsafe "TTF_RenderText_Blended1" + renderTextBlended :: TTFFont -> CString -> Ptr Color -> IO (Ptr SDL.Surface) + +foreign import ccall unsafe "TTF_RenderUTF8_Solid1" + renderUTF8Solid :: TTFFont -> CString -> Ptr Color -> IO (Ptr SDL.Surface) + +foreign import ccall unsafe "TTF_RenderUTF8_Shaded1" + renderUTF8Shaded :: TTFFont -> CString -> Ptr Color -> Ptr Color -> IO (Ptr SDL.Surface) + +foreign import ccall unsafe "TTF_RenderUTF8_Blended1" + renderUTF8Blended :: TTFFont -> CString -> Ptr Color -> IO (Ptr SDL.Surface) diff --git a/src/Graphics/UI/SDL/TTF/Types.hsc b/src/Graphics/UI/SDL/TTF/Types.hsc new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/SDL/TTF/Types.hsc @@ -0,0 +1,56 @@ +#include "SDL2/SDL_ttf.h" +{-# LANGUAGE EmptyDataDecls #-} +module Graphics.UI.SDL.TTF.Types where + +data KerningStatus + = KerningOn + | KerningOff + deriving (Show,Eq) + +data TTFError + = RenderUTF8Blended + | RenderUTF8Shaded + | RenderUTF8Solid + | RenderTextBlended + | RenderTextShaded + | RenderTextSolid + | OpenFont + deriving Show + +data TTFStyle = TTFNormal | TTFBold | TTFItalic | TTFUnderline | TTFStrikethrough + deriving ( Eq, Ord, Show, Read ) + +instance Enum TTFStyle where + fromEnum TTFNormal = #{const TTF_STYLE_NORMAL} + fromEnum TTFBold = #{const TTF_STYLE_BOLD} + fromEnum TTFItalic = #{const TTF_STYLE_ITALIC} + fromEnum TTFUnderline = #{const TTF_STYLE_UNDERLINE} + fromEnum TTFStrikethrough = #{const TTF_STYLE_STRIKETHROUGH} + + toEnum #{const TTF_STYLE_NORMAL} = TTFNormal + toEnum #{const TTF_STYLE_BOLD} = TTFBold + toEnum #{const TTF_STYLE_ITALIC} = TTFItalic + toEnum #{const TTF_STYLE_UNDERLINE} = TTFUnderline + toEnum #{const TTF_STYLE_STRIKETHROUGH} = TTFStrikethrough + toEnum _ = error "TTFStyle.toEnum: Invalid argument." + +-- | Hinting +-- +-- Font hinting is the use of mathematical instructions to adjust +-- the display of an outline font so that it lines up with a rasterized grid. +-- At small screen sizes, with or without antialiasing, hinting is critical +-- for producing a clear, legible text for human readers. +data TTFHinting = TTFHNormal | TTFHLight | TTFHMono | TTFHNone + deriving ( Eq, Ord, Show, Read ) + +instance Enum TTFHinting where + fromEnum TTFHNormal = #{const TTF_HINTING_NORMAL} + fromEnum TTFHLight = #{const TTF_HINTING_LIGHT} + fromEnum TTFHMono = #{const TTF_HINTING_MONO} + fromEnum TTFHNone = #{const TTF_HINTING_NONE} + + toEnum #{const TTF_HINTING_NORMAL} = TTFHNormal + toEnum #{const TTF_HINTING_LIGHT} = TTFHLight + toEnum #{const TTF_HINTING_MONO} = TTFHMono + toEnum #{const TTF_HINTING_NONE} = TTFHNone + toEnum _ = error "TTFHinting.toEnum: Invalid argument." diff --git a/test/font_test.hs b/test/font_test.hs new file mode 100644 --- /dev/null +++ b/test/font_test.hs @@ -0,0 +1,65 @@ +module Main where + +import qualified Graphics.UI.SDL.TTF as TTF +import qualified Graphics.UI.SDL as SDL + +import Foreign.C.String (withCAString) +import Foreign (peek,alloca,with,maybePeek,nullPtr) + +arial :: String +arial = "./test/ARIAL.TTF" + +main :: IO () +main = do + _ <- SDL.init SDL.SDL_INIT_VIDEO + window <- createWindow + renderer <- createRenderer window + + TTF.withInit $ do + font <- TTF.openFont arial 150 -- Pt size for retina screen. :< + textSurface <- TTF.renderUTF8Solid font "some text" (SDL.Color 255 255 255 0) + textTexture <- SDL.createTextureFromSurface renderer textSurface + SDL.freeSurface textSurface + loop window renderer textTexture + + TTF.closeFont font + SDL.destroyRenderer renderer + SDL.destroyWindow window + SDL.quit + +createRenderer :: SDL.Window -> IO (SDL.Renderer) +createRenderer w = SDL.createRenderer w (-1) 0 + +createWindow :: IO (SDL.Window) +createWindow = withCAString "test" $ \t -> + SDL.createWindow t + SDL.SDL_WINDOWPOS_UNDEFINED + SDL.SDL_WINDOWPOS_UNDEFINED + 640 480 + SDL.SDL_WINDOW_SHOWN + +loop :: t -> SDL.Renderer -> SDL.Texture -> IO () +loop window renderer textTexture = do + let loc = SDL.Rect 320 240 150 100 + _ <- SDL.renderClear renderer + _ <- with loc $ \loc' -> + SDL.renderCopy renderer textTexture nullPtr loc' + SDL.renderPresent renderer + + handleEvents window renderer textTexture + +pollEvent :: IO (Maybe SDL.Event) +pollEvent = alloca $ \ptr -> do + status <- SDL.pollEvent ptr + if status == 1 + then maybePeek peek ptr + else return Nothing + +handleEvents :: t -> SDL.Renderer -> SDL.Texture -> IO () +handleEvents window renderer textTexture = do + mbEvent <- pollEvent + case mbEvent of + Just (SDL.QuitEvent _ _) -> return () + _ -> loop window renderer textTexture + +