{-|

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 CPP, DeriveGeneric, LambdaCase, 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 (unsafePackCString, unsafeUseAsCStringLen)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import Data.Word (Word8)
import Foreign.C.String (CString)
import Foreign.C.Types (CInt)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Utils (fromBool, toBool, with)
import Foreign.Ptr (Ptr, castPtr, nullPtr)
import Foreign.Storable (peek)
import GHC.Generics (Generic)
import SDL (SDLException (SDLCallFailed), Surface (..))
import SDL.Internal.Exception
import SDL.Raw.Filesystem (rwFromConstMem)
import SDL.Vect (V4 (..))

import qualified Foreign.C.String
import qualified SDL.Raw
import qualified SDL.Raw.Font

-- stolen from https://github.com/haskell-game/dear-imgui.hs/blob/main/src/DearImGui/Internal/Text.hs
#if MIN_VERSION_text(2,0,1)

import qualified Data.Text.Foreign

withCString :: Text -> (CString -> IO a) -> IO a
withCString = Data.Text.Foreign.withCString

#else

import qualified Data.Text
import qualified GHC.Foreign
import qualified System.IO

withCString :: Text -> (CString -> IO a) -> IO a
withCString :: Text -> (CString -> IO a) -> IO a
withCString Text
t CString -> IO a
action = do
  TextEncoding -> String -> (CString -> IO a) -> IO a
forall a. TextEncoding -> String -> (CString -> IO a) -> IO a
GHC.Foreign.withCString TextEncoding
System.IO.utf8 (Text -> String
Data.Text.unpack Text
t) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
textPtr ->
    CString -> IO a
action CString
textPtr

#endif

-- | 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 Word8
major Word8
minor 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
== CInt
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_ Text
"SDL.Font.initialize" Text
"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 String
path 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 Text
"SDL.Font.load" Text
"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
Foreign.C.String.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 ByteString
bytes 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
$ \(CString
cstr, 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 Text
"SDL.Font.decode" Text
"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 CInt
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 String
path Int
pts 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 Text
"SDL.Font.loadIndex" Text
"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
Foreign.C.String.withCString String
path ((CString -> IO (Ptr Font)) -> m Font)
-> (CString -> IO (Ptr Font)) -> m Font
forall a b. (a -> b) -> a -> b
$ \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 ByteString
bytes Int
pts 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
$ \(CString
cstr, 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 Text
"SDL.Font.decodeIndex" Text
"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 CInt
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 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 Ptr Font
font) (V4 Word8
r Word8
g Word8
b Word8
a) 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)
-> ((CString -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (CString -> 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 Text
"SDL.Font.solid" Text
"TTF_RenderUTF8_Solid" (m (Ptr Surface) -> m (Ptr Surface))
-> ((CString -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (CString -> 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))
-> ((CString -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (CString -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (CString -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a. Text -> (CString -> IO a) -> IO a
withCString Text
text ((CString -> IO (Ptr Surface)) -> m Surface)
-> (CString -> IO (Ptr Surface)) -> m Surface
forall a b. (a -> b) -> a -> b
$ \CString
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
$ \Ptr Color
fg ->
          Ptr Font -> CString -> Ptr Color -> IO (Ptr Surface)
forall (m :: * -> *).
MonadIO m =>
Ptr Font -> CString -> Ptr Color -> m (Ptr Surface)
SDL.Raw.Font.renderUTF8_Solid Ptr Font
font (CString -> CString
forall a b. Ptr a -> Ptr b
castPtr CString
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 Ptr Font
font) (V4 Word8
r Word8
g Word8
b Word8
a) (V4 Word8
r2 Word8
g2 Word8
b2 Word8
a2) 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)
-> ((CString -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (CString -> 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 Text
"SDL.Font.shaded" Text
"TTF_RenderUTF8_Shaded" (m (Ptr Surface) -> m (Ptr Surface))
-> ((CString -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (CString -> 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))
-> ((CString -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (CString -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (CString -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a. Text -> (CString -> IO a) -> IO a
withCString Text
text ((CString -> IO (Ptr Surface)) -> m Surface)
-> (CString -> IO (Ptr Surface)) -> m Surface
forall a b. (a -> b) -> a -> b
$ \CString
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
$ \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
$ \Ptr Color
bg ->
            Ptr Font -> CString -> Ptr Color -> Ptr Color -> IO (Ptr Surface)
forall (m :: * -> *).
MonadIO m =>
Ptr Font -> CString -> Ptr Color -> Ptr Color -> m (Ptr Surface)
SDL.Raw.Font.renderUTF8_Shaded Ptr Font
font (CString -> CString
forall a b. Ptr a -> Ptr b
castPtr CString
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 Ptr Font
font) (V4 Word8
r Word8
g Word8
b Word8
a) 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)
-> ((CString -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (CString -> 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 Text
"SDL.Font.blended" Text
"TTF_RenderUTF8_Blended" (m (Ptr Surface) -> m (Ptr Surface))
-> ((CString -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (CString -> 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))
-> ((CString -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (CString -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (CString -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a. Text -> (CString -> IO a) -> IO a
withCString Text
text ((CString -> IO (Ptr Surface)) -> m Surface)
-> (CString -> IO (Ptr Surface)) -> m Surface
forall a b. (a -> b) -> a -> b
$ \CString
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
$ \Ptr Color
fg ->
          Ptr Font -> CString -> Ptr Color -> IO (Ptr Surface)
forall (m :: * -> *).
MonadIO m =>
Ptr Font -> CString -> Ptr Color -> m (Ptr Surface)
SDL.Raw.Font.renderUTF8_Blended Ptr Font
font (CString -> CString
forall a b. Ptr a -> Ptr b
castPtr CString
ptr) Ptr Color
fg

-- 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 a -> CInt
convert CInt
cint = (a -> [a]) -> [a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\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, 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 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) CInt
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
    Style
Bold          -> CInt
forall a. (Eq a, Num a) => a
SDL.Raw.Font.TTF_STYLE_BOLD
    Style
Italic        -> CInt
forall a. (Eq a, Num a) => a
SDL.Raw.Font.TTF_STYLE_ITALIC
    Style
Underline     -> CInt
forall a. (Eq a, Num a) => a
SDL.Raw.Font.TTF_STYLE_UNDERLINE
    Style
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 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 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
    Hinting
Normal -> CInt
forall a. (Eq a, Num a) => a
SDL.Raw.Font.TTF_HINTING_NORMAL
    Hinting
Light  -> CInt
forall a. (Eq a, Num a) => a
SDL.Raw.Font.TTF_HINTING_LIGHT
    Hinting
Mono   -> CInt
forall a. (Eq a, Num a) => a
SDL.Raw.Font.TTF_HINTING_MONO
    Hinting
None   -> CInt
forall a. (Eq a, Num a) => a
SDL.Raw.Font.TTF_HINTING_NONE

cIntToHinting :: CInt -> Hinting
cIntToHinting :: CInt -> Hinting
cIntToHinting =
  \case
    CInt
SDL.Raw.Font.TTF_HINTING_NORMAL -> Hinting
Normal
    CInt
SDL.Raw.Font.TTF_HINTING_LIGHT  -> Hinting
Light
    CInt
SDL.Raw.Font.TTF_HINTING_MONO   -> Hinting
Mono
    CInt
SDL.Raw.Font.TTF_HINTING_NONE   -> Hinting
None
    CInt
_ -> String -> Hinting
forall a. HasCallStack => String -> a
error String
"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 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 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
  Bool
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
  Bool
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 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 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 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  Int
_ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Maybe Int
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 Ptr Font
font) 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
      CInt
0 -> Maybe Int -> m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
      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 Ptr Font
font) 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
$ \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
$ \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
$ \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
$ \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
$ \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
/= CInt
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 Ptr Font
font) Text
text =
    IO (Int, Int) -> m (Int, Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, Int) -> m (Int, Int))
-> ((CString -> IO (Int, Int)) -> IO (Int, Int))
-> (CString -> IO (Int, Int))
-> m (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Text -> (CString -> IO (Int, Int)) -> IO (Int, Int)
forall a. Text -> (CString -> IO a) -> IO a
withCString Text
text ((CString -> IO (Int, Int)) -> m (Int, Int))
-> (CString -> IO (Int, Int)) -> m (Int, Int)
forall a b. (a -> b) -> a -> b
$ \CString
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
$ \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
$ \Ptr CInt
h ->
            Ptr Font -> CString -> Ptr CInt -> Ptr CInt -> IO CInt
forall (m :: * -> *).
MonadIO m =>
Ptr Font -> CString -> Ptr CInt -> Ptr CInt -> m CInt
SDL.Raw.Font.sizeUTF8 Ptr Font
font (CString -> CString
forall a b. Ptr a -> Ptr b
castPtr CString
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
                CInt
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')
                CInt
_ -> 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 Text
"SDL.Font.size" Text
"TTF_SizeUTF8" 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 Ptr Font
font) (V4 Word8
r Word8
g Word8
b Word8
a) 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 Text
"SDL.Font.solidGlyph" Text
"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
$ \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 Ptr Font
font) (V4 Word8
r Word8
g Word8
b Word8
a) (V4 Word8
r2 Word8
g2 Word8
b2 Word8
a2) 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 Text
"SDL.Font.shadedGlyph" Text
"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
$ \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
$ \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 Ptr Font
font) (V4 Word8
r Word8
g Word8
b Word8
a) 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 Text
"SDL.Font.blendedGlyph" Text
"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
$ \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 Ptr Font
font) (V4 Word8
r Word8
g Word8
b Word8
a) Int
wrapLength 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)
-> ((CString -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (CString -> 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 Text
"SDL.Font.blended" Text
"TTF_RenderUTF8_Blended_Wrapped" (m (Ptr Surface) -> m (Ptr Surface))
-> ((CString -> IO (Ptr Surface)) -> m (Ptr Surface))
-> (CString -> 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))
-> ((CString -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (CString -> IO (Ptr Surface))
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (CString -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a. Text -> (CString -> IO a) -> IO a
withCString Text
text ((CString -> IO (Ptr Surface)) -> m Surface)
-> (CString -> IO (Ptr Surface)) -> m Surface
forall a b. (a -> b) -> a -> b
$ \CString
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
$ \Ptr Color
fg ->
          Ptr Font -> CString -> Ptr Color -> CUInt -> IO (Ptr Surface)
forall (m :: * -> *).
MonadIO m =>
Ptr Font -> CString -> Ptr Color -> CUInt -> m (Ptr Surface)
SDL.Raw.Font.renderUTF8_Blended_Wrapped Ptr Font
font (CString -> CString
forall a b. Ptr a -> Ptr b
castPtr CString
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 Ptr Font
font) Int
prevIndex 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)