{-|

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
render 'Text' in various styles to an @SDL@ 'Surface'.

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
  , getKerningSize

  -- * Glyphs
  --
  -- | Functions that work with individual glyphs.
  , glyphProvided
  , glyphIndex
  , glyphMetrics
  , solidGlyph
  , shadedGlyph
  , blendedGlyph
  , blendedWrapped
  ) 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 :: m (a, a, a)
version = IO (a, a, a) -> m (a, a, a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, a, a) -> m (a, a, a)) -> IO (a, a, a) -> m (a, a, a)
forall a b. (a -> b) -> a -> b
$ do
  SDL.Raw.Version major :: Word8
major minor :: Word8
minor patch :: Word8
patch <- Ptr Version -> IO Version
forall a. Storable a => Ptr a -> IO a
peek (Ptr Version -> IO Version) -> IO (Ptr Version) -> IO Version
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Ptr Version)
forall (m :: * -> *). MonadIO m => m (Ptr Version)
SDL.Raw.Font.getVersion
  (a, a, a) -> IO (a, a, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
major, Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
minor, Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
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 :: m ()
initialize = do
  Bool
init'd <- (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1) (CInt -> Bool) -> m CInt -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` m CInt
forall (m :: * -> *). MonadIO m => m CInt
SDL.Raw.Font.wasInit
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
init'd (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Text -> Text -> m CInt -> m ()
forall (m :: * -> *) a.
(MonadIO m, Num a, Ord a) =>
Text -> Text -> m a -> m ()
throwIfNeg_ "SDL.Font.initialize" "TTF_Init" m CInt
forall (m :: * -> *). MonadIO m => m CInt
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 :: m ()
quit = m ()
forall (m :: * -> *). MonadIO m => m ()
SDL.Raw.Font.quit

-- | Represents a loaded font.
newtype Font = Font { Font -> Ptr Font
unwrap :: Ptr SDL.Raw.Font.Font }
  deriving (Font -> Font -> Bool
(Font -> Font -> Bool) -> (Font -> Font -> Bool) -> Eq Font
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Font -> Font -> Bool
$c/= :: Font -> Font -> Bool
== :: Font -> Font -> Bool
$c== :: Font -> Font -> Bool
Eq, Int -> Font -> ShowS
[Font] -> ShowS
Font -> String
(Int -> Font -> ShowS)
-> (Font -> String) -> ([Font] -> ShowS) -> Show Font
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Font] -> ShowS
$cshowList :: [Font] -> ShowS
show :: Font -> String
$cshow :: Font -> String
showsPrec :: Int -> Font -> ShowS
$cshowsPrec :: Int -> Font -> ShowS
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 :: String -> Int -> m Font
load path :: String
path pts :: Int
pts =
  (Ptr Font -> Font) -> m (Ptr Font) -> m Font
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Font -> Font
Font (m (Ptr Font) -> m Font)
-> ((CString -> IO (Ptr Font)) -> m (Ptr Font))
-> (CString -> IO (Ptr Font))
-> m Font
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Text -> Text -> m (Ptr Font) -> m (Ptr Font)
forall (m :: * -> *) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull "SDL.Font.load" "TTF_OpenFont" (m (Ptr Font) -> m (Ptr Font))
-> ((CString -> IO (Ptr Font)) -> m (Ptr Font))
-> (CString -> IO (Ptr Font))
-> m (Ptr Font)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      IO (Ptr Font) -> m (Ptr Font)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Font) -> m (Ptr Font))
-> ((CString -> IO (Ptr Font)) -> IO (Ptr Font))
-> (CString -> IO (Ptr Font))
-> m (Ptr Font)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (CString -> IO (Ptr Font)) -> IO (Ptr Font)
forall a. String -> (CString -> IO a) -> IO a
withCString String
path ((CString -> IO (Ptr Font)) -> m Font)
-> (CString -> IO (Ptr Font)) -> m Font
forall a b. (a -> b) -> a -> b
$
        (CString -> CInt -> IO (Ptr Font))
-> CInt -> CString -> IO (Ptr Font)
forall a b c. (a -> b -> c) -> b -> a -> c
flip CString -> CInt -> IO (Ptr Font)
forall (m :: * -> *). MonadIO m => CString -> CInt -> m (Ptr Font)
SDL.Raw.Font.openFont (CInt -> CString -> IO (Ptr Font))
-> CInt -> CString -> IO (Ptr Font)
forall a b. (a -> b) -> a -> b
$ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pts

-- | Same as 'load', but accepts a 'ByteString' containing a font instead.
decode :: MonadIO m => ByteString -> PointSize -> m Font
decode :: ByteString -> Int -> m Font
decode bytes :: ByteString
bytes pts :: Int
pts = IO Font -> m Font
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Font -> m Font)
-> ((CStringLen -> IO Font) -> IO Font)
-> (CStringLen -> IO Font)
-> m Font
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ByteString -> (CStringLen -> IO Font) -> IO Font
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bytes ((CStringLen -> IO Font) -> m Font)
-> (CStringLen -> IO Font) -> m Font
forall a b. (a -> b) -> a -> b
$ \(cstr :: CString
cstr, len :: Int
len) -> do
    Ptr RWops
rw <- Ptr () -> CInt -> IO (Ptr RWops)
forall (m :: * -> *). MonadIO m => Ptr () -> CInt -> m (Ptr RWops)
rwFromConstMem (CString -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr CString
cstr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
    (Ptr Font -> Font) -> IO (Ptr Font) -> IO Font
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Font -> Font
Font (IO (Ptr Font) -> IO Font)
-> (IO (Ptr Font) -> IO (Ptr Font)) -> IO (Ptr Font) -> IO Font
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Text -> Text -> IO (Ptr Font) -> IO (Ptr Font)
forall (m :: * -> *) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull "SDL.Font.decode" "TTF_OpenFontRW" (IO (Ptr Font) -> IO Font) -> IO (Ptr Font) -> IO Font
forall a b. (a -> b) -> a -> b
$
        Ptr RWops -> CInt -> CInt -> IO (Ptr Font)
forall (m :: * -> *).
MonadIO m =>
Ptr RWops -> CInt -> CInt -> m (Ptr Font)
SDL.Raw.Font.openFont_RW Ptr RWops
rw 0 (CInt -> IO (Ptr Font)) -> CInt -> IO (Ptr Font)
forall a b. (a -> b) -> a -> b
$ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
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 :: String -> Int -> Int -> m Font
loadIndex path :: String
path pts :: Int
pts i :: Int
i =
  (Ptr Font -> Font) -> m (Ptr Font) -> m Font
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Font -> Font
Font (m (Ptr Font) -> m Font)
-> ((CString -> IO (Ptr Font)) -> m (Ptr Font))
-> (CString -> IO (Ptr Font))
-> m Font
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Text -> Text -> m (Ptr Font) -> m (Ptr Font)
forall (m :: * -> *) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull "SDL.Font.loadIndex" "TTF_OpenFontIndex" (m (Ptr Font) -> m (Ptr Font))
-> ((CString -> IO (Ptr Font)) -> m (Ptr Font))
-> (CString -> IO (Ptr Font))
-> m (Ptr Font)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      IO (Ptr Font) -> m (Ptr Font)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Font) -> m (Ptr Font))
-> ((CString -> IO (Ptr Font)) -> IO (Ptr Font))
-> (CString -> IO (Ptr Font))
-> m (Ptr Font)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (CString -> IO (Ptr Font)) -> IO (Ptr Font)
forall a. String -> (CString -> IO a) -> IO a
withCString String
path ((CString -> IO (Ptr Font)) -> m Font)
-> (CString -> IO (Ptr Font)) -> m Font
forall a b. (a -> b) -> a -> b
$ \cpath :: CString
cpath ->
        CString -> CInt -> Index -> IO (Ptr Font)
forall (m :: * -> *).
MonadIO m =>
CString -> CInt -> Index -> m (Ptr Font)
SDL.Raw.Font.openFontIndex CString
cpath (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pts) (Int -> Index
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)

-- | Same as 'loadIndex', but accepts a 'ByteString' containing a font instead.
decodeIndex :: MonadIO m => ByteString -> PointSize -> Index -> m Font
decodeIndex :: ByteString -> Int -> Int -> m Font
decodeIndex bytes :: ByteString
bytes pts :: Int
pts i :: Int
i = IO Font -> m Font
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Font -> m Font)
-> ((CStringLen -> IO Font) -> IO Font)
-> (CStringLen -> IO Font)
-> m Font
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ByteString -> (CStringLen -> IO Font) -> IO Font
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bytes ((CStringLen -> IO Font) -> m Font)
-> (CStringLen -> IO Font) -> m Font
forall a b. (a -> b) -> a -> b
$ \(cstr :: CString
cstr, len :: Int
len) -> do
    Ptr RWops
rw <- Ptr () -> CInt -> IO (Ptr RWops)
forall (m :: * -> *). MonadIO m => Ptr () -> CInt -> m (Ptr RWops)
rwFromConstMem (CString -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr CString
cstr) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
    (Ptr Font -> Font) -> IO (Ptr Font) -> IO Font
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Font -> Font
Font (IO (Ptr Font) -> IO Font)
-> (IO (Ptr Font) -> IO (Ptr Font)) -> IO (Ptr Font) -> IO Font
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Text -> Text -> IO (Ptr Font) -> IO (Ptr Font)
forall (m :: * -> *) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull "SDL.Font.decodeIndex" "TTF_OpenFontIndexRW" (IO (Ptr Font) -> IO Font) -> IO (Ptr Font) -> IO Font
forall a b. (a -> b) -> a -> b
$
        Ptr RWops -> CInt -> CInt -> Index -> IO (Ptr Font)
forall (m :: * -> *).
MonadIO m =>
Ptr RWops -> CInt -> CInt -> Index -> m (Ptr Font)
SDL.Raw.Font.openFontIndex_RW Ptr RWops
rw 0 (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pts) (Int -> Index
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)

-- | Frees a loaded 'Font'.
free :: MonadIO m => Font -> m ()
free :: Font -> m ()
free = Ptr Font -> m ()
forall (m :: * -> *). MonadIO m => Ptr Font -> m ()
SDL.Raw.Font.closeFont (Ptr Font -> m ()) -> (Font -> Ptr Font) -> Font -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Ptr Font
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 :: Ptr Surface -> Surface
unmanaged p :: Ptr Surface
p = Ptr Surface -> Maybe (IOVector Word8) -> Surface
Surface Ptr Surface
p Maybe (IOVector Word8)
forall a. Maybe a
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 -> Color -> Text -> m Surface
solid (Font font :: Ptr Font
font) (V4 r :: Word8
r g :: Word8
g b :: Word8
b a :: Word8
a) text :: Text
text =
  (Ptr Surface -> Surface) -> m (Ptr Surface) -> m Surface
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Surface -> Surface
unmanaged (m (Ptr Surface) -> m Surface)
-> ((Ptr Word16 -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (Ptr Word16 -> IO (Ptr Surface))
-> m Surface
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Text -> Text -> m (Ptr Surface) -> m (Ptr Surface)
forall (m :: * -> *) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull "SDL.Font.solid" "TTF_RenderUNICODE_Solid" (m (Ptr Surface) -> m (Ptr Surface))
-> ((Ptr Word16 -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (Ptr Word16 -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      IO (Ptr Surface) -> m (Ptr Surface)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Surface) -> m (Ptr Surface))
-> ((Ptr Word16 -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (Ptr Word16 -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Ptr Word16 -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a. Text -> (Ptr Word16 -> IO a) -> IO a
withText Text
text ((Ptr Word16 -> IO (Ptr Surface)) -> m Surface)
-> (Ptr Word16 -> IO (Ptr Surface)) -> m Surface
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word16
ptr ->
        Color -> (Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Word8 -> Word8 -> Word8 -> Word8 -> Color
SDL.Raw.Color Word8
r Word8
g Word8
b Word8
a) ((Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. (a -> b) -> a -> b
$ \fg :: Ptr Color
fg ->
          Ptr Font -> Ptr CUShort -> Ptr Color -> IO (Ptr Surface)
forall (m :: * -> *).
MonadIO m =>
Ptr Font -> Ptr CUShort -> Ptr Color -> m (Ptr Surface)
SDL.Raw.Font.renderUNICODE_Solid Ptr Font
font (Ptr Word16 -> Ptr CUShort
forall a b. Ptr a -> Ptr b
castPtr Ptr Word16
ptr) Ptr Color
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 -> Color -> Color -> Text -> m Surface
shaded (Font font :: Ptr Font
font) (V4 r :: Word8
r g :: Word8
g b :: Word8
b a :: Word8
a) (V4 r2 :: Word8
r2 g2 :: Word8
g2 b2 :: Word8
b2 a2 :: Word8
a2) text :: Text
text =
  (Ptr Surface -> Surface) -> m (Ptr Surface) -> m Surface
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Surface -> Surface
unmanaged (m (Ptr Surface) -> m Surface)
-> ((Ptr Word16 -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (Ptr Word16 -> IO (Ptr Surface))
-> m Surface
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Text -> Text -> m (Ptr Surface) -> m (Ptr Surface)
forall (m :: * -> *) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull "SDL.Font.shaded" "TTF_RenderUNICODE_Shaded" (m (Ptr Surface) -> m (Ptr Surface))
-> ((Ptr Word16 -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (Ptr Word16 -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      IO (Ptr Surface) -> m (Ptr Surface)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Surface) -> m (Ptr Surface))
-> ((Ptr Word16 -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (Ptr Word16 -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Ptr Word16 -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a. Text -> (Ptr Word16 -> IO a) -> IO a
withText Text
text ((Ptr Word16 -> IO (Ptr Surface)) -> m Surface)
-> (Ptr Word16 -> IO (Ptr Surface)) -> m Surface
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word16
ptr ->
        Color -> (Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Word8 -> Word8 -> Word8 -> Word8 -> Color
SDL.Raw.Color Word8
r Word8
g Word8
b Word8
a) ((Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. (a -> b) -> a -> b
$ \fg :: Ptr Color
fg ->
          Color -> (Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Word8 -> Word8 -> Word8 -> Word8 -> Color
SDL.Raw.Color Word8
r2 Word8
g2 Word8
b2 Word8
a2) ((Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. (a -> b) -> a -> b
$ \bg :: Ptr Color
bg ->
            Ptr Font
-> Ptr CUShort -> Ptr Color -> Ptr Color -> IO (Ptr Surface)
forall (m :: * -> *).
MonadIO m =>
Ptr Font
-> Ptr CUShort -> Ptr Color -> Ptr Color -> m (Ptr Surface)
SDL.Raw.Font.renderUNICODE_Shaded Ptr Font
font (Ptr Word16 -> Ptr CUShort
forall a b. Ptr a -> Ptr b
castPtr Ptr Word16
ptr) Ptr Color
fg Ptr Color
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 -> Color -> Text -> m Surface
blended (Font font :: Ptr Font
font) (V4 r :: Word8
r g :: Word8
g b :: Word8
b a :: Word8
a) text :: Text
text =
  (Ptr Surface -> Surface) -> m (Ptr Surface) -> m Surface
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Surface -> Surface
unmanaged (m (Ptr Surface) -> m Surface)
-> ((Ptr Word16 -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (Ptr Word16 -> IO (Ptr Surface))
-> m Surface
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Text -> Text -> m (Ptr Surface) -> m (Ptr Surface)
forall (m :: * -> *) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull "SDL.Font.blended" "TTF_RenderUNICODE_Blended" (m (Ptr Surface) -> m (Ptr Surface))
-> ((Ptr Word16 -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (Ptr Word16 -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      IO (Ptr Surface) -> m (Ptr Surface)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Surface) -> m (Ptr Surface))
-> ((Ptr Word16 -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (Ptr Word16 -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Ptr Word16 -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a. Text -> (Ptr Word16 -> IO a) -> IO a
withText Text
text ((Ptr Word16 -> IO (Ptr Surface)) -> m Surface)
-> (Ptr Word16 -> IO (Ptr Surface)) -> m Surface
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word16
ptr ->
        Color -> (Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Word8 -> Word8 -> Word8 -> Word8 -> Color
SDL.Raw.Color Word8
r Word8
g Word8
b Word8
a) ((Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. (a -> b) -> a -> b
$ \fg :: Ptr Color
fg ->
          Ptr Font -> Ptr CUShort -> Ptr Color -> IO (Ptr Surface)
forall (m :: * -> *).
MonadIO m =>
Ptr Font -> Ptr CUShort -> Ptr Color -> m (Ptr Surface)
SDL.Raw.Font.renderUNICODE_Blended Ptr Font
font (Ptr Word16 -> Ptr CUShort
forall a b. Ptr a -> Ptr b
castPtr Ptr Word16
ptr) Ptr Color
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 -> (Ptr Word16 -> IO a) -> IO a
withText text :: Text
text act :: Ptr Word16 -> IO a
act =
  Int -> (Ptr Word16 -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
len ((Ptr Word16 -> IO a) -> IO a) -> (Ptr Word16 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word16
ptr -> do
    Text -> Ptr Word16 -> IO ()
unsafeCopyToPtr Text
text Ptr Word16
ptr
    Ptr Word16 -> Int -> CUShort -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word16
ptr (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) (0 :: CUShort)
    Ptr Word16 -> IO a
act Ptr Word16
ptr
  where
    len :: Int
len = 2Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Text -> Int
lengthWord16 Text
text Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)

-- Helper function for converting a bitmask into a list of values.
fromMaskWith :: (Enum a, Bounded a) => (a -> CInt) -> CInt -> [a]
fromMaskWith :: (a -> CInt) -> CInt -> [a]
fromMaskWith convert :: a -> CInt
convert cint :: CInt
cint = (a -> [a]) -> [a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a :: a
a -> (a, CInt) -> [a]
forall a. (a, CInt) -> [a]
find (a
a, a -> CInt
convert a
a)) [a
forall a. Bounded a => a
minBound..]
  where
    find :: (a, CInt) -> [a]
find (a :: a
a, i :: CInt
i) = [a
a | CInt
i CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
i CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
cint]

-- Helper function for converting a list of values into a bitmask.
toMaskWith :: (a -> CInt) -> [a] -> CInt
toMaskWith :: (a -> CInt) -> [a] -> CInt
toMaskWith convert :: a -> CInt
convert = (a -> CInt -> CInt) -> CInt -> [a] -> CInt
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
(.|.) (CInt -> CInt -> CInt) -> (a -> CInt) -> a -> CInt -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CInt
convert) 0

-- | Possible styles that can be applied to a 'Font'.
data Style
  = Bold
  | Italic
  | Underline
  | Strikethrough
  deriving (Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c== :: Style -> Style -> Bool
Eq, Int -> Style
Style -> Int
Style -> [Style]
Style -> Style
Style -> Style -> [Style]
Style -> Style -> Style -> [Style]
(Style -> Style)
-> (Style -> Style)
-> (Int -> Style)
-> (Style -> Int)
-> (Style -> [Style])
-> (Style -> Style -> [Style])
-> (Style -> Style -> [Style])
-> (Style -> Style -> Style -> [Style])
-> Enum Style
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Style -> Style -> Style -> [Style]
$cenumFromThenTo :: Style -> Style -> Style -> [Style]
enumFromTo :: Style -> Style -> [Style]
$cenumFromTo :: Style -> Style -> [Style]
enumFromThen :: Style -> Style -> [Style]
$cenumFromThen :: Style -> Style -> [Style]
enumFrom :: Style -> [Style]
$cenumFrom :: Style -> [Style]
fromEnum :: Style -> Int
$cfromEnum :: Style -> Int
toEnum :: Int -> Style
$ctoEnum :: Int -> Style
pred :: Style -> Style
$cpred :: Style -> Style
succ :: Style -> Style
$csucc :: Style -> Style
Enum, Eq Style
Eq Style =>
(Style -> Style -> Ordering)
-> (Style -> Style -> Bool)
-> (Style -> Style -> Bool)
-> (Style -> Style -> Bool)
-> (Style -> Style -> Bool)
-> (Style -> Style -> Style)
-> (Style -> Style -> Style)
-> Ord Style
Style -> Style -> Bool
Style -> Style -> Ordering
Style -> Style -> Style
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Style -> Style -> Style
$cmin :: Style -> Style -> Style
max :: Style -> Style -> Style
$cmax :: Style -> Style -> Style
>= :: Style -> Style -> Bool
$c>= :: Style -> Style -> Bool
> :: Style -> Style -> Bool
$c> :: Style -> Style -> Bool
<= :: Style -> Style -> Bool
$c<= :: Style -> Style -> Bool
< :: Style -> Style -> Bool
$c< :: Style -> Style -> Bool
compare :: Style -> Style -> Ordering
$ccompare :: Style -> Style -> Ordering
$cp1Ord :: Eq Style
Ord, Style
Style -> Style -> Bounded Style
forall a. a -> a -> Bounded a
maxBound :: Style
$cmaxBound :: Style
minBound :: Style
$cminBound :: Style
Bounded, (forall x. Style -> Rep Style x)
-> (forall x. Rep Style x -> Style) -> Generic Style
forall x. Rep Style x -> Style
forall x. Style -> Rep Style x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Style x -> Style
$cfrom :: forall x. Style -> Rep Style x
Generic, ReadPrec [Style]
ReadPrec Style
Int -> ReadS Style
ReadS [Style]
(Int -> ReadS Style)
-> ReadS [Style]
-> ReadPrec Style
-> ReadPrec [Style]
-> Read Style
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Style]
$creadListPrec :: ReadPrec [Style]
readPrec :: ReadPrec Style
$creadPrec :: ReadPrec Style
readList :: ReadS [Style]
$creadList :: ReadS [Style]
readsPrec :: Int -> ReadS Style
$creadsPrec :: Int -> ReadS Style
Read, Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
(Int -> Style -> ShowS)
-> (Style -> String) -> ([Style] -> ShowS) -> Show Style
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Style] -> ShowS
$cshowList :: [Style] -> ShowS
show :: Style -> String
$cshow :: Style -> String
showsPrec :: Int -> Style -> ShowS
$cshowsPrec :: Int -> Style -> ShowS
Show)

styleToCInt :: Style -> CInt
styleToCInt :: Style -> CInt
styleToCInt =
  \case
    Bold          -> CInt
forall a. (Eq a, Num a) => a
SDL.Raw.Font.TTF_STYLE_BOLD
    Italic        -> CInt
forall a. (Eq a, Num a) => a
SDL.Raw.Font.TTF_STYLE_ITALIC
    Underline     -> CInt
forall a. (Eq a, Num a) => a
SDL.Raw.Font.TTF_STYLE_UNDERLINE
    Strikethrough -> CInt
forall a. (Eq a, Num a) => a
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 :: Font -> m [Style]
getStyle = (CInt -> [Style]) -> m CInt -> m [Style]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Style -> CInt) -> CInt -> [Style]
forall a. (Enum a, Bounded a) => (a -> CInt) -> CInt -> [a]
fromMaskWith Style -> CInt
styleToCInt) (m CInt -> m [Style]) -> (Font -> m CInt) -> Font -> m [Style]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Font -> m CInt
forall (m :: * -> *). MonadIO m => Ptr Font -> m CInt
SDL.Raw.Font.getFontStyle (Ptr Font -> m CInt) -> (Font -> Ptr Font) -> Font -> m CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Ptr Font
unwrap

-- | Sets the rendering style of a 'Font'.
--
-- Use an empty list to reset the style.
setStyle :: MonadIO m => Font -> [Style] -> m ()
setStyle :: Font -> [Style] -> m ()
setStyle (Font font :: Ptr Font
font) = Ptr Font -> CInt -> m ()
forall (m :: * -> *). MonadIO m => Ptr Font -> CInt -> m ()
SDL.Raw.Font.setFontStyle Ptr Font
font (CInt -> m ()) -> ([Style] -> CInt) -> [Style] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> CInt) -> [Style] -> CInt
forall a. (a -> CInt) -> [a] -> CInt
toMaskWith Style -> CInt
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 :: Font -> m Int
getOutline = (CInt -> Int) -> m CInt -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (m CInt -> m Int) -> (Font -> m CInt) -> Font -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Font -> m CInt
forall (m :: * -> *). MonadIO m => Ptr Font -> m CInt
SDL.Raw.Font.getFontOutline (Ptr Font -> m CInt) -> (Font -> Ptr Font) -> Font -> m CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Ptr Font
unwrap

-- | Sets the outline size for a given 'Font'.
--
-- Use 0 to turn off outlining.
setOutline :: MonadIO m => Font -> Outline -> m ()
setOutline :: Font -> Int -> m ()
setOutline (Font font :: Ptr Font
font) = Ptr Font -> CInt -> m ()
forall (m :: * -> *). MonadIO m => Ptr Font -> CInt -> m ()
SDL.Raw.Font.setFontOutline Ptr Font
font (CInt -> m ()) -> (Int -> CInt) -> Int -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | The hinting setting of a 'Font'.
data Hinting
  = Normal
  | Light
  | Mono
  | None
  deriving (Hinting -> Hinting -> Bool
(Hinting -> Hinting -> Bool)
-> (Hinting -> Hinting -> Bool) -> Eq Hinting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hinting -> Hinting -> Bool
$c/= :: Hinting -> Hinting -> Bool
== :: Hinting -> Hinting -> Bool
$c== :: Hinting -> Hinting -> Bool
Eq, Int -> Hinting
Hinting -> Int
Hinting -> [Hinting]
Hinting -> Hinting
Hinting -> Hinting -> [Hinting]
Hinting -> Hinting -> Hinting -> [Hinting]
(Hinting -> Hinting)
-> (Hinting -> Hinting)
-> (Int -> Hinting)
-> (Hinting -> Int)
-> (Hinting -> [Hinting])
-> (Hinting -> Hinting -> [Hinting])
-> (Hinting -> Hinting -> [Hinting])
-> (Hinting -> Hinting -> Hinting -> [Hinting])
-> Enum Hinting
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Hinting -> Hinting -> Hinting -> [Hinting]
$cenumFromThenTo :: Hinting -> Hinting -> Hinting -> [Hinting]
enumFromTo :: Hinting -> Hinting -> [Hinting]
$cenumFromTo :: Hinting -> Hinting -> [Hinting]
enumFromThen :: Hinting -> Hinting -> [Hinting]
$cenumFromThen :: Hinting -> Hinting -> [Hinting]
enumFrom :: Hinting -> [Hinting]
$cenumFrom :: Hinting -> [Hinting]
fromEnum :: Hinting -> Int
$cfromEnum :: Hinting -> Int
toEnum :: Int -> Hinting
$ctoEnum :: Int -> Hinting
pred :: Hinting -> Hinting
$cpred :: Hinting -> Hinting
succ :: Hinting -> Hinting
$csucc :: Hinting -> Hinting
Enum, Eq Hinting
Eq Hinting =>
(Hinting -> Hinting -> Ordering)
-> (Hinting -> Hinting -> Bool)
-> (Hinting -> Hinting -> Bool)
-> (Hinting -> Hinting -> Bool)
-> (Hinting -> Hinting -> Bool)
-> (Hinting -> Hinting -> Hinting)
-> (Hinting -> Hinting -> Hinting)
-> Ord Hinting
Hinting -> Hinting -> Bool
Hinting -> Hinting -> Ordering
Hinting -> Hinting -> Hinting
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Hinting -> Hinting -> Hinting
$cmin :: Hinting -> Hinting -> Hinting
max :: Hinting -> Hinting -> Hinting
$cmax :: Hinting -> Hinting -> Hinting
>= :: Hinting -> Hinting -> Bool
$c>= :: Hinting -> Hinting -> Bool
> :: Hinting -> Hinting -> Bool
$c> :: Hinting -> Hinting -> Bool
<= :: Hinting -> Hinting -> Bool
$c<= :: Hinting -> Hinting -> Bool
< :: Hinting -> Hinting -> Bool
$c< :: Hinting -> Hinting -> Bool
compare :: Hinting -> Hinting -> Ordering
$ccompare :: Hinting -> Hinting -> Ordering
$cp1Ord :: Eq Hinting
Ord, Hinting
Hinting -> Hinting -> Bounded Hinting
forall a. a -> a -> Bounded a
maxBound :: Hinting
$cmaxBound :: Hinting
minBound :: Hinting
$cminBound :: Hinting
Bounded, (forall x. Hinting -> Rep Hinting x)
-> (forall x. Rep Hinting x -> Hinting) -> Generic Hinting
forall x. Rep Hinting x -> Hinting
forall x. Hinting -> Rep Hinting x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Hinting x -> Hinting
$cfrom :: forall x. Hinting -> Rep Hinting x
Generic, ReadPrec [Hinting]
ReadPrec Hinting
Int -> ReadS Hinting
ReadS [Hinting]
(Int -> ReadS Hinting)
-> ReadS [Hinting]
-> ReadPrec Hinting
-> ReadPrec [Hinting]
-> Read Hinting
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Hinting]
$creadListPrec :: ReadPrec [Hinting]
readPrec :: ReadPrec Hinting
$creadPrec :: ReadPrec Hinting
readList :: ReadS [Hinting]
$creadList :: ReadS [Hinting]
readsPrec :: Int -> ReadS Hinting
$creadsPrec :: Int -> ReadS Hinting
Read, Int -> Hinting -> ShowS
[Hinting] -> ShowS
Hinting -> String
(Int -> Hinting -> ShowS)
-> (Hinting -> String) -> ([Hinting] -> ShowS) -> Show Hinting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hinting] -> ShowS
$cshowList :: [Hinting] -> ShowS
show :: Hinting -> String
$cshow :: Hinting -> String
showsPrec :: Int -> Hinting -> ShowS
$cshowsPrec :: Int -> Hinting -> ShowS
Show)

hintingToCInt :: Hinting -> CInt
hintingToCInt :: Hinting -> CInt
hintingToCInt =
  \case
    Normal -> CInt
forall a. (Eq a, Num a) => a
SDL.Raw.Font.TTF_HINTING_NORMAL
    Light  -> CInt
forall a. (Eq a, Num a) => a
SDL.Raw.Font.TTF_HINTING_LIGHT
    Mono   -> CInt
forall a. (Eq a, Num a) => a
SDL.Raw.Font.TTF_HINTING_MONO
    None   -> CInt
forall a. (Eq a, Num a) => a
SDL.Raw.Font.TTF_HINTING_NONE

cIntToHinting :: CInt -> Hinting
cIntToHinting :: CInt -> Hinting
cIntToHinting =
  \case
    SDL.Raw.Font.TTF_HINTING_NORMAL -> Hinting
Normal
    SDL.Raw.Font.TTF_HINTING_LIGHT  -> Hinting
Light
    SDL.Raw.Font.TTF_HINTING_MONO   -> Hinting
Mono
    SDL.Raw.Font.TTF_HINTING_NONE   -> Hinting
None
    _ -> String -> Hinting
forall a. HasCallStack => String -> a
error "SDL.Font.cIntToHinting received unknown TTF_HINTING."

-- | Gets the hinting setting of a given 'Font'.
getHinting :: MonadIO m => Font -> m Hinting
getHinting :: Font -> m Hinting
getHinting = (CInt -> Hinting) -> m CInt -> m Hinting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Hinting
cIntToHinting (m CInt -> m Hinting) -> (Font -> m CInt) -> Font -> m Hinting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Font -> m CInt
forall (m :: * -> *). MonadIO m => Ptr Font -> m CInt
SDL.Raw.Font.getFontHinting (Ptr Font -> m CInt) -> (Font -> Ptr Font) -> Font -> m CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Ptr Font
unwrap

-- | Sets the hinting setting of a font.
setHinting :: MonadIO m => Font -> Hinting -> m ()
setHinting :: Font -> Hinting -> m ()
setHinting (Font font :: Ptr Font
font) = Ptr Font -> CInt -> m ()
forall (m :: * -> *). MonadIO m => Ptr Font -> CInt -> m ()
SDL.Raw.Font.setFontHinting Ptr Font
font (CInt -> m ()) -> (Hinting -> CInt) -> Hinting -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hinting -> CInt
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 :: Font -> m Bool
getKerning = (CInt -> Bool) -> m CInt -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (m CInt -> m Bool) -> (Font -> m CInt) -> Font -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Font -> m CInt
forall (m :: * -> *). MonadIO m => Ptr Font -> m CInt
SDL.Raw.Font.getFontKerning (Ptr Font -> m CInt) -> (Font -> Ptr Font) -> Font -> m CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Ptr Font
unwrap

-- | Sets the kerning setting for a given 'Font'.
--
-- Use 'False' to turn off kerning.
setKerning :: MonadIO m => Font -> Kerning -> m ()
setKerning :: Font -> Bool -> m ()
setKerning (Font font :: Ptr Font
font) = Ptr Font -> CInt -> m ()
forall (m :: * -> *). MonadIO m => Ptr Font -> CInt -> m ()
SDL.Raw.Font.setFontKerning Ptr Font
font (CInt -> m ()) -> (Bool -> CInt) -> Bool -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> CInt
forall a. Num a => Bool -> a
fromBool

-- | Gets the maximum pixel height of all glyphs of a given 'Font'.
height :: MonadIO m => Font -> m Int
height :: Font -> m Int
height = (CInt -> Int) -> m CInt -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (m CInt -> m Int) -> (Font -> m CInt) -> Font -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Font -> m CInt
forall (m :: * -> *). MonadIO m => Ptr Font -> m CInt
SDL.Raw.Font.fontHeight (Ptr Font -> m CInt) -> (Font -> Ptr Font) -> Font -> m CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Ptr Font
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 :: Font -> m Int
ascent = (CInt -> Int) -> m CInt -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (m CInt -> m Int) -> (Font -> m CInt) -> Font -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Font -> m CInt
forall (m :: * -> *). MonadIO m => Ptr Font -> m CInt
SDL.Raw.Font.fontAscent (Ptr Font -> m CInt) -> (Font -> Ptr Font) -> Font -> m CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Ptr Font
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 :: Font -> m Int
descent = (CInt -> Int) -> m CInt -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (m CInt -> m Int) -> (Font -> m CInt) -> Font -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Font -> m CInt
forall (m :: * -> *). MonadIO m => Ptr Font -> m CInt
SDL.Raw.Font.fontDescent (Ptr Font -> m CInt) -> (Font -> Ptr Font) -> Font -> m CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Ptr Font
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 :: Font -> m Int
lineSkip = (CInt -> Int) -> m CInt -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (m CInt -> m Int) -> (Font -> m CInt) -> Font -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Font -> m CInt
forall (m :: * -> *). MonadIO m => Ptr Font -> m CInt
SDL.Raw.Font.fontLineSkip (Ptr Font -> m CInt) -> (Font -> Ptr Font) -> Font -> m CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Ptr Font
unwrap

-- | Tests whether the current face of a 'Font' is a fixed width font or not.
isMonospace :: MonadIO m => Font -> m Bool
isMonospace :: Font -> m Bool
isMonospace = (CInt -> Bool) -> m CInt -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (m CInt -> m Bool) -> (Font -> m CInt) -> Font -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Font -> m CInt
forall (m :: * -> *). MonadIO m => Ptr Font -> m CInt
SDL.Raw.Font.fontFaceIsFixedWidth (Ptr Font -> m CInt) -> (Font -> Ptr Font) -> Font -> m CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Ptr Font
unwrap

cStringToText :: MonadIO m => CString -> m Text
cStringToText :: CString -> m Text
cStringToText = (ByteString -> Text) -> m ByteString -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeUtf8 (m ByteString -> m Text)
-> (CString -> m ByteString) -> CString -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString)
-> (CString -> IO ByteString) -> CString -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> IO ByteString
unsafePackCString

onlyIfM :: Monad m => Bool -> m a -> m (Maybe a)
onlyIfM :: Bool -> m a -> m (Maybe a)
onlyIfM = \case
  False -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> (m a -> Maybe a) -> m a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> m a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing
  True  -> (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just

-- | Gets the current font face family name, if any.
familyName :: MonadIO m => Font -> m (Maybe Text)
familyName :: Font -> m (Maybe Text)
familyName (Font font :: Ptr Font
font) = do
  CString
cstr <- Ptr Font -> m CString
forall (m :: * -> *). MonadIO m => Ptr Font -> m CString
SDL.Raw.Font.fontFaceFamilyName Ptr Font
font
  Bool -> m Text -> m (Maybe Text)
forall (m :: * -> *) a. Monad m => Bool -> m a -> m (Maybe a)
onlyIfM (CString
cstr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr) (m Text -> m (Maybe Text)) -> m Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ CString -> m Text
forall (m :: * -> *). MonadIO m => CString -> m Text
cStringToText CString
cstr

-- | Gets the current font face style name, if any.
styleName :: MonadIO m => Font -> m (Maybe Text)
styleName :: Font -> m (Maybe Text)
styleName (Font font :: Ptr Font
font) = do
  CString
cstr <- Ptr Font -> m CString
forall (m :: * -> *). MonadIO m => Ptr Font -> m CString
SDL.Raw.Font.fontFaceStyleName Ptr Font
font
  Bool -> m Text -> m (Maybe Text)
forall (m :: * -> *) a. Monad m => Bool -> m a -> m (Maybe a)
onlyIfM (CString
cstr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr) (m Text -> m (Maybe Text)) -> m Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ CString -> m Text
forall (m :: * -> *). MonadIO m => CString -> m Text
cStringToText CString
cstr

-- | Does a 'Font' provide a certain unicode character?
glyphProvided :: MonadIO m => Font -> Char -> m Bool
glyphProvided :: Font -> Char -> m Bool
glyphProvided font :: Font
font ch :: Char
ch =
  Font -> Char -> m (Maybe Int)
forall (m :: * -> *). MonadIO m => Font -> Char -> m (Maybe Int)
glyphIndex Font
font Char
ch m (Maybe Int) -> (Maybe Int -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just  _ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Nothing -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

{-# INLINE fromChar #-}
fromChar :: Integral a => Char -> a
fromChar :: Char -> a
fromChar = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> (Char -> Int) -> Char -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
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 -> Char -> m (Maybe Int)
glyphIndex (Font font :: Ptr Font
font) ch :: Char
ch =
  Ptr Font -> CUShort -> m CInt
forall (m :: * -> *). MonadIO m => Ptr Font -> CUShort -> m CInt
SDL.Raw.Font.glyphIsProvided Ptr Font
font (Char -> CUShort
forall a. Integral a => Char -> a
fromChar Char
ch)
    m CInt -> (CInt -> m (Maybe Int)) -> m (Maybe Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      0 -> Maybe Int -> m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
      i :: CInt
i -> Maybe Int -> m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> m (Maybe Int))
-> (Int -> Maybe Int) -> Int -> m (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> m (Maybe Int)) -> Int -> m (Maybe Int)
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
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 -> Char -> m (Maybe (Int, Int, Int, Int, Int))
glyphMetrics (Font font :: Ptr Font
font) ch :: Char
ch =
  IO (Maybe (Int, Int, Int, Int, Int))
-> m (Maybe (Int, Int, Int, Int, Int))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Int, Int, Int, Int, Int))
 -> m (Maybe (Int, Int, Int, Int, Int)))
-> ((Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
    -> IO (Maybe (Int, Int, Int, Int, Int)))
-> (Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
-> m (Maybe (Int, Int, Int, Int, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
-> IO (Maybe (Int, Int, Int, Int, Int))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
 -> m (Maybe (Int, Int, Int, Int, Int)))
-> (Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
-> m (Maybe (Int, Int, Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ \minx :: Ptr CInt
minx ->
      (Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
-> IO (Maybe (Int, Int, Int, Int, Int))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
 -> IO (Maybe (Int, Int, Int, Int, Int)))
-> (Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
-> IO (Maybe (Int, Int, Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ \maxx :: Ptr CInt
maxx ->
        (Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
-> IO (Maybe (Int, Int, Int, Int, Int))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
 -> IO (Maybe (Int, Int, Int, Int, Int)))
-> (Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
-> IO (Maybe (Int, Int, Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ \miny :: Ptr CInt
miny ->
          (Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
-> IO (Maybe (Int, Int, Int, Int, Int))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
 -> IO (Maybe (Int, Int, Int, Int, Int)))
-> (Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
-> IO (Maybe (Int, Int, Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ \maxy :: Ptr CInt
maxy ->
            (Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
-> IO (Maybe (Int, Int, Int, Int, Int))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
 -> IO (Maybe (Int, Int, Int, Int, Int)))
-> (Ptr CInt -> IO (Maybe (Int, Int, Int, Int, Int)))
-> IO (Maybe (Int, Int, Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ \advn :: Ptr CInt
advn -> do
              let chi :: CUShort
chi = Char -> CUShort
forall a. Integral a => Char -> a
fromChar Char
ch
              CInt
r <- Ptr Font
-> CUShort
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> IO CInt
forall (m :: * -> *).
MonadIO m =>
Ptr Font
-> CUShort
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> m CInt
SDL.Raw.Font.glyphMetrics Ptr Font
font CUShort
chi Ptr CInt
minx Ptr CInt
maxx Ptr CInt
miny Ptr CInt
maxy Ptr CInt
advn
              if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 then
                Maybe (Int, Int, Int, Int, Int)
-> IO (Maybe (Int, Int, Int, Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Int, Int, Int, Int)
forall a. Maybe a
Nothing
              else do
                Int
a <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
minx
                Int
b <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
maxx
                Int
c <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
miny
                Int
d <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
maxy
                Int
e <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
advn
                Maybe (Int, Int, Int, Int, Int)
-> IO (Maybe (Int, Int, Int, Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, Int, Int, Int, Int)
 -> IO (Maybe (Int, Int, Int, Int, Int)))
-> Maybe (Int, Int, Int, Int, Int)
-> IO (Maybe (Int, Int, Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ (Int, Int, Int, Int, Int) -> Maybe (Int, Int, Int, Int, Int)
forall a. a -> Maybe a
Just (Int
a, Int
b, Int
c, Int
d, Int
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 -> Text -> m (Int, Int)
size (Font font :: Ptr Font
font) text :: Text
text =
    IO (Int, Int) -> m (Int, Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, Int) -> m (Int, Int))
-> ((Ptr Word16 -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr Word16 -> IO (Int, Int))
-> m (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Text -> (Ptr Word16 -> IO (Int, Int)) -> IO (Int, Int)
forall a. Text -> (Ptr Word16 -> IO a) -> IO a
withText Text
text ((Ptr Word16 -> IO (Int, Int)) -> m (Int, Int))
-> (Ptr Word16 -> IO (Int, Int)) -> m (Int, Int)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word16
ptr ->
        (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \w :: Ptr CInt
w ->
          (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \h :: Ptr CInt
h ->
            Ptr Font -> Ptr CUShort -> Ptr CInt -> Ptr CInt -> IO CInt
forall (m :: * -> *).
MonadIO m =>
Ptr Font -> Ptr CUShort -> Ptr CInt -> Ptr CInt -> m CInt
SDL.Raw.Font.sizeUNICODE Ptr Font
font (Ptr Word16 -> Ptr CUShort
forall a b. Ptr a -> Ptr b
castPtr Ptr Word16
ptr) Ptr CInt
w Ptr CInt
h
              IO CInt -> (CInt -> IO (Int, Int)) -> IO (Int, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                0 -> do
                  Int
w' <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
w
                  Int
h' <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
h
                  (Int, Int) -> IO (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
w', Int
h')
                _ -> do
                  Text
err <- IO Text
forall (m :: * -> *). MonadIO m => m Text
getError
                  SDLException -> IO (Int, Int)
forall e a. Exception e => e -> IO a
throwIO (SDLException -> IO (Int, Int)) -> SDLException -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> SDLException
SDLCallFailed "SDL.Font.size" "TTF_SizeUNICODE" Text
err

-- | Same as 'solid', but renders a single glyph instead.
solidGlyph :: MonadIO m => Font -> Color -> Char -> m SDL.Surface
solidGlyph :: Font -> Color -> Char -> m Surface
solidGlyph (Font font :: Ptr Font
font) (V4 r :: Word8
r g :: Word8
g b :: Word8
b a :: Word8
a) ch :: Char
ch =
  (Ptr Surface -> Surface) -> m (Ptr Surface) -> m Surface
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Surface -> Surface
unmanaged (m (Ptr Surface) -> m Surface)
-> ((Ptr Color -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (Ptr Color -> IO (Ptr Surface))
-> m Surface
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Text -> Text -> m (Ptr Surface) -> m (Ptr Surface)
forall (m :: * -> *) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull "SDL.Font.solidGlyph" "TTF_RenderGlyph_Solid" (m (Ptr Surface) -> m (Ptr Surface))
-> ((Ptr Color -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (Ptr Color -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      IO (Ptr Surface) -> m (Ptr Surface)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Surface) -> m (Ptr Surface))
-> ((Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (Ptr Color -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Color -> (Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Word8 -> Word8 -> Word8 -> Word8 -> Color
SDL.Raw.Color Word8
r Word8
g Word8
b Word8
a) ((Ptr Color -> IO (Ptr Surface)) -> m Surface)
-> (Ptr Color -> IO (Ptr Surface)) -> m Surface
forall a b. (a -> b) -> a -> b
$ \fg :: Ptr Color
fg ->
          Ptr Font -> CUShort -> Ptr Color -> IO (Ptr Surface)
forall (m :: * -> *).
MonadIO m =>
Ptr Font -> CUShort -> Ptr Color -> m (Ptr Surface)
SDL.Raw.Font.renderGlyph_Solid Ptr Font
font (Char -> CUShort
forall a. Integral a => Char -> a
fromChar Char
ch) Ptr Color
fg

-- | Same as 'shaded', but renders a single glyph instead.
shadedGlyph :: MonadIO m => Font -> Color -> Color -> Char -> m SDL.Surface
shadedGlyph :: Font -> Color -> Color -> Char -> m Surface
shadedGlyph (Font font :: Ptr Font
font) (V4 r :: Word8
r g :: Word8
g b :: Word8
b a :: Word8
a) (V4 r2 :: Word8
r2 g2 :: Word8
g2 b2 :: Word8
b2 a2 :: Word8
a2) ch :: Char
ch =
  (Ptr Surface -> Surface) -> m (Ptr Surface) -> m Surface
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Surface -> Surface
unmanaged (m (Ptr Surface) -> m Surface)
-> ((Ptr Color -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (Ptr Color -> IO (Ptr Surface))
-> m Surface
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Text -> Text -> m (Ptr Surface) -> m (Ptr Surface)
forall (m :: * -> *) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull "SDL.Font.shadedGlyph" "TTF_RenderGlyph_Solid" (m (Ptr Surface) -> m (Ptr Surface))
-> ((Ptr Color -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (Ptr Color -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      IO (Ptr Surface) -> m (Ptr Surface)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Surface) -> m (Ptr Surface))
-> ((Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (Ptr Color -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Color -> (Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Word8 -> Word8 -> Word8 -> Word8 -> Color
SDL.Raw.Color Word8
r Word8
g Word8
b Word8
a) ((Ptr Color -> IO (Ptr Surface)) -> m Surface)
-> (Ptr Color -> IO (Ptr Surface)) -> m Surface
forall a b. (a -> b) -> a -> b
$ \fg :: Ptr Color
fg ->
          Color -> (Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Word8 -> Word8 -> Word8 -> Word8 -> Color
SDL.Raw.Color Word8
r2 Word8
g2 Word8
b2 Word8
a2) ((Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. (a -> b) -> a -> b
$ \bg :: Ptr Color
bg ->
            Ptr Font -> CUShort -> Ptr Color -> Ptr Color -> IO (Ptr Surface)
forall (m :: * -> *).
MonadIO m =>
Ptr Font -> CUShort -> Ptr Color -> Ptr Color -> m (Ptr Surface)
SDL.Raw.Font.renderGlyph_Shaded Ptr Font
font (Char -> CUShort
forall a. Integral a => Char -> a
fromChar Char
ch) Ptr Color
fg Ptr Color
bg

-- | Same as 'blended', but renders a single glyph instead.
blendedGlyph :: MonadIO m => Font -> Color -> Char -> m SDL.Surface
blendedGlyph :: Font -> Color -> Char -> m Surface
blendedGlyph (Font font :: Ptr Font
font) (V4 r :: Word8
r g :: Word8
g b :: Word8
b a :: Word8
a) ch :: Char
ch =
  (Ptr Surface -> Surface) -> m (Ptr Surface) -> m Surface
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Surface -> Surface
unmanaged (m (Ptr Surface) -> m Surface)
-> ((Ptr Color -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (Ptr Color -> IO (Ptr Surface))
-> m Surface
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Text -> Text -> m (Ptr Surface) -> m (Ptr Surface)
forall (m :: * -> *) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull "SDL.Font.blendedGlyph" "TTF_RenderGlyph_Blended" (m (Ptr Surface) -> m (Ptr Surface))
-> ((Ptr Color -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (Ptr Color -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      IO (Ptr Surface) -> m (Ptr Surface)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Surface) -> m (Ptr Surface))
-> ((Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (Ptr Color -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Color -> (Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Word8 -> Word8 -> Word8 -> Word8 -> Color
SDL.Raw.Color Word8
r Word8
g Word8
b Word8
a) ((Ptr Color -> IO (Ptr Surface)) -> m Surface)
-> (Ptr Color -> IO (Ptr Surface)) -> m Surface
forall a b. (a -> b) -> a -> b
$ \fg :: Ptr Color
fg ->
          Ptr Font -> CUShort -> Ptr Color -> IO (Ptr Surface)
forall (m :: * -> *).
MonadIO m =>
Ptr Font -> CUShort -> Ptr Color -> m (Ptr Surface)
SDL.Raw.Font.renderGlyph_Blended Ptr Font
font (Char -> CUShort
forall a. Integral a => Char -> a
fromChar Char
ch) Ptr Color
fg

-- | Same as 'blended', but renders across multiple lines. 
--   Text is wrapped to multiple lines on line endings and on word boundaries
--   if it extends beyond wrapLength in pixels.
blendedWrapped :: MonadIO m => Font -> Color -> Int -> Text -> m SDL.Surface
blendedWrapped :: Font -> Color -> Int -> Text -> m Surface
blendedWrapped (Font font :: Ptr Font
font) (V4 r :: Word8
r g :: Word8
g b :: Word8
b a :: Word8
a) wrapLength :: Int
wrapLength text :: Text
text =
  (Ptr Surface -> Surface) -> m (Ptr Surface) -> m Surface
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Surface -> Surface
unmanaged (m (Ptr Surface) -> m Surface)
-> ((Ptr Word16 -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (Ptr Word16 -> IO (Ptr Surface))
-> m Surface
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Text -> Text -> m (Ptr Surface) -> m (Ptr Surface)
forall (m :: * -> *) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull "SDL.Font.blended" "TTF_RenderUNICODE_Blended_Wrapped" (m (Ptr Surface) -> m (Ptr Surface))
-> ((Ptr Word16 -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (Ptr Word16 -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      IO (Ptr Surface) -> m (Ptr Surface)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Surface) -> m (Ptr Surface))
-> ((Ptr Word16 -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (Ptr Word16 -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Ptr Word16 -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a. Text -> (Ptr Word16 -> IO a) -> IO a
withText Text
text ((Ptr Word16 -> IO (Ptr Surface)) -> m Surface)
-> (Ptr Word16 -> IO (Ptr Surface)) -> m Surface
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word16
ptr ->
        Color -> (Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Word8 -> Word8 -> Word8 -> Word8 -> Color
SDL.Raw.Color Word8
r Word8
g Word8
b Word8
a) ((Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (Ptr Color -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. (a -> b) -> a -> b
$ \fg :: Ptr Color
fg ->
          Ptr Font -> Ptr CUShort -> Ptr Color -> CUInt -> IO (Ptr Surface)
forall (m :: * -> *).
MonadIO m =>
Ptr Font -> Ptr CUShort -> Ptr Color -> CUInt -> m (Ptr Surface)
SDL.Raw.Font.renderUNICODE_Blended_Wrapped Ptr Font
font (Ptr Word16 -> Ptr CUShort
forall a b. Ptr a -> Ptr b
castPtr Ptr Word16
ptr) Ptr Color
fg (CUInt -> IO (Ptr Surface)) -> CUInt -> IO (Ptr Surface)
forall a b. (a -> b) -> a -> b
$ Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wrapLength

-- | From a given 'Font' get the kerning size of two glyphs.
getKerningSize :: MonadIO m => Font -> Index -> Index -> m Int
getKerningSize :: Font -> Int -> Int -> m Int
getKerningSize (Font font :: Ptr Font
font) prevIndex :: Int
prevIndex index :: Int
index =
  (CInt -> Int) -> m CInt -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (m CInt -> m Int) -> m CInt -> m Int
forall a b. (a -> b) -> a -> b
$ Ptr Font -> CInt -> CInt -> m CInt
forall (m :: * -> *).
MonadIO m =>
Ptr Font -> CInt -> CInt -> m CInt
SDL.Raw.Font.getFontKerningSize Ptr Font
font (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
prevIndex) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index)