-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.SDL.TTF.Render
-- Copyright   :  (c) David Himmelstrup 2005
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-----------------------------------------------------------------------------

{-# CFILES Graphics/UI/SDL/TTF/Wrapper.c #-}

module Graphics.UI.SDL.TTF.Render
    ( tryRenderTextSolid
    , renderTextSolid
    , tryRenderUTF8Solid
    , renderUTF8Solid
    , tryRenderGlyphSolid
    , renderGlyphSolid

    , tryRenderTextShaded
    , renderTextShaded
    , tryRenderUTF8Shaded
    , renderUTF8Shaded
    , tryRenderGlyphShaded
    , renderGlyphShaded

    , tryRenderTextBlended
    , renderTextBlended
    , tryRenderUTF8Blended
    , renderUTF8Blended
    , tryRenderGlyphBlended
    , renderGlyphBlended

    ) where

import Graphics.UI.SDL.TTF.Types
import Graphics.UI.SDL.General
import Graphics.UI.SDL.Video
import Graphics.UI.SDL.Color
import Graphics.UI.SDL.Types
import Foreign
import Foreign.C

import Data.Char

renderOneColor :: (Ptr FontStruct -> CString -> Ptr Color -> IO (Ptr SurfaceStruct))
            -> Font -> String -> Color -> IO (Maybe Surface)
renderOneColor :: (Ptr FontStruct -> CString -> Ptr Color -> IO (Ptr SurfaceStruct))
-> Font -> String -> Color -> IO (Maybe Surface)
renderOneColor Ptr FontStruct -> CString -> Ptr Color -> IO (Ptr SurfaceStruct)
render Font
font String
text Color
color
    = Font
-> (Ptr FontStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr FontStruct -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (Ptr FontStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr FontStruct
fontPtr ->
      String -> (CString -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a. String -> (CString -> IO a) -> IO a
withCString String
text ((CString -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (CString -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \CString
cString ->
      Color -> (Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color ((Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr Color
colorPtr ->
      do Ptr SurfaceStruct
image <- Ptr FontStruct -> CString -> Ptr Color -> IO (Ptr SurfaceStruct)
render Ptr FontStruct
fontPtr CString
cString Ptr Color
colorPtr
         if Ptr SurfaceStruct
image Ptr SurfaceStruct -> Ptr SurfaceStruct -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr SurfaceStruct
forall a. Ptr a
nullPtr
            then Maybe Surface -> IO (Maybe Surface)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Surface
forall a. Maybe a
Nothing
            else (Surface -> Maybe Surface) -> IO Surface -> IO (Maybe Surface)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Surface -> Maybe Surface
forall a. a -> Maybe a
Just (Ptr SurfaceStruct -> IO Surface
mkFinalizedSurface Ptr SurfaceStruct
image)

renderTwoColor :: (Ptr FontStruct -> CString -> Ptr Color -> Ptr Color -> IO (Ptr SurfaceStruct))
            -> Font -> String -> Color -> Color -> IO (Maybe Surface)
renderTwoColor :: (Ptr FontStruct
 -> CString -> Ptr Color -> Ptr Color -> IO (Ptr SurfaceStruct))
-> Font -> String -> Color -> Color -> IO (Maybe Surface)
renderTwoColor Ptr FontStruct
-> CString -> Ptr Color -> Ptr Color -> IO (Ptr SurfaceStruct)
render Font
font String
text Color
color1 Color
color2
    = Font
-> (Ptr FontStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr FontStruct -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (Ptr FontStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr FontStruct
fontPtr ->
      String -> (CString -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a. String -> (CString -> IO a) -> IO a
withCString String
text ((CString -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (CString -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \CString
cString ->
      Color -> (Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color1 ((Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr Color
colorPtr1 ->
      Color -> (Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
color2 ((Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr Color
colorPtr2 -> 
      do Ptr SurfaceStruct
image <- Ptr FontStruct
-> CString -> Ptr Color -> Ptr Color -> IO (Ptr SurfaceStruct)
render Ptr FontStruct
fontPtr CString
cString Ptr Color
colorPtr1 Ptr Color
colorPtr2
         if Ptr SurfaceStruct
image Ptr SurfaceStruct -> Ptr SurfaceStruct -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr SurfaceStruct
forall a. Ptr a
nullPtr
            then Maybe Surface -> IO (Maybe Surface)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Surface
forall a. Maybe a
Nothing
            else (Surface -> Maybe Surface) -> IO Surface -> IO (Maybe Surface)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Surface -> Maybe Surface
forall a. a -> Maybe a
Just (Ptr SurfaceStruct -> IO Surface
mkFinalizedSurface Ptr SurfaceStruct
image)

--------------------------------------------------------------
-- Solid
--------------------------------------------------------------


-- SDL_Surface *TTF_RenderText_Solid(TTF_Font *font, const char *text, SDL_Color fg)
foreign import ccall unsafe "renderTextSolid" ttfRenderTextSolid
    :: Ptr FontStruct -> CString -> Ptr Color -> IO (Ptr SurfaceStruct)
tryRenderTextSolid :: Font -> String -> Color -> IO (Maybe Surface)
tryRenderTextSolid :: Font -> String -> Color -> IO (Maybe Surface)
tryRenderTextSolid = (Ptr FontStruct -> CString -> Ptr Color -> IO (Ptr SurfaceStruct))
-> Font -> String -> Color -> IO (Maybe Surface)
renderOneColor Ptr FontStruct -> CString -> Ptr Color -> IO (Ptr SurfaceStruct)
ttfRenderTextSolid

renderTextSolid :: Font -> String -> Color -> IO Surface
renderTextSolid :: Font -> String -> Color -> IO Surface
renderTextSolid Font
font String
text Color
color
    = String -> IO (Maybe Surface) -> IO Surface
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"TTF_RenderText_Solid" (Font -> String -> Color -> IO (Maybe Surface)
tryRenderTextSolid Font
font String
text Color
color)

-- SDL_Surface * SDLCALL TTF_RenderUTF8_Solid(TTF_Font *font, const char *text, SDL_Color fg);
foreign import ccall unsafe "renderUTF8Solid" ttfRenderUTF8Solid
    :: Ptr FontStruct -> CString -> Ptr Color -> IO (Ptr SurfaceStruct)
tryRenderUTF8Solid :: Font -> String -> Color -> IO (Maybe Surface)
tryRenderUTF8Solid :: Font -> String -> Color -> IO (Maybe Surface)
tryRenderUTF8Solid = (Ptr FontStruct -> CString -> Ptr Color -> IO (Ptr SurfaceStruct))
-> Font -> String -> Color -> IO (Maybe Surface)
renderOneColor Ptr FontStruct -> CString -> Ptr Color -> IO (Ptr SurfaceStruct)
ttfRenderUTF8Solid

renderUTF8Solid :: Font -> String -> Color -> IO Surface
renderUTF8Solid :: Font -> String -> Color -> IO Surface
renderUTF8Solid Font
font String
text Color
color
    = String -> IO (Maybe Surface) -> IO Surface
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"TTF_RenderUTF8_Solid" (Font -> String -> Color -> IO (Maybe Surface)
tryRenderUTF8Solid Font
font String
text Color
color)

-- SDL_Surface * renderGlyphSolid(TTF_Font *font, Uint16 ch, SDL_Color *fg);
foreign import ccall unsafe "renderGlyphSolid" renderGlyphSolid
    :: Ptr FontStruct -> Word16 -> Ptr Color -> IO (Ptr SurfaceStruct)
tryRenderGlyphSolid :: Font -> Char -> Color -> IO (Maybe Surface)
tryRenderGlyphSolid :: Font -> Char -> Color -> IO (Maybe Surface)
tryRenderGlyphSolid Font
font Char
ch Color
fg
    = Font
-> (Ptr FontStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr FontStruct -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (Ptr FontStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr FontStruct
fontPtr ->
      Color -> (Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
fg ((Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr Color
color ->
      do Ptr SurfaceStruct
image <- Ptr FontStruct -> Word16 -> Ptr Color -> IO (Ptr SurfaceStruct)
renderGlyphSolid Ptr FontStruct
fontPtr (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
ch)) Ptr Color
color
         if Ptr SurfaceStruct
image Ptr SurfaceStruct -> Ptr SurfaceStruct -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr SurfaceStruct
forall a. Ptr a
nullPtr
            then Maybe Surface -> IO (Maybe Surface)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Surface
forall a. Maybe a
Nothing
            else (Surface -> Maybe Surface) -> IO Surface -> IO (Maybe Surface)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Surface -> Maybe Surface
forall a. a -> Maybe a
Just (Ptr SurfaceStruct -> IO Surface
mkFinalizedSurface Ptr SurfaceStruct
image)

--------------------------------------------------------------
-- Shaded
--------------------------------------------------------------


-- SDL_Surface *TTF_RenderText_Shaded(TTF_Font *font, const char *text, SDL_Color fg)
foreign import ccall unsafe "renderTextShaded" ttfRenderTextShaded
    :: Ptr FontStruct -> CString -> Ptr Color -> Ptr Color -> IO (Ptr SurfaceStruct)
tryRenderTextShaded :: Font -> String -> Color -> Color -> IO (Maybe Surface)
tryRenderTextShaded :: Font -> String -> Color -> Color -> IO (Maybe Surface)
tryRenderTextShaded = (Ptr FontStruct
 -> CString -> Ptr Color -> Ptr Color -> IO (Ptr SurfaceStruct))
-> Font -> String -> Color -> Color -> IO (Maybe Surface)
renderTwoColor Ptr FontStruct
-> CString -> Ptr Color -> Ptr Color -> IO (Ptr SurfaceStruct)
ttfRenderTextShaded

renderTextShaded :: Font -> String -> Color -> Color -> IO Surface
renderTextShaded :: Font -> String -> Color -> Color -> IO Surface
renderTextShaded Font
font String
text Color
fg Color
bg
    = String -> IO (Maybe Surface) -> IO Surface
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"TTF_RenderText_Shaded" (Font -> String -> Color -> Color -> IO (Maybe Surface)
tryRenderTextShaded Font
font String
text Color
fg Color
bg)

-- SDL_Surface * SDLCALL TTF_RenderUTF8_Shaded(TTF_Font *font, const char *text, SDL_Color fg);
foreign import ccall unsafe "renderUTF8Shaded" ttfRenderUTF8Shaded
    :: Ptr FontStruct -> CString -> Ptr Color -> Ptr Color -> IO (Ptr SurfaceStruct)
tryRenderUTF8Shaded :: Font -> String -> Color -> Color -> IO (Maybe Surface)
tryRenderUTF8Shaded :: Font -> String -> Color -> Color -> IO (Maybe Surface)
tryRenderUTF8Shaded = (Ptr FontStruct
 -> CString -> Ptr Color -> Ptr Color -> IO (Ptr SurfaceStruct))
-> Font -> String -> Color -> Color -> IO (Maybe Surface)
renderTwoColor Ptr FontStruct
-> CString -> Ptr Color -> Ptr Color -> IO (Ptr SurfaceStruct)
ttfRenderUTF8Shaded

renderUTF8Shaded :: Font -> String -> Color -> Color -> IO Surface
renderUTF8Shaded :: Font -> String -> Color -> Color -> IO Surface
renderUTF8Shaded Font
font String
text Color
fg Color
bg
    = String -> IO (Maybe Surface) -> IO Surface
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"TTF_RenderUTF8_Shaded" (Font -> String -> Color -> Color -> IO (Maybe Surface)
tryRenderUTF8Shaded Font
font String
text Color
fg Color
bg)

-- SDL_Surface * renderGlyphShaded(TTF_Font *font, Uint16 ch, SDL_Color *fg);
foreign import ccall unsafe "renderGlyphShaded" renderGlyphShaded
    :: Ptr FontStruct -> Word16 -> Ptr Color -> Ptr Color -> IO (Ptr SurfaceStruct)
tryRenderGlyphShaded :: Font -> Char -> Color -> Color -> IO (Maybe Surface)
tryRenderGlyphShaded :: Font -> Char -> Color -> Color -> IO (Maybe Surface)
tryRenderGlyphShaded Font
font Char
ch Color
fg Color
bg
    = Font
-> (Ptr FontStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr FontStruct -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (Ptr FontStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr FontStruct
fontPtr ->
      Color -> (Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
fg ((Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr Color
fgPtr ->
      Color -> (Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
bg ((Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr Color
bgPtr ->
      do Ptr SurfaceStruct
image <- Ptr FontStruct
-> Word16 -> Ptr Color -> Ptr Color -> IO (Ptr SurfaceStruct)
renderGlyphShaded Ptr FontStruct
fontPtr (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
ch)) Ptr Color
fgPtr Ptr Color
bgPtr
         if Ptr SurfaceStruct
image Ptr SurfaceStruct -> Ptr SurfaceStruct -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr SurfaceStruct
forall a. Ptr a
nullPtr
            then Maybe Surface -> IO (Maybe Surface)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Surface
forall a. Maybe a
Nothing
            else (Surface -> Maybe Surface) -> IO Surface -> IO (Maybe Surface)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Surface -> Maybe Surface
forall a. a -> Maybe a
Just (Ptr SurfaceStruct -> IO Surface
mkFinalizedSurface Ptr SurfaceStruct
image)

--------------------------------------------------------------
-- Blended
--------------------------------------------------------------


-- SDL_Surface *TTF_RenderText_Blended(TTF_Font *font, const char *text, SDL_Color fg)
foreign import ccall unsafe "renderTextBlended" ttfRenderTextBlended
    :: Ptr FontStruct -> CString -> Ptr Color -> IO (Ptr SurfaceStruct)
tryRenderTextBlended :: Font -> String -> Color -> IO (Maybe Surface)
tryRenderTextBlended :: Font -> String -> Color -> IO (Maybe Surface)
tryRenderTextBlended = (Ptr FontStruct -> CString -> Ptr Color -> IO (Ptr SurfaceStruct))
-> Font -> String -> Color -> IO (Maybe Surface)
renderOneColor Ptr FontStruct -> CString -> Ptr Color -> IO (Ptr SurfaceStruct)
ttfRenderTextBlended

renderTextBlended :: Font -> String -> Color -> IO Surface
renderTextBlended :: Font -> String -> Color -> IO Surface
renderTextBlended Font
font String
text Color
color
    = String -> IO (Maybe Surface) -> IO Surface
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"TTF_RenderText_Blended" (Font -> String -> Color -> IO (Maybe Surface)
tryRenderTextBlended Font
font String
text Color
color)

-- SDL_Surface * SDLCALL TTF_RenderUTF8_Blended(TTF_Font *font, const char *text, SDL_Color fg);
foreign import ccall unsafe "renderUTF8Blended" ttfRenderUTF8Blended
    :: Ptr FontStruct -> CString -> Ptr Color -> IO (Ptr SurfaceStruct)
tryRenderUTF8Blended :: Font -> String -> Color -> IO (Maybe Surface)
tryRenderUTF8Blended :: Font -> String -> Color -> IO (Maybe Surface)
tryRenderUTF8Blended = (Ptr FontStruct -> CString -> Ptr Color -> IO (Ptr SurfaceStruct))
-> Font -> String -> Color -> IO (Maybe Surface)
renderOneColor Ptr FontStruct -> CString -> Ptr Color -> IO (Ptr SurfaceStruct)
ttfRenderUTF8Blended

renderUTF8Blended :: Font -> String -> Color -> IO Surface
renderUTF8Blended :: Font -> String -> Color -> IO Surface
renderUTF8Blended Font
font String
text Color
color
    = String -> IO (Maybe Surface) -> IO Surface
forall a. String -> IO (Maybe a) -> IO a
unwrapMaybe String
"TTF_RenderUTF8_Blended" (Font -> String -> Color -> IO (Maybe Surface)
tryRenderUTF8Blended Font
font String
text Color
color)

-- SDL_Surface * renderGlyphBlended(TTF_Font *font, Uint16 ch, SDL_Color *fg);
foreign import ccall unsafe "renderGlyphBlended" renderGlyphBlended
    :: Ptr FontStruct -> Word16 -> Ptr Color -> IO (Ptr SurfaceStruct)
tryRenderGlyphBlended :: Font -> Char -> Color -> IO (Maybe Surface)
tryRenderGlyphBlended :: Font -> Char -> Color -> IO (Maybe Surface)
tryRenderGlyphBlended Font
font Char
ch Color
fg
    = Font
-> (Ptr FontStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr Font
font ((Ptr FontStruct -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (Ptr FontStruct -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr FontStruct
fontPtr ->
      Color -> (Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Color
fg ((Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface))
-> (Ptr Color -> IO (Maybe Surface)) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr Color
color ->
      do Ptr SurfaceStruct
image <- Ptr FontStruct -> Word16 -> Ptr Color -> IO (Ptr SurfaceStruct)
renderGlyphBlended Ptr FontStruct
fontPtr (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
ch)) Ptr Color
color
         if Ptr SurfaceStruct
image Ptr SurfaceStruct -> Ptr SurfaceStruct -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr SurfaceStruct
forall a. Ptr a
nullPtr
            then Maybe Surface -> IO (Maybe Surface)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Surface
forall a. Maybe a
Nothing
            else (Surface -> Maybe Surface) -> IO Surface -> IO (Maybe Surface)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Surface -> Maybe Surface
forall a. a -> Maybe a
Just (Ptr SurfaceStruct -> IO Surface
mkFinalizedSurface Ptr SurfaceStruct
image)