{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
module SDL.Image
(
load,
decode,
loadTexture,
decodeTexture,
loadTGA,
decodeTGA,
loadTextureTGA,
decodeTextureTGA,
formattedAs,
format,
Format (..),
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)
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)
data InitFlag
=
InitJPG
|
InitPNG
|
InitTIF
|
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
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
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
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
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
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
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
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
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
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
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
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 ..]
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)
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
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)
quit :: MonadIO m => m ()
quit :: forall (m :: * -> *). MonadIO m => m ()
quit = m ()
forall (m :: * -> *). MonadIO m => m ()
SDL.Raw.Image.quit