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/SDL2-ttf.cabal b/SDL2-ttf.cabal new file mode 100644 --- /dev/null +++ b/SDL2-ttf.cabal @@ -0,0 +1,28 @@ +Cabal-Version: >= 1.6 +Name: SDL2-ttf +Version: 0.1.0 +Maintainer: Ömer Sinan Ağacan (omeragacan@gmail.com) +Author: Ömer Sinan Ağacan (omeragacan@gmail.com) +License-File: LICENSE +License: MIT +Build-Type: Simple +Category: Foreign binding +Synopsis: Binding to libSDL-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 + +source-repository head + type: git + location: https://github.com/osa1/hsSDL2-ttf 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,13 @@ +#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_RenderUTF8_Solid1(TTF_Font *font, + const char *text, SDL_Color *fg) +{ + return TTF_RenderUTF8_Solid(font, text, *fg); +} 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,114 @@ +module Graphics.UI.SDL.TTF where + +import Foreign.C.String +import Foreign.Marshal.Alloc +import Foreign.Storable +import Foreign.Ptr +import Control.Monad +import Data.Int + +import qualified Graphics.UI.SDL.TTF.FFI as FFI +import Graphics.UI.SDL.TTF.Types +import Graphics.UI.SDL.Types +import Graphics.UI.SDL.Color +import Graphics.UI.SDL.Video (mkFinalizedSurface) +import Graphics.UI.SDL.General (getError) + +import Prelude hiding (init) + +init :: IO () +init = do + ret <- FFI.init + when (ret < 0) $ error . (\s -> "init: " ++ show s) =<< getError + +quit :: IO () +quit = FFI.quit + +withInit :: IO a -> IO a +withInit a = do init; ret <- a; quit; return ret + +openFont :: String -> Int -> IO TTFFont +openFont file ptsize = withCString file $ \cstr -> do + FFI.TTFFontPtr ptr <- FFI.openFont cstr (fromIntegral ptsize) + when (ptr == nullPtr) $ error . (\s -> "openFont: " ++ show s) =<< getError + return $ TTFFont (FFI.TTFFontPtr ptr) + +openFontIndex :: String -> Int -> Int -> IO TTFFont +openFontIndex file ptsize index = withCString file $ \cstr -> liftM TTFFont $ FFI.openFontIndex cstr (fromIntegral ptsize) (fromIntegral index) + +getFontStyle :: TTFFont -> IO TTFStyle +getFontStyle (TTFFont fontPtr) = liftM (toEnum . fromIntegral) $ FFI.getFontStyle fontPtr + +setFontStyle :: TTFFont -> TTFStyle -> IO () +setFontStyle (TTFFont fontPtr) style = FFI.setFontStyle fontPtr (fromIntegral $ fromEnum style) + +getFontHinting :: TTFFont -> IO TTFHinting +getFontHinting (TTFFont fontPtr) = liftM (toEnum . fromIntegral) $ FFI.getFontHinting fontPtr + +setFontHinting :: TTFFont -> TTFHinting -> IO () +setFontHinting (TTFFont fontPtr) hinting = FFI.setFontHinting fontPtr (fromIntegral $ fromEnum hinting) + +getFontHeight :: TTFFont -> IO Int +getFontHeight (TTFFont fontPtr) = liftM fromIntegral $ FFI.getFontHeight fontPtr + +getFontAscent :: TTFFont -> IO Int +getFontAscent (TTFFont fontPtr) = liftM fromIntegral $ FFI.getFontAscent fontPtr + +getFontDescent :: TTFFont -> IO Int +getFontDescent (TTFFont fontPtr) = liftM fromIntegral $ FFI.getFontDescent fontPtr + +getFontKerning :: TTFFont -> IO Int +getFontKerning (TTFFont fontPtr) = liftM fromIntegral $ FFI.getFontKerning fontPtr + +setFontKerning :: TTFFont -> Int -> IO () +setFontKerning (TTFFont fontPtr) i = FFI.setFontKerning fontPtr (fromIntegral i) + +fontFaces :: TTFFont -> IO Int64 +fontFaces (TTFFont fontPtr) = liftM fromIntegral $ FFI.fontFaces fontPtr + +fontFaceIsFixedWidth :: TTFFont -> IO Bool +fontFaceIsFixedWidth (TTFFont fontPtr) = liftM (== 0) $ FFI.fontFaceIsFixedWidth fontPtr + +fontFaceFamilyName :: TTFFont -> IO String +fontFaceFamilyName (TTFFont fontPtr) = FFI.fontFaceFamilyName fontPtr >>= peekCString + +fontFaceStyleName :: TTFFont -> IO String +fontFaceStyleName (TTFFont fontPtr) = FFI.fontFaceStyleName fontPtr >>= peekCString + +peekInts fn (TTFFont fontPtr) text = do + wPtr <- malloc + hPtr <- malloc + -- TODO: handle errors + void $ withCString text $ \cstr -> fn fontPtr cstr wPtr hPtr + w <- peek wPtr + h <- peek hPtr + free wPtr + free hPtr + return (fromIntegral w, fromIntegral h) + +sizeText :: TTFFont -> String -> IO (Int, Int) +sizeText = peekInts FFI.sizeText + +sizeUTF8 :: TTFFont -> String -> IO (Int, Int) +sizeUTF8 = peekInts FFI.sizeUTF8 + +sizeUNICODE :: TTFFont -> String -> IO (Int, Int) +sizeUNICODE = peekInts FFI.sizeUNICODE + +renderTextSolid :: TTFFont -> String -> Color -> IO Surface +renderTextSolid (TTFFont fontPtr) text fg = withCString text $ \cstr -> do + colorPtr <- malloc + poke colorPtr fg + ptr <- FFI.renderTextSolid fontPtr cstr colorPtr + when (ptr == nullPtr) $ error . show =<< getError + ret <- mkFinalizedSurface ptr + free colorPtr + return ret + +renderUTF8Solid :: TTFFont -> String -> Color -> IO Surface +renderUTF8Solid (TTFFont fontPtr) text fg = withCString text $ \cstr -> do + colorPtr <- malloc + poke colorPtr fg + ret <- mkFinalizedSurface =<< FFI.renderUTF8Solid fontPtr cstr colorPtr + free colorPtr + return ret 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,76 @@ +#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.Color + +foreign import ccall unsafe "TTF_Init" + init :: IO CInt + +foreign import ccall unsafe "TTF_Quit" + quit :: IO () + +newtype TTFFontPtr = TTFFontPtr (Ptr ()) + +foreign import ccall unsafe "TTF_OpenFont" + openFont :: CString -> CInt -> IO TTFFontPtr + +foreign import ccall unsafe "TTF_OpenFontIndex" + openFontIndex :: CString -> CInt -> CInt -> IO TTFFontPtr + +foreign import ccall unsafe "TTF_GetFontStyle" + getFontStyle :: TTFFontPtr -> IO CInt + +foreign import ccall unsafe "TTF_SetFontStyle" + setFontStyle :: TTFFontPtr -> CInt -> IO () + +foreign import ccall unsafe "TTF_GetFontHinting" + getFontHinting :: TTFFontPtr -> IO CInt + +foreign import ccall unsafe "TTF_SetFontHinting" + setFontHinting :: TTFFontPtr -> CInt -> IO () + +foreign import ccall unsafe "TTF_FontHeight" + getFontHeight :: TTFFontPtr -> IO CInt + +foreign import ccall unsafe "TTF_FontAscent" + getFontAscent :: TTFFontPtr -> IO CInt + +foreign import ccall unsafe "TTF_FontDescent" + getFontDescent :: TTFFontPtr -> IO CInt + +foreign import ccall unsafe "TTF_GetFontKerning" + getFontKerning :: TTFFontPtr -> IO CInt + +foreign import ccall unsafe "TTF_SetFontKerning" + setFontKerning :: TTFFontPtr -> CInt -> IO () + +foreign import ccall unsafe "TTF_FontFaces" + fontFaces :: TTFFontPtr -> IO CLong + +foreign import ccall unsafe "TTF_FontFaceIsFixedWidth" + fontFaceIsFixedWidth :: TTFFontPtr -> IO CInt + +foreign import ccall unsafe "TTF_FontFaceFamilyName" + fontFaceFamilyName :: TTFFontPtr -> IO CString + +foreign import ccall unsafe "TTF_FontFaceStyleName" + fontFaceStyleName :: TTFFontPtr -> IO CString + +foreign import ccall unsafe "TTF_SizeText" + sizeText :: TTFFontPtr -> CString -> Ptr CInt -> Ptr CInt -> IO CInt + +foreign import ccall unsafe "TTF_SizeUTF8" + sizeUTF8 :: TTFFontPtr -> CString -> Ptr CInt -> Ptr CInt -> IO CInt + +foreign import ccall unsafe "TTF_SizeUNICODE" + sizeUNICODE :: TTFFontPtr -> CString -> Ptr CInt -> Ptr CInt -> IO CInt + +foreign import ccall unsafe "TTF_RenderText_Solid1" + renderTextSolid :: TTFFontPtr -> CString -> Ptr Color -> IO (Ptr SDL.SurfaceStruct) + +foreign import ccall unsafe "TTF_RenderUTF8_Solid1" + renderUTF8Solid :: TTFFontPtr -> CString -> Ptr Color -> IO (Ptr SDL.SurfaceStruct) 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,39 @@ +#include "SDL2/SDL_ttf.h" +{-# LANGUAGE EmptyDataDecls #-} +module Graphics.UI.SDL.TTF.Types where + +import Graphics.UI.SDL.TTF.FFI as FFI + +newtype TTFFont = TTFFont FFI.TTFFontPtr + +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." + +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."