packages feed

sdl2-ttf 1.0.0 → 2.0.0

raw patch · 16 files changed

+1210/−774 lines, 16 filesdep +bytestringdep +template-haskelldep +textdep −lineardep −transformersdep ~basedep ~sdl2new-component:exe:sdl2-ttf-examplenew-uploader

Dependencies added: bytestring, template-haskell, text

Dependencies removed: linear, transformers

Dependency ranges changed: base, sdl2

Files

LICENSE view
@@ -1,9 +1,30 @@-Copyright (c) Rongcui Dong 2015+Copyright (c) 2013-2017 Ömer Sinan Ağacan, Siniša Biđin, Rongcui Dong -Original author: (c) 2013 Ömer Sinan Ağacan+This code is double-licenced under MIT and BSD3 licences. -Sublicensed from original MIT License. A copy of original license is-available in source distribution++MIT licence text follows.++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.+++BSD3 licence text follows.  All rights reserved.
+ cbits/helpers.c view
@@ -0,0 +1,119 @@+#include "SDL.h"+#include "SDL_ttf.h"++// Lots of SDL_ttf's render functions accept an SDL_Color directly. We send in+// a pointer instead, which we dereference here. Is there a way to avoid this?++// Note the "_p" added to the function names.++extern DECLSPEC SDL_Surface * SDLCALL+  TTF_RenderUNICODE_Solid_p(+    TTF_Font *font,+    uint16_t *text,+    SDL_Color *fg) {++  return TTF_RenderUNICODE_Solid(font, text, *fg);+}++extern DECLSPEC SDL_Surface * SDLCALL+  TTF_RenderUNICODE_Shaded_p(+    TTF_Font *font,+    uint16_t *text,+    SDL_Color *fg,+    SDL_Color *bg) {++  return TTF_RenderUNICODE_Shaded(font, text, *fg, *bg);+}++extern DECLSPEC SDL_Surface * SDLCALL+  TTF_RenderUNICODE_Blended_p(+    TTF_Font *font,+    uint16_t *text,+    SDL_Color *fg) {++  return TTF_RenderUNICODE_Blended(font, text, *fg);+}++extern DECLSPEC SDL_Surface * SDLCALL+  TTF_RenderUTF8_Solid_p(+    TTF_Font *font,+    const char *text,+    SDL_Color *fg) {++  return TTF_RenderUTF8_Solid(font, text, *fg);+}++extern DECLSPEC SDL_Surface * SDLCALL+  TTF_RenderUTF8_Shaded_p(+    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_Blended_p(+    TTF_Font *font,+    const char *text,+    SDL_Color *fg) {++  return TTF_RenderUTF8_Blended(font, text, *fg);+}++extern DECLSPEC SDL_Surface * SDLCALL+  TTF_RenderText_Solid_p(+    TTF_Font *font,+    const char *text,+    SDL_Color *fg) {++  return TTF_RenderText_Solid(font, text, *fg);+}++extern DECLSPEC SDL_Surface * SDLCALL+  TTF_RenderText_Shaded_p(+    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_Blended_p(+    TTF_Font *font,+    const char *text,+    SDL_Color *fg) {++  return TTF_RenderText_Blended(font, text, *fg);+}++extern DECLSPEC SDL_Surface * SDLCALL+  TTF_RenderGlyph_Solid_p(+    TTF_Font *font,+    uint16_t glyph,+    SDL_Color *fg) {++  return TTF_RenderGlyph_Solid(font, glyph, *fg);+}++extern DECLSPEC SDL_Surface * SDLCALL+  TTF_RenderGlyph_Shaded_p(+    TTF_Font *font,+    uint16_t glyph,+    SDL_Color *fg,+    SDL_Color *bg) {++  return TTF_RenderGlyph_Shaded(font, glyph, *fg, *bg);+}++extern DECLSPEC SDL_Surface * SDLCALL+  TTF_RenderGlyph_Blended_p(+    TTF_Font *font,+    uint16_t glyph,+    SDL_Color *fg) {++  return TTF_RenderGlyph_Blended(font, glyph, *fg);+}
− cbits/rendering.c 
@@ -1,37 +0,0 @@-#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);-}
− cbits/rendering.h 
@@ -1,20 +0,0 @@-#ifndef _RENDERING_H-#define _RENDERING_H--#include "SDL2/SDL.h"-#include "SDL2/SDL_ttf.h"--extern DECLSPEC SDL_Surface * SDLCALL TTF_RenderText_Solid1(TTF_Font *font,-                const char *text, SDL_Color *fg);-extern DECLSPEC SDL_Surface * SDLCALL TTF_RenderText_Shaded1(TTF_Font *font,-                const char *text, SDL_Color *fg, SDL_Color *bg);-extern DECLSPEC SDL_Surface * SDLCALL TTF_RenderText_Blended1(TTF_Font *font,-                const char *text, SDL_Color *fg);-extern DECLSPEC SDL_Surface * SDLCALL TTF_RenderUTF8_Solid1(TTF_Font *font,-                const char *text, SDL_Color *fg);-extern DECLSPEC SDL_Surface * SDLCALL TTF_RenderUTF8_Shaded1(TTF_Font *font,-                const char *text, SDL_Color *fg, SDL_Color *bg);-extern DECLSPEC SDL_Surface * SDLCALL TTF_RenderUTF8_Blended1(TTF_Font *font,-                const char *text, SDL_Color *fg);--#endif
+ example/Example.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Concurrent (threadDelay)+import Control.Monad      (forM_)+import Data.ByteString    (readFile)+import Data.Text          (Text, unpack)+import Data.Text.IO       (putStrLn)+import Prelude     hiding (putStrLn, readFile)+import System.Environment (getArgs)+import System.Exit        (exitFailure)++import qualified SDL+import qualified SDL.Font++red :: SDL.Font.Color+red = SDL.V4 255 0 0 0++gray :: SDL.Font.Color+gray = SDL.V4 128 128 128 255++-- A sequence of example actions to be perfomed and displayed.+examples :: [(Text, SDL.Window -> FilePath -> IO ())]+examples = [++  ("Blitting solid",+    \window path -> do+      font <- SDL.Font.load path 70+      text <- SDL.Font.solid font red "Solid!"+      SDL.Font.free font+      screen <- SDL.getWindowSurface window+      SDL.surfaceBlit text Nothing screen Nothing+      SDL.freeSurface text+      SDL.updateWindowSurface window),++  ("Blitting shaded",+    \window path -> do+      font <- SDL.Font.load path 70+      text <- SDL.Font.shaded font red gray "Shaded!"+      SDL.Font.free font+      screen <- SDL.getWindowSurface window+      SDL.surfaceBlit text Nothing screen Nothing+      SDL.freeSurface text+      SDL.updateWindowSurface window),++  ("Blitting blended",+    \window path -> do+      font <- SDL.Font.load path 70+      text <- SDL.Font.blended font red "Blended!"+      SDL.Font.free font+      screen <- SDL.getWindowSurface window+      SDL.surfaceBlit text Nothing screen Nothing+      SDL.freeSurface text+      SDL.updateWindowSurface window),++  ("Blitting styled",+    \window path -> do+      font <- SDL.Font.load path 65+      let styles = [SDL.Font.Bold, SDL.Font.Underline, SDL.Font.Italic]+      SDL.Font.setStyle font styles+      print =<< SDL.Font.getStyle font+      text <- SDL.Font.blended font red "Styled!"+      SDL.Font.free font+      screen <- SDL.getWindowSurface window+      SDL.surfaceBlit text Nothing screen Nothing+      SDL.freeSurface text+      SDL.updateWindowSurface window),++  ("Blitting outlined",+    \window path -> do+      font <- SDL.Font.load path 65+      SDL.Font.setOutline font 3+      print =<< SDL.Font.getOutline font+      text <- SDL.Font.blended font red "Outlined!"+      SDL.Font.free font+      screen <- SDL.getWindowSurface window+      SDL.surfaceBlit text Nothing screen Nothing+      SDL.freeSurface text+      SDL.updateWindowSurface window),++  ("Decoding from bytestring",+    \window path -> do+      bytes <- readFile path+      font <- SDL.Font.decode bytes 40+      let chars = "Decoded~~~!"+      putStrLn "How big will the surface be?"+      print =<< SDL.Font.size font chars+      text <- SDL.Font.blended font gray chars+      putStrLn "Style and family names?"+      print =<< SDL.Font.styleName font+      print =<< SDL.Font.familyName font+      SDL.Font.free font+      screen <- SDL.getWindowSurface window+      SDL.surfaceBlit text Nothing screen Nothing+      SDL.freeSurface text+      SDL.updateWindowSurface window),++  ("Render a single glyph",+    \window path -> do+      font <- SDL.Font.load path 100+      text <- SDL.Font.blendedGlyph font red 'ŏ'+      SDL.Font.free font+      screen <- SDL.getWindowSurface window+      SDL.surfaceBlit text Nothing screen Nothing+      SDL.freeSurface text+      SDL.updateWindowSurface window),++  ("Check existence of weird chars, blit them",+    \window path -> do+      font <- SDL.Font.load path 80+      putStrLn "  Glyphs provided or not:"+      let chars = "☃Δ✭!"+      exist <- mapM (SDL.Font.glyphProvided font) $ unpack chars+      print $ zip (unpack chars) exist+      putStrLn "  Metrics:"+      metrics <- mapM (SDL.Font.glyphMetrics font) $ unpack chars+      print $ zip (unpack chars) metrics+      text <- SDL.Font.blended font red chars+      SDL.Font.free font+      screen <- SDL.getWindowSurface window+      SDL.surfaceBlit text Nothing screen Nothing+      SDL.freeSurface text+      SDL.updateWindowSurface window)+  ]++main :: IO ()+main = do++  SDL.initialize [SDL.InitVideo]+  SDL.Font.initialize++  getArgs >>= \case++    [] -> do+      putStrLn "Usage: cabal run path/to/font.(ttf|fon)"+      exitFailure++    -- Run each of the examples within a newly-created window.+    (path:_) ->+      forM_ examples $ \(name, action) -> do+        putStrLn name+        window <- SDL.createWindow name SDL.defaultWindow+        SDL.showWindow window+        action window path+        threadDelay 1000000+        SDL.destroyWindow window++  SDL.Font.quit+  SDL.quit
− examples/ARIAL.TTF

binary file changed (273020 → absent bytes)

− examples/font_test.c 
@@ -1,46 +0,0 @@-#include "SDL2/SDL.h"-#include "SDL2/SDL_video.h"-#include "SDL2/SDL_ttf.h"--int handle_event()-{-  SDL_Event event;-  while (SDL_PollEvent(&event)) {-    if (event.type == SDL_QUIT) {-      return -1;-    }-  }-  return 0;-}--int main()-{-  SDL_Init(SDL_INIT_EVERYTHING);-  TTF_Init();--  SDL_Window *window = SDL_CreateWindow("test", 100, 100, 640, 480, SDL_WINDOW_SHOWN);-  SDL_Renderer *renderer = SDL_CreateRenderer(window, -1, SDL_RENDERER_ACCELERATED);--  TTF_Font *font = TTF_OpenFont("/usr/share/fonts/truetype/DroidSans.ttf", 13);-  if (font == NULL)-    printf("null font\n");--  SDL_Color color = {255, 255, 255};-  SDL_Surface *textSurface = TTF_RenderText_Solid(font, "some text", color);-  if (textSurface == NULL)-    printf("null text surface\n");--  SDL_Texture *textTexture = SDL_CreateTextureFromSurface(renderer, textSurface);-  if (textTexture == NULL)-    printf("null text texture\n");--  SDL_Rect rect = { 0, 0, 640, 480 };--  while (handle_event() == 0) {-    SDL_RenderClear(renderer);-    SDL_RenderCopy(renderer, textTexture, &rect, &rect);-    SDL_RenderPresent(renderer);-  }--  return 0;-}
− examples/font_test.hs 
@@ -1,72 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Main where--import qualified SDL.TTF as TTF-import qualified SDL.Raw             as Raw-import qualified SDL as SDL----import Foreign.C.String (withCAString)---import Foreign (peek,alloca,with,maybePeek,nullPtr)--import Linear.V2-import Linear.Affine (Point(..))--arial :: String-arial = "./examples/ARIAL.TTF"--main :: IO ()-main = do-    _ <- SDL.initialize [SDL.InitVideo]-    window <- SDL.createWindow "Test" SDL.defaultWindow-    renderer <- SDL.createRenderer window 0 SDL.defaultRenderer--    TTF.withInit $ do-      inited <- TTF.wasInit-      if not inited then error "[Bug] Font system not initialized" else return ()-      font <- TTF.openFont arial 150 -- Pt size for retina screen. :<-      textSurface <- TTF.renderUTF8Solid font "some text" (Raw.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.Rectangle (P $ V2 320 240) (V2 150 100)-    SDL.clear renderer-    SDL.copy renderer textTexture Nothing (Just loc)-    SDL.present 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 <- SDL.pollEvent-  case mbEvent of-    Just (SDL.Event _ SDL.QuitEvent) -> return ()-    _ -> loop window renderer textTexture
sdl2-ttf.cabal view
@@ -1,41 +1,73 @@-Cabal-Version:      >= 1.10-Name:               sdl2-ttf-Version:            1.0.0-Maintainer:         Rongcui Dong (karl_1702@188.com)-Author:             Ömer Sinan Ağacan (omeragacan@gmail.com)-                  , Sean Chalmers (sclhiannan@gmail.com)-License-File:       LICENSE-License:            MIT-Build-Type:         Simple-Category:           Foreign binding-Synopsis:           Binding to libSDL2-ttf-Description:        Haskell bindings to the sdl2-ttf C++ library <http://www.libsdl.org/projects/SDL_ttf/>.-Data-files:-extra-source-files: cbits/rendering.h-                    examples/ARIAL.TTF-                    examples/font_test.c+name:          sdl2-ttf+version:       2.0.0+synopsis:      Bindings to SDL2_ttf.+description:   Haskell bindings to SDL2_ttf C++ library <http://www.libsdl.org/projects/SDL_ttf/>.+bug-reports:   https://github.com/haskell-game/sdl2-ttf/issues+license:       BSD3+license-file:  LICENSE+maintainer:    Mikolaj Konarski <mikolaj.konarski@funktory.com>+author:        Rongcui Dong (rongcuid@outlook.com),+               Siniša Biđin <sinisa@bidin.eu>,+               Ömer Sinan Ağacan (omeragacan@gmail.com),+               Sean Chalmers (sclhiannan@gmail.com)+copyright:     Copyright © 2013-2017 Ömer Sinan Ağacan, Siniša Biđin, Rongcui Dong+category:      Font, Foreign binding, Graphics+build-type:    Simple+cabal-version: >=1.10 -Library-  Hs-source-dirs:     src-  Build-Depends:      base >= 3 && < 5, sdl2 >= 2, transformers-  default-extensions: ForeignFunctionInterface-  Exposed-Modules:    SDL.TTF.Types,-                      SDL.TTF.FFI-                      SDL.TTF-  other-modules:      SDL.TTF.Internals-  GHC-Options:        -Wall-  include-dirs:       cbits-  C-sources:          cbits/rendering.c-  extra-libraries:    SDL2, SDL2_ttf-  default-language:   Haskell2010+source-repository head+  type:     git+  location: https://github.com/haskell-game/sdl2-ttf -executable font-test-  main-is:          font_test.hs-  hs-source-dirs:   examples-  build-depends:    base >= 3 && <5, sdl2, sdl2-ttf, linear-  GHC-Options:      -Wall+library+  ghc-options: -Wall++  exposed-modules:+    SDL.Font,+    SDL.Raw.Font++  other-modules:+    SDL.Raw.Helper++  hs-source-dirs:+    src++  pkgconfig-depends:+    sdl2 >= 2.0.3,+    SDL2_ttf >= 2.0.0++  c-sources:+    cbits/helpers.c++  build-depends:+    base             >= 4.7 && < 5,+    bytestring       >= 0.10.4.0,+    sdl2             >= 2.2,+    template-haskell,+    text             >= 1.1.0.0++  default-language:+    Haskell2010++  if os(windows)+    cpp-options: -D_SDL_main_h++flag example+  description: Build the example executable+  default:     False++executable sdl2-ttf-example+  ghc-options: -Wall+  hs-source-dirs: example+  main-is: Example.hs   default-language: Haskell2010 -source-repository head-    type:     git-    location: https://github.com/carldong/sdl2-ttf+  if flag(example)+    build-depends:+      base,+      bytestring,+      sdl2,+      sdl2-ttf,+      text+  else+    buildable: False
+ src/SDL/Font.hs view
@@ -0,0 +1,503 @@+{-|++Module      : SDL.Font+Copyright   : (c) 2015 Siniša Biđin+License     : MIT+Stability   : experimental++Bindings to the @SDL2_ttf@ library+<http://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf.html>+which itself is a wrapper around the FreeType library.+The bindings should allow you to load fonts and++You can safely assume that any monadic function listed here is capable of+throwing an 'SDLException' in case it encounters an error.++-}++{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE LambdaCase         #-}+{-# LANGUAGE OverloadedStrings  #-}++module SDL.Font+  (+  -- * General+    initialize+  , version+  , quit++  -- * Loading+  --+  -- | Use the following functions to load @TTF@ and @FON@ file formats.+  , Font(..)+  , PointSize+  , load+  , Index+  , loadIndex+  , decode+  , decodeIndex+  , free++  -- * Rendering+  --+  -- | Use the following functions to render text to a 'Surface'.+  --+  -- The methods available are described in more detail in the original+  -- @SDL2_ttf@ documentation+  -- <http://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf.html#SEC42 here>.+  , Color+  , solid+  , shaded+  , blended+  , size++  -- * Attributes+  , Style(..)+  , getStyle+  , setStyle+  , Outline+  , getOutline+  , setOutline+  , Hinting(..)+  , getHinting+  , setHinting+  , Kerning+  , getKerning+  , setKerning+  , isMonospace+  , familyName+  , styleName+  , height+  , ascent+  , descent+  , lineSkip++  -- * Glyphs+  --+  -- | Functions that work with individual glyphs.+  , glyphProvided+  , glyphIndex+  , glyphMetrics+  , solidGlyph+  , shadedGlyph+  , blendedGlyph+  ) where++import Control.Exception      (throwIO)+import Control.Monad          (unless)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Bits              ((.&.), (.|.))+import Data.ByteString        (ByteString)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen, unsafePackCString)+import Data.Text              (Text)+import Data.Text.Encoding     (decodeUtf8)+import Data.Text.Foreign      (lengthWord16, unsafeCopyToPtr)+import Data.Word              (Word8, Word16)+import Foreign.C.String       (CString, withCString)+import Foreign.C.Types        (CUShort, CInt)+import Foreign.Marshal.Alloc  (allocaBytes, alloca)+import Foreign.Marshal.Utils  (with, fromBool, toBool)+import Foreign.Ptr            (Ptr, castPtr, nullPtr)+import Foreign.Storable       (peek, pokeByteOff)+import GHC.Generics           (Generic)+import SDL                    (Surface(..), SDLException(SDLCallFailed))+import SDL.Internal.Exception+import SDL.Raw.Filesystem     (rwFromConstMem)+import SDL.Vect               (V4(..))++import qualified SDL.Raw+import qualified SDL.Raw.Font++-- | Gets the major, minor, patch versions of the linked @SDL2_ttf@ library.+--+-- You may call this without initializing the library with 'initialize'.+version :: (Integral a, MonadIO m) => m (a, a, a)+version = liftIO $ do+  SDL.Raw.Version major minor patch <- peek =<< SDL.Raw.Font.getVersion+  return (fromIntegral major, fromIntegral minor, fromIntegral patch)++-- | Initializes the library.+--+-- Unless noted otherwise, this must be called before any other part of the+-- library is used.+--+-- You may call this multiple times.+initialize :: MonadIO m => m ()+initialize = do+  init'd <- (== 1) `fmap` SDL.Raw.Font.wasInit+  unless init'd $+    throwIfNeg_ "SDL.Font.initialize" "TTF_Init" SDL.Raw.Font.init++-- | Cleans up any resources still in use by the library.+--+-- If called, you must call 'initialize' again before using any other parts of+-- the library.+quit :: MonadIO m => m ()+quit = SDL.Raw.Font.quit++-- | Represents a loaded font.+newtype Font = Font { unwrap :: Ptr SDL.Raw.Font.Font }+  deriving (Eq, Show)++-- | Point size (based on 72DPI) to load font as. Translates to pixel height.+type PointSize = Int++-- | Given a path to a font file, loads it for use as a 'Font' at a certain+-- 'PointSize'.+load :: MonadIO m => FilePath -> PointSize -> m Font+load path pts =+  fmap Font .+    throwIfNull "SDL.Font.load" "TTF_OpenFont" .+      liftIO . withCString path $+        flip SDL.Raw.Font.openFont $ fromIntegral pts++-- | Same as 'load', but accepts a 'ByteString' containing a font instead.+decode :: MonadIO m => ByteString -> PointSize -> m Font+decode bytes pts = liftIO .+  unsafeUseAsCStringLen bytes $ \(cstr, len) -> do+    rw <- rwFromConstMem (castPtr cstr) (fromIntegral len)+    fmap Font .+      throwIfNull "SDL.Font.decode" "TTF_OpenFontRW" $+        SDL.Raw.Font.openFont_RW rw 0 $ fromIntegral pts++-- | Designates a font face, the default and first one being 0.+type Index = Int++-- | Given a path to a font file, loads one of its font faces (designated by+-- the given index) for use as a 'Font' at a certain 'PointSize'.+--+-- The first face is always index 0, and is the one chosen by default when+-- using 'load'.+loadIndex :: MonadIO m => FilePath -> PointSize -> Index -> m Font+loadIndex path pts i =+  fmap Font .+    throwIfNull "SDL.Font.loadIndex" "TTF_OpenFontIndex" .+      liftIO . withCString path $ \cpath ->+        SDL.Raw.Font.openFontIndex cpath (fromIntegral pts) (fromIntegral i)++-- | Same as 'loadIndex', but accepts a 'ByteString' containing a font instead.+decodeIndex :: MonadIO m => ByteString -> PointSize -> Index -> m Font+decodeIndex bytes pts i = liftIO .+  unsafeUseAsCStringLen bytes $ \(cstr, len) -> do+    rw <- rwFromConstMem (castPtr cstr) (fromIntegral len)+    fmap Font .+      throwIfNull "SDL.Font.decodeIndex" "TTF_OpenFontIndexRW" $+        SDL.Raw.Font.openFontIndex_RW rw 0 (fromIntegral pts) (fromIntegral i)++-- | Frees a loaded 'Font'.+free :: MonadIO m => Font -> m ()+free = SDL.Raw.Font.closeFont . unwrap++-- | Color as an RGBA byte vector.+type Color = V4 Word8++-- | A helper for unmanaged 'Surface's, since it is not exposed by SDL itself.+unmanaged :: Ptr SDL.Raw.Surface -> Surface+unmanaged p = Surface p Nothing++-- | Renders 'Text' using the /quick and dirty/ method.+--+-- Is the fastest of the rendering methods, but results in text that isn't as+-- /smooth/.+solid :: MonadIO m => Font -> Color -> Text -> m SDL.Surface+solid (Font font) (V4 r g b a) text =+  fmap unmanaged .+    throwIfNull "SDL.Font.solid" "TTF_RenderUNICODE_Solid" .+      liftIO . withText text $ \ptr ->+        with (SDL.Raw.Color r g b a) $ \fg ->+          SDL.Raw.Font.renderUNICODE_Solid font (castPtr ptr) fg++-- | Uses the /slow and nice, but with a solid box/ method.+--+-- Renders slower than 'solid', but in about the same time as 'blended'.+--+-- Results in a 'Surface' containing antialiased text of a foreground color+-- surrounded by a box of a background color. This 'Surface' will blit as fast+-- as the one from 'solid'.+shaded :: MonadIO m => Font -> Color -> Color -> Text -> m SDL.Surface+shaded (Font font) (V4 r g b a) (V4 r2 g2 b2 a2) text =+  fmap unmanaged .+    throwIfNull "SDL.Font.shaded" "TTF_RenderUNICODE_Shaded" .+      liftIO . withText text $ \ptr ->+        with (SDL.Raw.Color r g b a) $ \fg ->+          with (SDL.Raw.Color r2 g2 b2 a2) $ \bg ->+            SDL.Raw.Font.renderUNICODE_Shaded font (castPtr ptr) fg bg++-- | The /slow slow slow, but ultra nice over another image/ method, 'blended'+-- renders text at high quality.+--+-- The text is antialiased and surrounded by a transparent box. Renders slower+-- than 'solid', but in about the same time as 'shaded'.+--+-- The resulting 'Surface' will blit slower than the ones from 'solid' or+-- 'shaded'.+blended :: MonadIO m => Font -> Color -> Text -> m SDL.Surface+blended (Font font) (V4 r g b a) text =+  fmap unmanaged .+    throwIfNull "SDL.Font.blended" "TTF_RenderUNICODE_Blended" .+      liftIO . withText text $ \ptr ->+        with (SDL.Raw.Color r g b a) $ \fg ->+          SDL.Raw.Font.renderUNICODE_Blended font (castPtr ptr) fg++-- Analogous to Data.Text.Foreign.useAsPtr, just appends a null-byte.+-- FIXME: Is this even necessary?+withText :: Text -> (Ptr Word16 -> IO a) -> IO a+withText text act =+  allocaBytes len $ \ptr -> do+    unsafeCopyToPtr text ptr+    pokeByteOff ptr (len - 2) (0 :: CUShort)+    act ptr+  where+    len = 2*(lengthWord16 text + 1)++-- Helper function for converting a bitmask into a list of values.+fromMaskWith :: (Enum a, Bounded a) => (a -> CInt) -> CInt -> [a]+fromMaskWith convert cint = concatMap (\a -> find (a, convert a)) [minBound..]+  where+    find (a, i) = [a | i == i .&. cint]++-- Helper function for converting a list of values into a bitmask.+toMaskWith :: (a -> CInt) -> [a] -> CInt+toMaskWith convert = foldr ((.|.) . convert) 0++-- | Possible styles that can be applied to a 'Font'.+data Style+  = Bold+  | Italic+  | Underline+  | Strikethrough+  deriving (Eq, Enum, Ord, Bounded, Generic, Read, Show)++styleToCInt :: Style -> CInt+styleToCInt =+  \case+    Bold          -> SDL.Raw.Font.TTF_STYLE_BOLD+    Italic        -> SDL.Raw.Font.TTF_STYLE_ITALIC+    Underline     -> SDL.Raw.Font.TTF_STYLE_UNDERLINE+    Strikethrough -> SDL.Raw.Font.TTF_STYLE_STRIKETHROUGH++-- | Gets the rendering styles of a given 'Font'.+--+-- If none were ever set, this will be an empty list.+getStyle :: MonadIO m => Font -> m [Style]+getStyle = fmap (fromMaskWith styleToCInt) . SDL.Raw.Font.getFontStyle . unwrap++-- | Sets the rendering style of a 'Font'.+--+-- Use an empty list to reset the style.+setStyle :: MonadIO m => Font -> [Style] -> m ()+setStyle (Font font) = SDL.Raw.Font.setFontStyle font . toMaskWith styleToCInt++-- | The size of the 'Font' outline, in pixels.+--+-- Use 0 to turn off outlining.+type Outline = Int++-- | Gets the current outline size of a given 'Font'.+getOutline :: MonadIO m => Font -> m Outline+getOutline = fmap fromIntegral . SDL.Raw.Font.getFontOutline . unwrap++-- | Sets the outline size for a given 'Font'.+--+-- Use 0 to turn off outlining.+setOutline :: MonadIO m => Font -> Outline -> m ()+setOutline (Font font) = SDL.Raw.Font.setFontOutline font . fromIntegral++-- | The hinting setting of a 'Font'.+data Hinting+  = Normal+  | Light+  | Mono+  | None+  deriving (Eq, Enum, Ord, Bounded, Generic, Read, Show)++hintingToCInt :: Hinting -> CInt+hintingToCInt =+  \case+    Normal -> SDL.Raw.Font.TTF_HINTING_NORMAL+    Light  -> SDL.Raw.Font.TTF_HINTING_LIGHT+    Mono   -> SDL.Raw.Font.TTF_HINTING_MONO+    None   -> SDL.Raw.Font.TTF_HINTING_NONE++cIntToHinting :: CInt -> Hinting+cIntToHinting =+  \case+    SDL.Raw.Font.TTF_HINTING_NORMAL -> Normal+    SDL.Raw.Font.TTF_HINTING_LIGHT  -> Light+    SDL.Raw.Font.TTF_HINTING_MONO   -> Mono+    SDL.Raw.Font.TTF_HINTING_NONE   -> None+    _ -> error "SDL.Font.cIntToHinting received unknown TTF_HINTING."++-- | Gets the hinting setting of a given 'Font'.+getHinting :: MonadIO m => Font -> m Hinting+getHinting = fmap cIntToHinting . SDL.Raw.Font.getFontHinting . unwrap++-- | Sets the hinting setting of a font.+setHinting :: MonadIO m => Font -> Hinting -> m ()+setHinting (Font font) = SDL.Raw.Font.setFontHinting font . hintingToCInt++-- | Whether kerning is enabled or not.+--+-- The default for a newly-loaded 'Font' is enabled.+type Kerning = Bool++-- | Gets the current kerning setting of a given 'Font'.+getKerning :: MonadIO m => Font -> m Kerning+getKerning = fmap toBool . SDL.Raw.Font.getFontKerning . unwrap++-- | Sets the kerning setting for a given 'Font'.+--+-- Use 'False' to turn off kerning.+setKerning :: MonadIO m => Font -> Kerning -> m ()+setKerning (Font font) = SDL.Raw.Font.setFontKerning font . fromBool++-- | Gets the maximum pixel height of all glyphs of a given 'Font'.+height :: MonadIO m => Font -> m Int+height = fmap fromIntegral . SDL.Raw.Font.fontHeight . unwrap++-- | Gets the maximum pixel ascent of all glyphs of a given 'Font'.+--+-- This can be interpreted as the distance from the top of the font to the+-- baseline.+ascent :: MonadIO m => Font -> m Int+ascent = fmap fromIntegral . SDL.Raw.Font.fontAscent . unwrap++-- | Gets the maximum pixel descent of all glyphs of a given 'Font'.+--+-- Also interpreted as the distance from the baseline to the bottom of the+-- font.+descent :: MonadIO m => Font -> m Int+descent = fmap fromIntegral . SDL.Raw.Font.fontDescent . unwrap++-- | Gets the recommended pixel height of a rendered line of text of a given+-- 'Font'.+--+-- This is usually larger than what 'height' would return.+lineSkip :: MonadIO m => Font -> m Int+lineSkip = fmap fromIntegral . SDL.Raw.Font.fontLineSkip . unwrap++-- | Tests whether the current face of a 'Font' is a fixed width font or not.+isMonospace :: MonadIO m => Font -> m Bool+isMonospace = fmap toBool . SDL.Raw.Font.fontFaceIsFixedWidth . unwrap++cStringToText :: MonadIO m => CString -> m Text+cStringToText = fmap decodeUtf8 . liftIO . unsafePackCString++onlyIfM :: Monad m => Bool -> m a -> m (Maybe a)+onlyIfM = \case+  False -> return . const Nothing+  True  -> fmap Just++-- | Gets the current font face family name, if any.+familyName :: MonadIO m => Font -> m (Maybe Text)+familyName (Font font) = do+  cstr <- SDL.Raw.Font.fontFaceFamilyName font+  onlyIfM (cstr /= nullPtr) $ cStringToText cstr++-- | Gets the current font face style name, if any.+styleName :: MonadIO m => Font -> m (Maybe Text)+styleName (Font font) = do+  cstr <- SDL.Raw.Font.fontFaceStyleName font+  onlyIfM (cstr /= nullPtr) $ cStringToText cstr++-- | Does a 'Font' provide a certain unicode character?+glyphProvided :: MonadIO m => Font -> Char -> m Bool+glyphProvided font ch =+  glyphIndex font ch >>= \case+    Just  _ -> return True+    Nothing -> return False++{-# INLINE fromChar #-}+fromChar :: Integral a => Char -> a+fromChar = fromIntegral . fromEnum++-- | Same as 'glyphProvided', but returns an index of the glyph for the given+-- character instead, if one is provided.+glyphIndex :: MonadIO m => Font -> Char -> m (Maybe Int)+glyphIndex (Font font) ch =+  SDL.Raw.Font.glyphIsProvided font (fromChar ch)+    >>= \case+      0 -> return Nothing+      i -> return . Just $ fromIntegral i++-- | Get glyph metrics for a given unicode character. The values returned are:+--+--     1. minimum x offset+--     2. maximum x offset+--     3. minimum y offset+--     4. maximum y offset+--     5. advance offset+--+-- You can see more information about these values in the original @SDL2_ttf@+-- documentation+-- <http://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf.html#SEC38 here>.+glyphMetrics :: MonadIO m => Font -> Char -> m (Maybe (Int, Int, Int, Int, Int))+glyphMetrics (Font font) ch =+  liftIO .+    alloca $ \minx ->+      alloca $ \maxx ->+        alloca $ \miny ->+          alloca $ \maxy ->+            alloca $ \advn -> do+              let chi = fromChar ch+              r <- SDL.Raw.Font.glyphMetrics font chi minx maxx miny maxy advn+              if r /= 0 then+                return Nothing+              else do+                a <- fromIntegral <$> peek minx+                b <- fromIntegral <$> peek maxx+                c <- fromIntegral <$> peek miny+                d <- fromIntegral <$> peek maxy+                e <- fromIntegral <$> peek advn+                return $ Just (a, b, c, d, e)++-- | Use this function to discover how wide and tall a 'Surface' needs to be+-- in order to accommodate a given text when it is rendered.+--+-- Note that no actual rendering takes place.+--+-- The values returned are the width and height, respectively, in pixels. The+-- height returned is the same one returned by 'height'.+size :: MonadIO m => Font -> Text -> m (Int, Int)+size (Font font) text =+    liftIO .+      withText text $ \ptr ->+        alloca $ \w ->+          alloca $ \h ->+            SDL.Raw.Font.sizeUNICODE font (castPtr ptr) w h+              >>= \case+                0 -> do+                  w' <- fromIntegral <$> peek w+                  h' <- fromIntegral <$> peek h+                  return (w', h')+                _ -> do+                  err <- getError+                  throwIO $ SDLCallFailed "SDL.Font.size" "TTF_SizeUNICODE" err++-- | Same as 'solid', but renders a single glyph instead.+solidGlyph :: MonadIO m => Font -> Color -> Char -> m SDL.Surface+solidGlyph (Font font) (V4 r g b a) ch =+  fmap unmanaged .+    throwIfNull "SDL.Font.solidGlyph" "TTF_RenderGlyph_Solid" .+      liftIO .+        with (SDL.Raw.Color r g b a) $ \fg ->+          SDL.Raw.Font.renderGlyph_Solid font (fromChar ch) fg++-- | Same as 'shaded', but renders a single glyph instead.+shadedGlyph :: MonadIO m => Font -> Color -> Color -> Char -> m SDL.Surface+shadedGlyph (Font font) (V4 r g b a) (V4 r2 g2 b2 a2) ch =+  fmap unmanaged .+    throwIfNull "SDL.Font.shadedGlyph" "TTF_RenderGlyph_Solid" .+      liftIO .+        with (SDL.Raw.Color r g b a) $ \fg ->+          with (SDL.Raw.Color r2 g2 b2 a2) $ \bg ->+            SDL.Raw.Font.renderGlyph_Shaded font (fromChar ch) fg bg++-- | Same as 'blended', but renders a single glyph instead.+blendedGlyph :: MonadIO m => Font -> Color -> Char -> m SDL.Surface+blendedGlyph (Font font) (V4 r g b a) ch =+  fmap unmanaged .+    throwIfNull "SDL.Font.blendedGlyph" "TTF_RenderGlyph_Blended" .+      liftIO .+        with (SDL.Raw.Color r g b a) $ \fg ->+          SDL.Raw.Font.renderGlyph_Blended font (fromChar ch) fg
+ src/SDL/Raw/Font.hsc view
@@ -0,0 +1,257 @@+{-|++Module      : SDL.Raw.Font+Copyright   : (c) 2015 Siniša Biđin+License     : MIT+Stability   : experimental++Raw bindings to the @SDL2_ttf@ library. No error-handling is done here. For more+information about specific function behaviour, see the @SDL2_ttf@ documentation.++-}++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TemplateHaskell #-}++module SDL.Raw.Font+  (+  -- * General+    init+  , wasInit+  , quit+  , getVersion++  -- * Loading fonts+  , Font+  , FontPath+  , PointSize+  , openFont+  , Free+  , openFont_RW+  , Index+  , openFontIndex+  , openFontIndex_RW+  , closeFont++  -- * Font attributes+  , getFontStyle+  , setFontStyle+  , pattern TTF_STYLE_NORMAL+  , pattern TTF_STYLE_BOLD+  , pattern TTF_STYLE_ITALIC+  , pattern TTF_STYLE_UNDERLINE+  , pattern TTF_STYLE_STRIKETHROUGH+  , getFontOutline+  , setFontOutline+  , getFontHinting+  , setFontHinting+  , pattern TTF_HINTING_NORMAL+  , pattern TTF_HINTING_LIGHT+  , pattern TTF_HINTING_MONO+  , pattern TTF_HINTING_NONE+  , getFontKerning+  , setFontKerning+  , fontHeight+  , fontAscent+  , fontDescent+  , fontLineSkip+  , fontFaces+  , fontFaceIsFixedWidth+  , fontFaceFamilyName+  , fontFaceStyleName+  , glyphIsProvided+  , glyphMetrics++  -- * Getting text size+  , sizeText+  , sizeUTF8+  , sizeUNICODE++  -- * Rendering text+  , renderText_Solid+  , renderText_Shaded+  , renderText_Blended+  , renderUTF8_Solid+  , renderUTF8_Shaded+  , renderUTF8_Blended+  , renderUNICODE_Solid+  , renderUNICODE_Shaded+  , renderUNICODE_Blended+  , renderGlyph_Solid+  , renderGlyph_Shaded+  , renderGlyph_Blended++  -- * Other+  , byteSwappedUNICODE+  , pattern UNICODE_BOM_NATIVE+  , pattern UNICODE_BOM_SWAPPED+  ) where++#include "SDL_ttf.h"++import Foreign.C.String       (CString)+import Foreign.C.Types        (CInt(..), CLong(..), CUShort(..))+import Foreign.Ptr            (Ptr)+import Prelude         hiding (init)+import SDL.Raw.Types          (Version, Surface, RWops, Color)+import SDL.Raw.Helper         (liftF)++pattern UNICODE_BOM_NATIVE      = #{const UNICODE_BOM_NATIVE}+pattern UNICODE_BOM_SWAPPED     = #{const UNICODE_BOM_SWAPPED}+pattern TTF_STYLE_NORMAL        = #{const TTF_STYLE_NORMAL}+pattern TTF_STYLE_BOLD          = #{const TTF_STYLE_BOLD}+pattern TTF_STYLE_ITALIC        = #{const TTF_STYLE_ITALIC}+pattern TTF_STYLE_UNDERLINE     = #{const TTF_STYLE_UNDERLINE}+pattern TTF_STYLE_STRIKETHROUGH = #{const TTF_STYLE_STRIKETHROUGH}+pattern TTF_HINTING_LIGHT       = #{const TTF_HINTING_LIGHT}+pattern TTF_HINTING_MONO        = #{const TTF_HINTING_MONO}+pattern TTF_HINTING_NONE        = #{const TTF_HINTING_NONE}+pattern TTF_HINTING_NORMAL      = #{const TTF_HINTING_NORMAL}++liftF "getVersion" "TTF_Linked_Version"+  [t|IO (Ptr Version)|]++liftF "init" "TTF_Init"+  [t|IO CInt|]++liftF "wasInit" "TTF_WasInit"+  [t|IO CInt|]++liftF "quit" "TTF_Quit"+  [t|IO ()|]++-- | A path to a font file.+type FontPath = CString++-- | Point size (based on 72DPI). Translates to pixel height.+type PointSize = CInt++-- | The raw, underlying @TTF_Font@ struct.+data Font++-- | Should the 'Ptr' 'RWops' be freed after an operation? 1 for yes, 0 for no.+type Free = CInt++-- | Indicates the font face we're loading. First face is always 0.+type Index = CLong++liftF "openFont" "TTF_OpenFont"+  [t|FontPath -> PointSize -> IO (Ptr Font)|]++liftF "openFont_RW" "TTF_OpenFontRW"+  [t|Ptr RWops -> Free -> PointSize -> IO (Ptr Font)|]++liftF "openFontIndex" "TTF_OpenFontIndex"+  [t|FontPath -> PointSize -> Index -> IO (Ptr Font)|]++liftF "openFontIndex_RW" "TTF_OpenFontIndexRW"+  [t|Ptr RWops -> Free -> PointSize -> Index -> IO (Ptr Font)|]++liftF "closeFont" "TTF_CloseFont"+  [t|Ptr Font -> IO ()|]++liftF "byteSwappedUNICODE" "TTF_ByteSwappedUNICODE"+  [t|CInt -> IO ()|]++liftF "getFontStyle" "TTF_GetFontStyle"+  [t|Ptr Font -> IO CInt|]++liftF "setFontStyle" "TTF_SetFontStyle"+  [t|Ptr Font -> CInt -> IO ()|]++liftF "getFontOutline" "TTF_GetFontOutline"+  [t|Ptr Font -> IO CInt|]++liftF "setFontOutline" "TTF_SetFontOutline"+  [t|Ptr Font -> CInt -> IO ()|]++liftF "getFontHinting" "TTF_GetFontHinting"+  [t|Ptr Font -> IO CInt|]++liftF "setFontHinting" "TTF_SetFontHinting"+  [t|Ptr Font -> CInt -> IO ()|]++liftF "getFontKerning" "TTF_GetFontKerning"+  [t|Ptr Font -> IO CInt|]++liftF "setFontKerning" "TTF_SetFontKerning"+  [t|Ptr Font -> CInt -> IO ()|]++liftF "fontHeight" "TTF_FontHeight"+  [t|Ptr Font -> IO CInt|]++liftF "fontAscent" "TTF_FontAscent"+  [t|Ptr Font -> IO CInt|]++liftF "fontDescent" "TTF_FontDescent"+  [t|Ptr Font -> IO CInt|]++liftF "fontLineSkip" "TTF_FontLineSkip"+  [t|Ptr Font -> IO CInt|]++liftF "fontFaces" "TTF_FontFaces"+  [t|Ptr Font -> IO CLong|]++liftF "fontFaceIsFixedWidth" "TTF_FontFaceIsFixedWidth"+  [t|Ptr Font -> IO CInt|]++liftF "fontFaceFamilyName" "TTF_FontFaceFamilyName"+  [t|Ptr Font -> IO CString|]++liftF "fontFaceStyleName"  "TTF_FontFaceStyleName"+  [t|Ptr Font -> IO CString|]++liftF "glyphIsProvided" "TTF_GlyphIsProvided"+  [t|Ptr Font -> CUShort -> IO CInt|]++liftF "glyphMetrics" "TTF_GlyphMetrics"+  [t|Ptr Font -> CUShort ->+     Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt ->+     IO CInt|]++liftF "sizeText" "TTF_SizeText"+  [t|Ptr Font -> CString -> Ptr CInt -> Ptr CInt -> IO CInt|]++liftF "sizeUTF8" "TTF_SizeUTF8"+  [t|Ptr Font -> CString -> Ptr CInt -> Ptr CInt -> IO CInt|]++liftF "sizeUNICODE" "TTF_SizeUNICODE"+  [t|Ptr Font -> Ptr CUShort -> Ptr CInt -> Ptr CInt -> IO CInt|]++liftF "renderText_Solid" "TTF_RenderText_Solid_p"+  [t|Ptr Font -> CString -> Ptr Color -> IO (Ptr Surface)|]++liftF "renderUTF8_Solid" "TTF_RenderUTF8_Solid_p"+  [t|Ptr Font -> CString -> Ptr Color -> IO (Ptr Surface)|]++liftF "renderUNICODE_Solid" "TTF_RenderUNICODE_Solid_p"+  [t|Ptr Font -> Ptr CUShort -> Ptr Color -> IO (Ptr Surface)|]++liftF "renderGlyph_Solid" "TTF_RenderGlyph_Solid_p"+  [t|Ptr Font -> CUShort -> Ptr Color -> IO (Ptr Surface)|]++liftF "renderText_Shaded" "TTF_RenderText_Shaded_p"+  [t|Ptr Font -> CString -> Ptr Color -> Ptr Color -> IO (Ptr Surface)|]++liftF "renderUTF8_Shaded" "TTF_RenderUTF8_Shaded_p"+  [t|Ptr Font -> CString -> Ptr Color -> Ptr Color -> IO (Ptr Surface)|]++liftF "renderUNICODE_Shaded" "TTF_RenderUNICODE_Shaded_p"+  [t|Ptr Font -> Ptr CUShort -> Ptr Color -> Ptr Color -> IO (Ptr Surface)|]++liftF "renderGlyph_Shaded" "TTF_RenderGlyph_Shaded_p"+  [t|Ptr Font -> CUShort -> Ptr Color -> Ptr Color -> IO (Ptr Surface)|]++liftF "renderText_Blended" "TTF_RenderText_Blended_p"+  [t|Ptr Font -> CString -> Ptr Color -> IO (Ptr Surface)|]++liftF "renderUTF8_Blended" "TTF_RenderUTF8_Blended_p"+  [t|Ptr Font -> CString -> Ptr Color -> IO (Ptr Surface)|]++liftF "renderUNICODE_Blended" "TTF_RenderUNICODE_Blended_p"+  [t|Ptr Font -> Ptr CUShort -> Ptr Color -> IO (Ptr Surface)|]++liftF "renderGlyph_Blended" "TTF_RenderGlyph_Blended_p"+  [t|Ptr Font -> CUShort -> Ptr Color -> IO (Ptr Surface)|]
+ src/SDL/Raw/Helper.hs view
@@ -0,0 +1,86 @@+{-|++Module      : SDL.Raw.Helper+Copyright   : (c) 2015 Siniša Biđin+License     : MIT+Stability   : experimental++Exposes a way to automatically generate a foreign import alongside its lifted,+inlined MonadIO variant. Use this to simplify the package's SDL.Raw.* modules.++-}++{-# LANGUAGE BangPatterns    #-}+{-# LANGUAGE LambdaCase      #-}+{-# LANGUAGE TemplateHaskell #-}++module SDL.Raw.Helper (liftF) where++import Control.Monad           (replicateM)+import Control.Monad.IO.Class  (MonadIO, liftIO)+import Language.Haskell.TH++-- | Given a name @fname@, a name of a C function @cname@ and the desired+-- Haskell type @ftype@, this function generates:+--+-- * A foreign import of @cname@, named as @fname'@.+-- * An always-inline MonadIO version of @fname'@, named @fname@.+liftF :: String -> String -> Q Type -> Q [Dec]+liftF fname cname ftype = do+  let f' = mkName $ fname ++ "'" -- Direct binding.+  let f  = mkName fname          -- Lifted.+  t' <- ftype                    -- Type of direct binding.++  -- The generated function accepts n arguments.+  args <- replicateM (countArgs t') $ newName "x"++  -- If the function has no arguments, then we just liftIO it directly.+  -- However, this fails to typecheck without an explicit type signature.+  -- Therefore, we include one. TODO: Can we get rid of this?+  sigd <- case args of+            [] -> ((:[]) . SigD f) `fmap` liftType t'+            _  -> return []++  return $ concat+    [+      [ ForeignD $ ImportF CCall Safe cname f' t'+      , PragmaD $ InlineP f Inline FunLike AllPhases+      ]+    , sigd+    , [ FunD f+        [ Clause+            (map VarP args)+            (NormalB $ 'liftIO `applyTo` [f' `applyTo` map VarE args])+            []+        ]+      ]+    ]++-- | How many arguments does a function of a given type take?+countArgs :: Type -> Int+countArgs = count 0+  where+    count !n = \case+      (AppT (AppT ArrowT _) t) -> count (n+1) t+      (ForallT _ _ t) -> count n t+      (SigT t _)      -> count n t+      _               -> n++-- | An expression where f is applied to n arguments.+applyTo :: Name -> [Exp] -> Exp+applyTo f [] = VarE f+applyTo f es = loop (tail es) . AppE (VarE f) $ head es+  where+    loop as e = foldl AppE e as++-- | Fuzzily speaking, converts a given IO type into a MonadIO m one.+liftType :: Type -> Q Type+liftType = \case+  AppT _ t -> do+    m <- newName "m"+    return $+      ForallT+        [PlainTV m]+        [AppT (ConT ''MonadIO) $ VarT m]+        (AppT (VarT m) t)+  t -> return t
− src/SDL/TTF.hsc 
@@ -1,361 +0,0 @@--------------------------------------------------------------------------- |--- Module      :  SDL.TTF------ Introduction from SDL_ttf documentation at:--- <http://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf.html>------ 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 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 qualified SDL as SDL-import qualified SDL.Raw as Raw--import SDL.TTF.FFI (TTFFont)--import qualified SDL.TTF.FFI as FFI-import SDL.TTF.Types-import SDL.TTF.Internals--import Control.Monad.IO.Class-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 :: MonadIO m => m CInt-init = liftIO $ 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 :: MonadIO m => m Bool-wasInit = liftIO $ FFI.wasInit >>= return . (/=0)---- | 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 :: MonadIO m => m ()-quit = liftIO $ 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 :: MonadIO m => m a -> m 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 :: MonadIO m => String -- ^ File name to load font from.-         -> Int                 -- ^ Point size (based on 72DPI) to load font as.-         -> m TTFFont           -- ^ Pointer to the font as a TTF_Font. NULL is returned on errors.-openFont file ptsize = liftIO $ 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 :: MonadIO m => TTFFont -- ^ Font to be freed.-          -> m ()-closeFont fontPtr = liftIO $ 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 :: MonadIO m => 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.-              -> m TTFFont           -- ^ Pointer to the font as a TTF_Font.-openFontIndex file ptsize index = liftIO $ 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: <http://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf.html#SEC21>@-getFontStyle :: MonadIO m => TTFFont -- ^ Font-             -> m TTFStyle           -- ^ Current style bitmask of the font.-getFontStyle fontPtr = liftIO $ 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: <http://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf.html#SEC22>@-setFontStyle :: MonadIO m => TTFFont -- ^ Font-             -> TTFStyle             -- ^ The style as a bitmask-             -> m ()-setFontStyle fontPtr style = liftIO $ 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 :: MonadIO m => TTFFont -- ^ Font-               -> m TTFHinting         -- ^ The current hinting setting of the loaded font.-getFontHinting fontPtr = liftIO $ 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 :: MonadIO m => TTFFont -- ^ Font-               -> TTFHinting           -- ^ The hinting setting desired.-               -> m ()-setFontHinting fontPtr hinting = liftIO $ 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 :: MonadIO m => TTFFont -- ^ Font-              -> m Int                -- ^ Maximum pixel height of all glyphs in the font.-getFontHeight fontPtr = liftIO $ 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 :: MonadIO m => TTFFont -- ^ Font-              -> m Int                -- ^ Maximum pixel ascent of all glyphs in the font.-getFontAscent fontPtr = liftIO $ 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 :: MonadIO m => TTFFont -- ^ Font-               -> m Int                -- ^ Maximum pixel height of all glyphs in the font.-getFontDescent fontPtr = liftIO $ 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 :: MonadIO m => TTFFont -- ^ Font-                   -> m KerningStatus      -- ^ Current Kerning status.-fontKerningEnabled fontPtr = liftIO $ 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 :: MonadIO m => TTFFont -- ^ Font-               -> KerningStatus        -- ^ Desired Kerning status.-               -> m ()-setFontKerning fontPtr KerningOn  = liftIO $ FFI.setFontKerning fontPtr 1-setFontKerning fontPtr KerningOff = liftIO $ 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 :: MonadIO m => TTFFont -- ^ Font-          -> m Int64              -- ^ The number of faces in the font.-fontFaces fontPtr = liftIO $ 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 :: MonadIO m => TTFFont -- ^ Font-                     -> m FixedWidth         -- ^ If font is a fixed width font.-fontFaceIsFixedWidth fontPtr =-  liftIO $ FFI.fontFaceIsFixedWidth fontPtr >>= return . toFW-  where-    toFW 1 = IsFixedW-    toFW _ = NotFixedW---- | 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 :: MonadIO m => TTFFont -- ^ Font-                   -> m String             -- ^ The current family name of of the face of the font, or NULL perhaps.-fontFaceFamilyName fontPtr = liftIO $ 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 :: MonadIO m => TTFFont -- ^ Font-                  -> m String             -- ^ The current style name of of the face of the font, or NULL perhaps.-fontFaceStyleName fontPtr = liftIO $ 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 :: MonadIO m => TTFFont -- ^ Font-         -> String               -- ^ The LATIN1 null terminated string to size up.-         -> m (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 :: MonadIO m => TTFFont -- ^ Font-         -> String               -- ^ The UTF8 null terminated string to size up.-         -> m (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 :: MonadIO m => TTFFont -- ^ Font-            -> String               -- ^ The UNICODE null terminated string to size up.-            -> m (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 :: MonadIO m => TTFFont -- ^ Font-                -> String               -- ^ The LATIN1 null terminated string to render.-                -> Raw.Color            -- ^ The color to render the text in. Colormap index 1.-                -> m SDL.Surface        -- ^ The returned high level SDL.Surface-renderTextSolid fontPtr text fg = liftIO $ withCString text $ \cstr -> do-    --with fg $ \colorPtr -> FFI.renderTextSolid fontPtr cstr colorPtr-    with fg $ \colorPtr -> unmanagedSurface <$> 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 :: MonadIO m => TTFFont -- ^ Font-                 -> String               -- ^ The LATIN1 null terminated string to render.-                 -> Raw.Color            -- ^ The color to render the text in. Colormap index 1.-                 -> Raw.Color            -- ^ The color to render the background box in. Colormap index 0.-                 -> m SDL.Surface        -- ^ Pointer to a new SDL_SDL.Surface. NULL is returned on errors.-renderTextShaded fontPtr text fg bg = liftIO $ withCString text $ \cstr ->-    with fg $ \fgColorPtr ->-      with bg $ \bgColorPtr ->-        unmanagedSurface <$> 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 :: MonadIO m => TTFFont -- ^ Font-                  -> String               -- ^ The LATIN1 null terminated string to render.-                  -> Raw.Color            -- ^ The color to render the text in. Colormap index 1.-                  -> m SDL.Surface        -- ^ Pointer to a new SDL_SDL.Surface. NULL is returned on errors.-renderTextBlended fontPtr text color = liftIO $ withCString text $ \cstr ->-    with color $ \colorPtr -> unmanagedSurface <$> 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 :: MonadIO m => TTFFont -- ^ Font-                  -> String             -- ^ The UTF8 null terminated string to render.-                  -> Raw.Color          -- ^ The color to render the text in. Colormap index 1.-                  -> m SDL.Surface      -- ^ Pointer to a new SDL_SDL.Surface. NULL is returned on errors.-renderUTF8Solid fontPtr text fg = liftIO $ withCString text $ \cstr -> do-    with fg $ \colorPtr -> unmanagedSurface <$> 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 :: MonadIO m => TTFFont -- ^ Font-                 -> String               -- ^ The UTF8 null terminated string to render.-                 -> Raw.Color            -- ^ The color to render the text in. Colormap index 1.-                 -> Raw.Color            -- ^ The color to render the background box in. Colormap index 0.-                 -> m SDL.Surface        -- ^ Pointer to a new SDL_SDL.Surface. NULL is returned on errors.-renderUTF8Shaded fontPtr text fg bg = liftIO $ withCString text $ \cstr ->-    with fg $ \fgColorPtr ->-      with bg $ \bgColorPtr ->-        unmanagedSurface <$> 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 :: MonadIO m => TTFFont -- ^ Font-                  -> String               -- ^ The UTF8 null terminated string to render.-                  -> Raw.Color            -- ^ The color to render the text in. Colormap index 1.-                  -> m SDL.Surface        -- ^ Pointer to a new SDL_SDL.Surface. NULL is returned on errors.-renderUTF8Blended fontPtr text color = liftIO $ withCString text $ \cstr ->-    with color $ \colorPtr -> unmanagedSurface <$> FFI.renderUTF8Blended fontPtr cstr colorPtr
− src/SDL/TTF/FFI.hsc 
@@ -1,94 +0,0 @@-#include "SDL2/SDL_ttf.h"-module SDL.TTF.FFI where--import Foreign.C-import Foreign.Ptr--import qualified SDL.Raw.Types as SDL-import SDL.Raw.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)
− src/SDL/TTF/Internals.hsc 
@@ -1,33 +0,0 @@-module SDL.TTF.Internals where--import Foreign.C.String-import Foreign.C.Types (CInt)-import Foreign.Marshal.Alloc-import Foreign.Storable-import Foreign.Ptr-import Control.Monad-import Control.Monad.IO.Class--import qualified SDL as SDL-import qualified SDL.Raw as Raw--import qualified SDL.TTF.FFI as FFI--peekInts-  :: MonadIO m-  => (FFI.TTFFont -> CString -> Ptr CInt -> Ptr CInt -> IO CInt)-  -> FFI.TTFFont-  -> String-  -> m (Int,Int)-peekInts fn fontPtr text = liftIO $ 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)---- | Straight from the code of "sdl2" package, which is not exported. It will make a high level Surface from a Raw Surface. I will move this to somewhere safe, soon-unmanagedSurface :: Ptr Raw.Surface -> SDL.Surface-unmanagedSurface s = SDL.Surface s Nothing
− src/SDL/TTF/Types.hsc 
@@ -1,70 +0,0 @@-#include "SDL2/SDL_ttf.h"-{-# LANGUAGE EmptyDataDecls #-}-module SDL.TTF.Types where--data KerningStatus-  = KerningOn-  | KerningOff-  deriving (Show,Eq)--data FixedWidth-  = IsFixedW-  | NotFixedW-  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."