packages feed

SDL2-ttf (empty) → 0.1.0

raw patch · 7 files changed

+291/−0 lines, 7 filesdep +SDL2dep +basesetup-changed

Dependencies added: SDL2, base

Files

+ LICENSE view
@@ -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.
+ SDL2-ttf.cabal view
@@ -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
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cbits/rendering.c view
@@ -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);+}
+ src/Graphics/UI/SDL/TTF.hsc view
@@ -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
+ src/Graphics/UI/SDL/TTF/FFI.hsc view
@@ -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)
+ src/Graphics/UI/SDL/TTF/Types.hsc view
@@ -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."