{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
--
-- Module      : SDL.Image
-- Copyright   : (c) 2015 Siniša Biđin, 2021 Daniel Firth
-- License     : MIT
-- Maintainer  : sinisa@bidin.eu, dan.firth@homotopic.tech
-- Stability   : experimental
--
-- Bindings to the @SDL2_image@ library. These should allow you to load various
-- types of images as @SDL@ 'Surface's, as well as detect image formats.
--
-- You can safely assume that any monadic function listed here is capable of
-- throwing an 'SDLException' in case it encounters an error.
module SDL.Image
  ( -- * Loading images

    --

    -- | Use the following functions to read any @PNG@, @JPG@, @TIF@, @GIF@,
    -- @WEBP@, @CUR@, @ICO@, @BMP@, @PNM@, @XPM@, @XCF@, @PCX@ and @XV@ formatted
    -- data.
    --
    -- If you have @TGA@-formatted data, you might wish to use the functions from
    -- the <#tga following section> instead.
    load,
    decode,
    loadTexture,
    decodeTexture,

    -- * Loading TGA images

    --

    -- | #tga# Since @TGA@ images don't contain a specific unique signature, the
    -- following functions might succeed even when given files not formatted as
    -- @TGA@ images.
    --
    -- Only use these functions if you're certain the inputs are @TGA@-formatted,
    -- otherwise they'll throw an exception.
    loadTGA,
    decodeTGA,
    loadTextureTGA,
    decodeTextureTGA,

    -- * Format detection
    formattedAs,
    format,
    Format (..),

    -- * Other
    initialize,
    InitFlag (..),
    version,
    quit,
  )
where

import Control.Exception (bracket, throwIO)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Bits ((.|.))
import Data.ByteString (ByteString)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.List (find)
import Data.Text (pack)
import Foreign.C.String (withCString)
import Foreign.C.Types (CInt)
import Foreign.Ptr (Ptr, castPtr)
import Foreign.Storable (peek)
import GHC.Generics (Generic)
import SDL (Renderer, SDLException (..), Surface (..), Texture)
import qualified SDL
import SDL.Internal.Exception (throwIfNull, throwIf_)
import qualified SDL.Raw
import SDL.Raw.Filesystem (rwFromConstMem, rwFromFile)
import qualified SDL.Raw.Image
import SDL.Raw.Types (RWops)
import System.IO.Unsafe (unsafePerformIO)

-- | Initializes @SDL2_image@ by loading support for the chosen image formats.
-- Explicit initialization is optional.
--
-- You should call this function if you prefer to load image support yourself,
-- at a time when your process isn't as busy. Otherwise, image support will be
-- loaded dynamically when you attempt to load a @JPG@, @PNG@, @TIF@ or
-- @WEBP@-formatted file.
--
-- You may call this function multiple times.
initialize :: (Foldable f, MonadIO m) => f InitFlag -> m ()
initialize :: forall (f :: * -> *) (m :: * -> *).
(Foldable f, MonadIO m) =>
f InitFlag -> m ()
initialize f InitFlag
flags = do
  let cint :: CInt
cint = (CInt -> InitFlag -> CInt) -> CInt -> f InitFlag -> CInt
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\CInt
a InitFlag
b -> CInt
a CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. InitFlag -> CInt
flagToCInt InitFlag
b) CInt
0 f InitFlag
flags
  (CInt -> Bool) -> Text -> Text -> m CInt -> m ()
forall (m :: * -> *) a.
MonadIO m =>
(a -> Bool) -> Text -> Text -> m a -> m ()
throwIf_
    (\CInt
result -> CInt
cint CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0 Bool -> Bool -> Bool
&& CInt
cint CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
result)
    Text
"SDL.Image.initialize"
    Text
"IMG_Init"
    (CInt -> m CInt
forall {m :: * -> *}. MonadIO m => CInt -> m CInt
SDL.Raw.Image.init CInt
cint)

-- | Flags intended to be fed to 'initialize'.
--
-- Each designates early loading of support for a particular image format.
data InitFlag
  = -- | Load support for reading @JPG@ files.
    InitJPG
  | -- | Same, but for @PNG@ files.
    InitPNG
  | -- | @TIF@ files.
    InitTIF
  | -- | @WEBP@ files.
    InitWEBP
  deriving stock (InitFlag -> InitFlag -> Bool
(InitFlag -> InitFlag -> Bool)
-> (InitFlag -> InitFlag -> Bool) -> Eq InitFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InitFlag -> InitFlag -> Bool
== :: InitFlag -> InitFlag -> Bool
$c/= :: InitFlag -> InitFlag -> Bool
/= :: InitFlag -> InitFlag -> Bool
Eq, Int -> InitFlag
InitFlag -> Int
InitFlag -> [InitFlag]
InitFlag -> InitFlag
InitFlag -> InitFlag -> [InitFlag]
InitFlag -> InitFlag -> InitFlag -> [InitFlag]
(InitFlag -> InitFlag)
-> (InitFlag -> InitFlag)
-> (Int -> InitFlag)
-> (InitFlag -> Int)
-> (InitFlag -> [InitFlag])
-> (InitFlag -> InitFlag -> [InitFlag])
-> (InitFlag -> InitFlag -> [InitFlag])
-> (InitFlag -> InitFlag -> InitFlag -> [InitFlag])
-> Enum InitFlag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: InitFlag -> InitFlag
succ :: InitFlag -> InitFlag
$cpred :: InitFlag -> InitFlag
pred :: InitFlag -> InitFlag
$ctoEnum :: Int -> InitFlag
toEnum :: Int -> InitFlag
$cfromEnum :: InitFlag -> Int
fromEnum :: InitFlag -> Int
$cenumFrom :: InitFlag -> [InitFlag]
enumFrom :: InitFlag -> [InitFlag]
$cenumFromThen :: InitFlag -> InitFlag -> [InitFlag]
enumFromThen :: InitFlag -> InitFlag -> [InitFlag]
$cenumFromTo :: InitFlag -> InitFlag -> [InitFlag]
enumFromTo :: InitFlag -> InitFlag -> [InitFlag]
$cenumFromThenTo :: InitFlag -> InitFlag -> InitFlag -> [InitFlag]
enumFromThenTo :: InitFlag -> InitFlag -> InitFlag -> [InitFlag]
Enum, Eq InitFlag
Eq InitFlag =>
(InitFlag -> InitFlag -> Ordering)
-> (InitFlag -> InitFlag -> Bool)
-> (InitFlag -> InitFlag -> Bool)
-> (InitFlag -> InitFlag -> Bool)
-> (InitFlag -> InitFlag -> Bool)
-> (InitFlag -> InitFlag -> InitFlag)
-> (InitFlag -> InitFlag -> InitFlag)
-> Ord InitFlag
InitFlag -> InitFlag -> Bool
InitFlag -> InitFlag -> Ordering
InitFlag -> InitFlag -> InitFlag
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
$ccompare :: InitFlag -> InitFlag -> Ordering
compare :: InitFlag -> InitFlag -> Ordering
$c< :: InitFlag -> InitFlag -> Bool
< :: InitFlag -> InitFlag -> Bool
$c<= :: InitFlag -> InitFlag -> Bool
<= :: InitFlag -> InitFlag -> Bool
$c> :: InitFlag -> InitFlag -> Bool
> :: InitFlag -> InitFlag -> Bool
$c>= :: InitFlag -> InitFlag -> Bool
>= :: InitFlag -> InitFlag -> Bool
$cmax :: InitFlag -> InitFlag -> InitFlag
max :: InitFlag -> InitFlag -> InitFlag
$cmin :: InitFlag -> InitFlag -> InitFlag
min :: InitFlag -> InitFlag -> InitFlag
Ord, InitFlag
InitFlag -> InitFlag -> Bounded InitFlag
forall a. a -> a -> Bounded a
$cminBound :: InitFlag
minBound :: InitFlag
$cmaxBound :: InitFlag
maxBound :: InitFlag
Bounded, (forall x. InitFlag -> Rep InitFlag x)
-> (forall x. Rep InitFlag x -> InitFlag) -> Generic InitFlag
forall x. Rep InitFlag x -> InitFlag
forall x. InitFlag -> Rep InitFlag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InitFlag -> Rep InitFlag x
from :: forall x. InitFlag -> Rep InitFlag x
$cto :: forall x. Rep InitFlag x -> InitFlag
to :: forall x. Rep InitFlag x -> InitFlag
Generic, ReadPrec [InitFlag]
ReadPrec InitFlag
Int -> ReadS InitFlag
ReadS [InitFlag]
(Int -> ReadS InitFlag)
-> ReadS [InitFlag]
-> ReadPrec InitFlag
-> ReadPrec [InitFlag]
-> Read InitFlag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS InitFlag
readsPrec :: Int -> ReadS InitFlag
$creadList :: ReadS [InitFlag]
readList :: ReadS [InitFlag]
$creadPrec :: ReadPrec InitFlag
readPrec :: ReadPrec InitFlag
$creadListPrec :: ReadPrec [InitFlag]
readListPrec :: ReadPrec [InitFlag]
Read, Int -> InitFlag -> ShowS
[InitFlag] -> ShowS
InitFlag -> [Char]
(Int -> InitFlag -> ShowS)
-> (InitFlag -> [Char]) -> ([InitFlag] -> ShowS) -> Show InitFlag
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitFlag -> ShowS
showsPrec :: Int -> InitFlag -> ShowS
$cshow :: InitFlag -> [Char]
show :: InitFlag -> [Char]
$cshowList :: [InitFlag] -> ShowS
showList :: [InitFlag] -> ShowS
Show)

flagToCInt :: InitFlag -> CInt
flagToCInt :: InitFlag -> CInt
flagToCInt =
  \case
    InitFlag
InitJPG -> CInt
forall {a}. (Eq a, Num a) => a
SDL.Raw.Image.IMG_INIT_JPG
    InitFlag
InitPNG -> CInt
forall {a}. (Eq a, Num a) => a
SDL.Raw.Image.IMG_INIT_PNG
    InitFlag
InitTIF -> CInt
forall {a}. (Eq a, Num a) => a
SDL.Raw.Image.IMG_INIT_TIF
    InitFlag
InitWEBP -> CInt
forall {a}. (Eq a, Num a) => a
SDL.Raw.Image.IMG_INIT_WEBP

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

-- | Loads any given file of a supported image type as a 'Surface', including
-- @TGA@ if the filename ends with @\".tga\"@.
--
-- If you have @TGA@ files that don't have names ending with @\".tga\"@, use
-- 'loadTGA' instead.
load :: MonadIO m => FilePath -> m Surface
load :: forall (m :: * -> *). MonadIO m => [Char] -> m Surface
load [Char]
path =
  (Ptr Surface -> Surface) -> m (Ptr Surface) -> m Surface
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Surface -> Surface
unmanaged
    (m (Ptr Surface) -> m Surface)
-> (IO (Ptr Surface) -> m (Ptr Surface))
-> 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.Image.load" Text
"IMG_Load"
    (m (Ptr Surface) -> m (Ptr Surface))
-> (IO (Ptr Surface) -> m (Ptr Surface))
-> IO (Ptr Surface)
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Ptr Surface) -> m (Ptr Surface)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO (Ptr Surface) -> m Surface) -> IO (Ptr Surface) -> m Surface
forall a b. (a -> b) -> a -> b
$ [Char] -> (CString -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
path CString -> IO (Ptr Surface)
forall {m :: * -> *}. MonadIO m => CString -> m (Ptr Surface)
SDL.Raw.Image.load

-- | Same as 'load', but returning a 'Texture' instead.
--
-- For @TGA@ files not ending in ".tga", use 'loadTextureTGA' instead.
loadTexture :: MonadIO m => Renderer -> FilePath -> m Texture
loadTexture :: forall (m :: * -> *). MonadIO m => Renderer -> [Char] -> m Texture
loadTexture Renderer
r [Char]
path =
  IO Texture -> m Texture
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Texture -> m Texture)
-> ((Surface -> IO Texture) -> IO Texture)
-> (Surface -> IO Texture)
-> m Texture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Surface
-> (Surface -> IO ()) -> (Surface -> IO Texture) -> IO Texture
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket ([Char] -> IO Surface
forall (m :: * -> *). MonadIO m => [Char] -> m Surface
load [Char]
path) Surface -> IO ()
forall (m :: * -> *). MonadIO m => Surface -> m ()
SDL.freeSurface ((Surface -> IO Texture) -> m Texture)
-> (Surface -> IO Texture) -> m Texture
forall a b. (a -> b) -> a -> b
$
    Renderer -> Surface -> IO Texture
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Renderer -> Surface -> m Texture
SDL.createTextureFromSurface Renderer
r

-- | Reads an image from a 'ByteString'.
--
-- This will work for all supported image types, __except TGA__. If you need to
-- decode a @TGA@ 'ByteString', use 'decodeTGA' instead.
decode :: MonadIO m => ByteString -> m Surface
decode :: forall (m :: * -> *). MonadIO m => ByteString -> m Surface
decode ByteString
bytes = IO Surface -> m Surface
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
  (IO Surface -> m Surface)
-> ((CStringLen -> IO Surface) -> IO Surface)
-> (CStringLen -> IO Surface)
-> m Surface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (CStringLen -> IO Surface) -> IO Surface
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bytes
  ((CStringLen -> IO Surface) -> m Surface)
-> (CStringLen -> IO Surface) -> m Surface
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 Surface -> Surface) -> IO (Ptr Surface) -> IO Surface
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Surface -> Surface
unmanaged
      (IO (Ptr Surface) -> IO Surface)
-> (IO (Ptr Surface) -> IO (Ptr Surface))
-> IO (Ptr Surface)
-> IO Surface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> IO (Ptr Surface) -> IO (Ptr Surface)
forall (m :: * -> *) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull Text
"SDL.Image.decode" Text
"IMG_Load_RW"
      (IO (Ptr Surface) -> IO Surface) -> IO (Ptr Surface) -> IO Surface
forall a b. (a -> b) -> a -> b
$ Ptr RWops -> CInt -> IO (Ptr Surface)
forall {m :: * -> *}.
MonadIO m =>
Ptr RWops -> CInt -> m (Ptr Surface)
SDL.Raw.Image.load_RW Ptr RWops
rw CInt
0

-- | Same as 'decode', but returning a 'Texture' instead.
--
-- If you need to decode a @TGA@ 'ByteString', use 'decodeTextureTGA' instead.
decodeTexture :: MonadIO m => Renderer -> ByteString -> m Texture
decodeTexture :: forall (m :: * -> *).
MonadIO m =>
Renderer -> ByteString -> m Texture
decodeTexture Renderer
r ByteString
bytes =
  IO Texture -> m Texture
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Texture -> m Texture)
-> ((Surface -> IO Texture) -> IO Texture)
-> (Surface -> IO Texture)
-> m Texture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Surface
-> (Surface -> IO ()) -> (Surface -> IO Texture) -> IO Texture
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ByteString -> IO Surface
forall (m :: * -> *). MonadIO m => ByteString -> m Surface
decode ByteString
bytes) Surface -> IO ()
forall (m :: * -> *). MonadIO m => Surface -> m ()
SDL.freeSurface ((Surface -> IO Texture) -> m Texture)
-> (Surface -> IO Texture) -> m Texture
forall a b. (a -> b) -> a -> b
$
    Renderer -> Surface -> IO Texture
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Renderer -> Surface -> m Texture
SDL.createTextureFromSurface Renderer
r

-- | If your @TGA@ files aren't in a filename ending with @\".tga\"@, you can
-- load them using this function.
loadTGA :: MonadIO m => FilePath -> m Surface
loadTGA :: forall (m :: * -> *). MonadIO m => [Char] -> m Surface
loadTGA [Char]
path =
  (Ptr Surface -> Surface) -> m (Ptr Surface) -> m Surface
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Surface -> Surface
unmanaged
    (m (Ptr Surface) -> m Surface)
-> (IO (Ptr Surface) -> m (Ptr Surface))
-> 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.Image.loadTGA" Text
"IMG_LoadTGA_RW"
    (m (Ptr Surface) -> m (Ptr Surface))
-> (IO (Ptr Surface) -> m (Ptr Surface))
-> IO (Ptr Surface)
-> m (Ptr Surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Ptr Surface) -> m (Ptr Surface)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO (Ptr Surface) -> m Surface) -> IO (Ptr Surface) -> m Surface
forall a b. (a -> b) -> a -> b
$ do
      Ptr RWops
rw <- [Char] -> (CString -> IO (Ptr RWops)) -> IO (Ptr RWops)
forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
"rb" ((CString -> IO (Ptr RWops)) -> IO (Ptr RWops))
-> (CString -> IO (Ptr RWops)) -> IO (Ptr RWops)
forall a b. (a -> b) -> a -> b
$ [Char] -> (CString -> IO (Ptr RWops)) -> IO (Ptr RWops)
forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
path ((CString -> IO (Ptr RWops)) -> IO (Ptr RWops))
-> (CString -> CString -> IO (Ptr RWops))
-> CString
-> IO (Ptr RWops)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CString -> CString -> IO (Ptr RWops))
-> CString -> CString -> IO (Ptr RWops)
forall a b c. (a -> b -> c) -> b -> a -> c
flip CString -> CString -> IO (Ptr RWops)
forall (m :: * -> *).
MonadIO m =>
CString -> CString -> m (Ptr RWops)
rwFromFile
      Ptr RWops -> IO (Ptr Surface)
forall {m :: * -> *}. MonadIO m => Ptr RWops -> m (Ptr Surface)
SDL.Raw.Image.loadTGA_RW Ptr RWops
rw

-- | Same as 'loadTGA', only returning a 'Texture' instead.
loadTextureTGA :: MonadIO m => Renderer -> FilePath -> m Texture
loadTextureTGA :: forall (m :: * -> *). MonadIO m => Renderer -> [Char] -> m Texture
loadTextureTGA Renderer
r [Char]
path =
  IO Texture -> m Texture
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Texture -> m Texture)
-> ((Surface -> IO Texture) -> IO Texture)
-> (Surface -> IO Texture)
-> m Texture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Surface
-> (Surface -> IO ()) -> (Surface -> IO Texture) -> IO Texture
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket ([Char] -> IO Surface
forall (m :: * -> *). MonadIO m => [Char] -> m Surface
loadTGA [Char]
path) Surface -> IO ()
forall (m :: * -> *). MonadIO m => Surface -> m ()
SDL.freeSurface ((Surface -> IO Texture) -> m Texture)
-> (Surface -> IO Texture) -> m Texture
forall a b. (a -> b) -> a -> b
$
    Renderer -> Surface -> IO Texture
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Renderer -> Surface -> m Texture
SDL.createTextureFromSurface Renderer
r

-- | Reads a @TGA@ image from a 'ByteString'.
--
-- Assumes the input is a @TGA@-formatted image.
decodeTGA :: MonadIO m => ByteString -> m Surface
decodeTGA :: forall (m :: * -> *). MonadIO m => ByteString -> m Surface
decodeTGA ByteString
bytes = IO Surface -> m Surface
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
  (IO Surface -> m Surface)
-> ((CStringLen -> IO Surface) -> IO Surface)
-> (CStringLen -> IO Surface)
-> m Surface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (CStringLen -> IO Surface) -> IO Surface
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bytes
  ((CStringLen -> IO Surface) -> m Surface)
-> (CStringLen -> IO Surface) -> m Surface
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 Surface -> Surface) -> IO (Ptr Surface) -> IO Surface
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr Surface -> Surface
unmanaged
      (IO (Ptr Surface) -> IO Surface)
-> (IO (Ptr Surface) -> IO (Ptr Surface))
-> IO (Ptr Surface)
-> IO Surface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> IO (Ptr Surface) -> IO (Ptr Surface)
forall (m :: * -> *) a.
MonadIO m =>
Text -> Text -> m (Ptr a) -> m (Ptr a)
throwIfNull Text
"SDL.Image.decodeTGA" Text
"IMG_LoadTGA_RW"
      (IO (Ptr Surface) -> IO Surface) -> IO (Ptr Surface) -> IO Surface
forall a b. (a -> b) -> a -> b
$ Ptr RWops -> IO (Ptr Surface)
forall {m :: * -> *}. MonadIO m => Ptr RWops -> m (Ptr Surface)
SDL.Raw.Image.loadTGA_RW Ptr RWops
rw

-- | Same as 'decodeTGA', but returns a 'Texture' instead.
decodeTextureTGA :: MonadIO m => Renderer -> ByteString -> m Texture
decodeTextureTGA :: forall (m :: * -> *).
MonadIO m =>
Renderer -> ByteString -> m Texture
decodeTextureTGA Renderer
r ByteString
bytes =
  IO Texture -> m Texture
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Texture -> m Texture)
-> ((Surface -> IO Texture) -> IO Texture)
-> (Surface -> IO Texture)
-> m Texture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Surface
-> (Surface -> IO ()) -> (Surface -> IO Texture) -> IO Texture
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ByteString -> IO Surface
forall (m :: * -> *). MonadIO m => ByteString -> m Surface
decodeTGA ByteString
bytes) Surface -> IO ()
forall (m :: * -> *). MonadIO m => Surface -> m ()
SDL.freeSurface ((Surface -> IO Texture) -> m Texture)
-> (Surface -> IO Texture) -> m Texture
forall a b. (a -> b) -> a -> b
$
    Renderer -> Surface -> IO Texture
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Renderer -> Surface -> m Texture
SDL.createTextureFromSurface Renderer
r

-- | Tests whether a 'ByteString' contains an image of a given format.
formattedAs :: Format -> ByteString -> Bool
formattedAs :: Format -> ByteString -> Bool
formattedAs Format
f ByteString
bytes = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO
  (IO Bool -> Bool)
-> ((CStringLen -> IO Bool) -> IO Bool)
-> (CStringLen -> IO Bool)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (CStringLen -> IO Bool) -> IO Bool
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bytes
  ((CStringLen -> IO Bool) -> Bool)
-> (CStringLen -> IO Bool) -> Bool
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)
    Format -> Ptr RWops -> IO CInt
forall (m :: * -> *). MonadIO m => Format -> Ptr RWops -> m CInt
formatPredicate Format
f Ptr RWops
rw IO CInt -> (CInt -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      CInt
1 -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      CInt
0 -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      CInt
e -> do
        let err :: Text
err = Text
"Expected 1 or 0, got " Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` [Char] -> Text
pack (CInt -> [Char]
forall a. Show a => a -> [Char]
show CInt
e) Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
"."
        let fun :: Text
fun = Text
"IMG_is" Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` [Char] -> Text
pack (Format -> [Char]
forall a. Show a => a -> [Char]
show Format
f)
        SDLException -> IO Bool
forall e a. Exception e => e -> IO a
throwIO (SDLException -> IO Bool) -> SDLException -> IO Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> SDLException
SDLCallFailed Text
"SDL.Image.formattedAs" Text
fun Text
err

-- | Tries to detect the image format by attempting 'formattedAs' with each
-- possible 'Format'.
--
-- If you're trying to test for a specific format, use a specific 'formattedAs'
-- directly instead.
format :: ByteString -> Maybe Format
format :: ByteString -> Maybe Format
format ByteString
bytes = (Format, Bool) -> Format
forall a b. (a, b) -> a
fst ((Format, Bool) -> Format) -> Maybe (Format, Bool) -> Maybe Format
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Format, Bool) -> Bool)
-> [(Format, Bool)] -> Maybe (Format, Bool)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Format, Bool) -> Bool
forall a b. (a, b) -> b
snd [(Format, Bool)]
attempts
  where
    attempts :: [(Format, Bool)]
attempts = (Format -> (Format, Bool)) -> [Format] -> [(Format, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\Format
f -> (Format
f, Format -> ByteString -> Bool
formattedAs Format
f ByteString
bytes)) [Format
forall a. Bounded a => a
minBound ..]

-- | Each of the supported image formats.
data Format
  = CUR
  | ICO
  | BMP
  | PNM
  | XPM
  | XCF
  | PCX
  | GIF
  | LBM
  | XV
  | JPG
  | PNG
  | TIF
  | WEBP
  deriving stock (Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
/= :: Format -> Format -> Bool
Eq, Int -> Format
Format -> Int
Format -> [Format]
Format -> Format
Format -> Format -> [Format]
Format -> Format -> Format -> [Format]
(Format -> Format)
-> (Format -> Format)
-> (Int -> Format)
-> (Format -> Int)
-> (Format -> [Format])
-> (Format -> Format -> [Format])
-> (Format -> Format -> [Format])
-> (Format -> Format -> Format -> [Format])
-> Enum Format
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Format -> Format
succ :: Format -> Format
$cpred :: Format -> Format
pred :: Format -> Format
$ctoEnum :: Int -> Format
toEnum :: Int -> Format
$cfromEnum :: Format -> Int
fromEnum :: Format -> Int
$cenumFrom :: Format -> [Format]
enumFrom :: Format -> [Format]
$cenumFromThen :: Format -> Format -> [Format]
enumFromThen :: Format -> Format -> [Format]
$cenumFromTo :: Format -> Format -> [Format]
enumFromTo :: Format -> Format -> [Format]
$cenumFromThenTo :: Format -> Format -> Format -> [Format]
enumFromThenTo :: Format -> Format -> Format -> [Format]
Enum, Eq Format
Eq Format =>
(Format -> Format -> Ordering)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Format)
-> (Format -> Format -> Format)
-> Ord Format
Format -> Format -> Bool
Format -> Format -> Ordering
Format -> Format -> Format
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
$ccompare :: Format -> Format -> Ordering
compare :: Format -> Format -> Ordering
$c< :: Format -> Format -> Bool
< :: Format -> Format -> Bool
$c<= :: Format -> Format -> Bool
<= :: Format -> Format -> Bool
$c> :: Format -> Format -> Bool
> :: Format -> Format -> Bool
$c>= :: Format -> Format -> Bool
>= :: Format -> Format -> Bool
$cmax :: Format -> Format -> Format
max :: Format -> Format -> Format
$cmin :: Format -> Format -> Format
min :: Format -> Format -> Format
Ord, Format
Format -> Format -> Bounded Format
forall a. a -> a -> Bounded a
$cminBound :: Format
minBound :: Format
$cmaxBound :: Format
maxBound :: Format
Bounded, (forall x. Format -> Rep Format x)
-> (forall x. Rep Format x -> Format) -> Generic Format
forall x. Rep Format x -> Format
forall x. Format -> Rep Format x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Format -> Rep Format x
from :: forall x. Format -> Rep Format x
$cto :: forall x. Rep Format x -> Format
to :: forall x. Rep Format x -> Format
Generic, ReadPrec [Format]
ReadPrec Format
Int -> ReadS Format
ReadS [Format]
(Int -> ReadS Format)
-> ReadS [Format]
-> ReadPrec Format
-> ReadPrec [Format]
-> Read Format
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Format
readsPrec :: Int -> ReadS Format
$creadList :: ReadS [Format]
readList :: ReadS [Format]
$creadPrec :: ReadPrec Format
readPrec :: ReadPrec Format
$creadListPrec :: ReadPrec [Format]
readListPrec :: ReadPrec [Format]
Read, Int -> Format -> ShowS
[Format] -> ShowS
Format -> [Char]
(Int -> Format -> ShowS)
-> (Format -> [Char]) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Format -> ShowS
showsPrec :: Int -> Format -> ShowS
$cshow :: Format -> [Char]
show :: Format -> [Char]
$cshowList :: [Format] -> ShowS
showList :: [Format] -> ShowS
Show)

-- Given an image format, return its raw predicate function.
formatPredicate :: MonadIO m => Format -> Ptr RWops -> m CInt
formatPredicate :: forall (m :: * -> *). MonadIO m => Format -> Ptr RWops -> m CInt
formatPredicate = \case
  Format
CUR -> Ptr RWops -> m CInt
forall {m :: * -> *}. MonadIO m => Ptr RWops -> m CInt
SDL.Raw.Image.isCUR
  Format
ICO -> Ptr RWops -> m CInt
forall {m :: * -> *}. MonadIO m => Ptr RWops -> m CInt
SDL.Raw.Image.isICO
  Format
BMP -> Ptr RWops -> m CInt
forall {m :: * -> *}. MonadIO m => Ptr RWops -> m CInt
SDL.Raw.Image.isBMP
  Format
PNM -> Ptr RWops -> m CInt
forall {m :: * -> *}. MonadIO m => Ptr RWops -> m CInt
SDL.Raw.Image.isPNM
  Format
XPM -> Ptr RWops -> m CInt
forall {m :: * -> *}. MonadIO m => Ptr RWops -> m CInt
SDL.Raw.Image.isXPM
  Format
XCF -> Ptr RWops -> m CInt
forall {m :: * -> *}. MonadIO m => Ptr RWops -> m CInt
SDL.Raw.Image.isXCF
  Format
PCX -> Ptr RWops -> m CInt
forall {m :: * -> *}. MonadIO m => Ptr RWops -> m CInt
SDL.Raw.Image.isPCX
  Format
GIF -> Ptr RWops -> m CInt
forall {m :: * -> *}. MonadIO m => Ptr RWops -> m CInt
SDL.Raw.Image.isGIF
  Format
LBM -> Ptr RWops -> m CInt
forall {m :: * -> *}. MonadIO m => Ptr RWops -> m CInt
SDL.Raw.Image.isLBM
  Format
XV -> Ptr RWops -> m CInt
forall {m :: * -> *}. MonadIO m => Ptr RWops -> m CInt
SDL.Raw.Image.isXV
  Format
JPG -> Ptr RWops -> m CInt
forall {m :: * -> *}. MonadIO m => Ptr RWops -> m CInt
SDL.Raw.Image.isJPG
  Format
PNG -> Ptr RWops -> m CInt
forall {m :: * -> *}. MonadIO m => Ptr RWops -> m CInt
SDL.Raw.Image.isPNG
  Format
TIF -> Ptr RWops -> m CInt
forall {m :: * -> *}. MonadIO m => Ptr RWops -> m CInt
SDL.Raw.Image.isTIF
  Format
WEBP -> Ptr RWops -> m CInt
forall {m :: * -> *}. MonadIO m => Ptr RWops -> m CInt
SDL.Raw.Image.isWEBP

-- | Gets the major, minor, patch versions of the linked @SDL2_image@ library.
version :: (Integral a, MonadIO m) => m (a, a, a)
version :: forall a (m :: * -> *). (Integral a, MonadIO m) => m (a, a, a)
version = IO (a, a, a) -> m (a, a, a)
forall a. IO a -> m 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.Image.getVersion
  (a, a, a) -> IO (a, a, a)
forall a. a -> IO 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)

-- | Cleans up any loaded image libraries, freeing memory. You only need to
-- call this function once.
quit :: MonadIO m => m ()
quit :: forall (m :: * -> *). MonadIO m => m ()
quit = m ()
forall (m :: * -> *). MonadIO m => m ()
SDL.Raw.Image.quit