-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.SDL.Image
-- Copyright   :  (c) David Himmelstrup 2005
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-----------------------------------------------------------------------------
module Graphics.UI.SDL.Image
    ( load
    , loadRW
    , ImageType(..)
    , loadTypedRW
    , loadTyped
    , isTypedRW
    , isTyped
    , isBMPRW
    , isBMP
    , isPNMRW
    , isPNM
    , isXPMRW
    , isXPM
    , isXCFRW
    , isXCF
    , isPCXRW
    , isPCX
    , isGIFRW
    , isGIF
    , isJPGRW
    , isJPG
    , isTIFRW
    , isTIF
    , isPNGRW
    , isPNG
    , isLBMRW
    , isLBM
    , module Graphics.UI.SDL.Image.Version
    ) where

import Graphics.UI.SDL.Image.Version

import Foreign
import Foreign.C

import Graphics.UI.SDL.Video
import Graphics.UI.SDL.General
import Graphics.UI.SDL.Types
import Graphics.UI.SDL.RWOps as RW

finalizeWhenNotNull :: String -> Ptr SurfaceStruct -> IO Surface
finalizeWhenNotNull :: String -> Ptr SurfaceStruct -> IO Surface
finalizeWhenNotNull String
errMsg Ptr SurfaceStruct
image
    = if Ptr SurfaceStruct
image Ptr SurfaceStruct -> Ptr SurfaceStruct -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr SurfaceStruct
forall a. Ptr a
nullPtr
         then String -> IO Surface
forall a. String -> IO a
failWithError String
errMsg
         else Ptr SurfaceStruct -> IO Surface
mkFinalizedSurface Ptr SurfaceStruct
image

-- SDL_Surface *IMG_Load(const char *file)
foreign import ccall unsafe "IMG_Load" imgLoad :: CString -> IO (Ptr SurfaceStruct)
load :: FilePath -> IO Surface
load :: String -> IO Surface
load String
filepath
    = String -> (CString -> IO Surface) -> IO Surface
forall a. String -> (CString -> IO a) -> IO a
withCString String
filepath ((CString -> IO Surface) -> IO Surface)
-> (CString -> IO Surface) -> IO Surface
forall a b. (a -> b) -> a -> b
$ \CString
cPath ->
      CString -> IO (Ptr SurfaceStruct)
imgLoad CString
cPath IO (Ptr SurfaceStruct)
-> (Ptr SurfaceStruct -> IO Surface) -> IO Surface
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Ptr SurfaceStruct -> IO Surface
finalizeWhenNotNull String
"IMG_Load"

-- SDL_Surface *IMG_Load_RW(SDL_RWops *src, int freesrc)
foreign import ccall "IMG_Load_RW" imgLoadRW :: Ptr RWopsStruct -> Int -> IO (Ptr SurfaceStruct)
loadRW :: RWops -> Bool -> IO Surface
loadRW :: RWops -> Bool -> IO Surface
loadRW RWops
rw Bool
freesrc
    = RWops -> (Ptr RWopsStruct -> IO Surface) -> IO Surface
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RWops
rw ((Ptr RWopsStruct -> IO Surface) -> IO Surface)
-> (Ptr RWopsStruct -> IO Surface) -> IO Surface
forall a b. (a -> b) -> a -> b
$ \Ptr RWopsStruct
rwPtr ->
      Ptr RWopsStruct -> Int -> IO (Ptr SurfaceStruct)
imgLoadRW Ptr RWopsStruct
rwPtr (Bool -> Int
forall a. Num a => Bool -> a
fromBool Bool
freesrc) IO (Ptr SurfaceStruct)
-> (Ptr SurfaceStruct -> IO Surface) -> IO Surface
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Ptr SurfaceStruct -> IO Surface
finalizeWhenNotNull String
"IMG_Load_RW"



data ImageType
    = TGA
    | BMP
    | PNM
    | XPM
    | XCF
    | PCX
    | GIF
    | JPG
    | TIF
    | LBM
    | PNG
    | Other String

imageTypeToString :: ImageType -> String
imageTypeToString :: ImageType -> String
imageTypeToString ImageType
TGA = String
"TGA"
imageTypeToString ImageType
BMP = String
"BMP"
imageTypeToString ImageType
PNM = String
"PNM"
imageTypeToString ImageType
XPM = String
"XPM"
imageTypeToString ImageType
XCF = String
"XCF"
imageTypeToString ImageType
PCX = String
"PCX"
imageTypeToString ImageType
GIF = String
"GIF"
imageTypeToString ImageType
JPG = String
"JPG"
imageTypeToString ImageType
TIF = String
"TIF"
imageTypeToString ImageType
LBM = String
"LBM"
imageTypeToString ImageType
PNG = String
"PNG"
imageTypeToString (Other String
format) = String
format

-- SDL_Surface *IMG_LoadTyped_RW(SDL_RWops *src, int freesrc, char *type)
foreign import ccall "IMG_LoadTyped_RW" imgLoadTypedRW :: Ptr RWopsStruct -> Int -> CString -> IO (Ptr SurfaceStruct)
loadTypedRW :: RWops -> Bool -> ImageType -> IO Surface
loadTypedRW :: RWops -> Bool -> ImageType -> IO Surface
loadTypedRW RWops
rw Bool
freesrc ImageType
imageType
    = RWops -> (Ptr RWopsStruct -> IO Surface) -> IO Surface
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RWops
rw ((Ptr RWopsStruct -> IO Surface) -> IO Surface)
-> (Ptr RWopsStruct -> IO Surface) -> IO Surface
forall a b. (a -> b) -> a -> b
$ \Ptr RWopsStruct
rwPtr ->
      String -> (CString -> IO Surface) -> IO Surface
forall a. String -> (CString -> IO a) -> IO a
withCString (ImageType -> String
imageTypeToString ImageType
imageType) ((CString -> IO Surface) -> IO Surface)
-> (CString -> IO Surface) -> IO Surface
forall a b. (a -> b) -> a -> b
$ \CString
cType ->
      Ptr RWopsStruct -> Int -> CString -> IO (Ptr SurfaceStruct)
imgLoadTypedRW Ptr RWopsStruct
rwPtr (Bool -> Int
forall a. Num a => Bool -> a
fromBool Bool
freesrc) CString
cType IO (Ptr SurfaceStruct)
-> (Ptr SurfaceStruct -> IO Surface) -> IO Surface
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Ptr SurfaceStruct -> IO Surface
finalizeWhenNotNull String
"IMG_LoadTyped_RW"

loadTyped :: FilePath -> ImageType -> IO Surface
loadTyped :: String -> ImageType -> IO Surface
loadTyped String
filepath ImageType
imageType
    = String -> String -> (RWops -> IO Surface) -> IO Surface
forall a. String -> String -> (RWops -> IO a) -> IO a
RW.with String
filepath String
"rb" ((RWops -> IO Surface) -> IO Surface)
-> (RWops -> IO Surface) -> IO Surface
forall a b. (a -> b) -> a -> b
$ \RWops
rw ->
      RWops -> Bool -> ImageType -> IO Surface
loadTypedRW RWops
rw Bool
False ImageType
imageType

isTypedRW :: ImageType -> RWops -> IO Bool
isTypedRW :: ImageType -> RWops -> IO Bool
isTypedRW ImageType
BMP = RWops -> IO Bool
isBMPRW
isTypedRW ImageType
PNM = RWops -> IO Bool
isPNMRW
isTypedRW ImageType
XPM = RWops -> IO Bool
isXPMRW
isTypedRW ImageType
XCF = RWops -> IO Bool
isXCFRW
isTypedRW ImageType
PCX = RWops -> IO Bool
isPCXRW
isTypedRW ImageType
GIF = RWops -> IO Bool
isGIFRW
isTypedRW ImageType
JPG = RWops -> IO Bool
isJPGRW
isTypedRW ImageType
TIF = RWops -> IO Bool
isTIFRW
isTypedRW ImageType
PNG = RWops -> IO Bool
isPNGRW
isTypedRW ImageType
LBM = RWops -> IO Bool
isLBMRW
isTypedRW ImageType
_other = IO Bool -> RWops -> IO Bool
forall a b. a -> b -> a
const (Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

isTyped :: ImageType -> FilePath -> IO Bool
isTyped :: ImageType -> String -> IO Bool
isTyped ImageType
imageType String
path
    = ImageType -> RWops -> IO Bool
isTypedRW ImageType
imageType (RWops -> IO Bool) -> IO RWops -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> IO RWops
RW.fromFile String
path String
"rb"


-- int IMG_isBMP(SDL_RWops *src)
foreign import ccall unsafe "IMG_isBMP" imgIsBMP :: Ptr RWopsStruct -> IO Int
isBMPRW :: RWops -> IO Bool
isBMPRW :: RWops -> IO Bool
isBMPRW RWops
rw
    = RWops -> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RWops
rw ((Ptr RWopsStruct -> IO Bool) -> IO Bool)
-> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr RWopsStruct
rwPtr ->
      (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Ptr RWopsStruct -> IO Int
imgIsBMP Ptr RWopsStruct
rwPtr)

isBMP :: FilePath -> IO Bool
isBMP :: String -> IO Bool
isBMP String
path = String -> String -> (RWops -> IO Bool) -> IO Bool
forall a. String -> String -> (RWops -> IO a) -> IO a
RW.with String
path String
"rb" ((RWops -> IO Bool) -> IO Bool) -> (RWops -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$
             RWops -> IO Bool
isBMPRW

-- int IMG_isPNM(SDL_RWops *src)
foreign import ccall unsafe "IMG_isPNM" imgIsPNM :: Ptr RWopsStruct -> IO Int
isPNMRW :: RWops -> IO Bool
isPNMRW :: RWops -> IO Bool
isPNMRW RWops
rw
    = RWops -> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RWops
rw ((Ptr RWopsStruct -> IO Bool) -> IO Bool)
-> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr RWopsStruct
rwPtr ->
      (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Ptr RWopsStruct -> IO Int
imgIsPNM Ptr RWopsStruct
rwPtr)

isPNM :: FilePath -> IO Bool
isPNM :: String -> IO Bool
isPNM String
path = String -> String -> (RWops -> IO Bool) -> IO Bool
forall a. String -> String -> (RWops -> IO a) -> IO a
RW.with String
path String
"rb" ((RWops -> IO Bool) -> IO Bool) -> (RWops -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$
             RWops -> IO Bool
isPNMRW

-- int IMG_isXPM(SDL_RWops *src)
foreign import ccall unsafe "IMG_isXPM" imgIsXPM :: Ptr RWopsStruct -> IO Int
isXPMRW :: RWops -> IO Bool
isXPMRW :: RWops -> IO Bool
isXPMRW RWops
rw
    = RWops -> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RWops
rw ((Ptr RWopsStruct -> IO Bool) -> IO Bool)
-> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr RWopsStruct
rwPtr ->
      (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Ptr RWopsStruct -> IO Int
imgIsXPM Ptr RWopsStruct
rwPtr)

isXPM :: FilePath -> IO Bool
isXPM :: String -> IO Bool
isXPM String
path = String -> String -> (RWops -> IO Bool) -> IO Bool
forall a. String -> String -> (RWops -> IO a) -> IO a
RW.with String
path String
"rb" ((RWops -> IO Bool) -> IO Bool) -> (RWops -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$
             RWops -> IO Bool
isXPMRW

-- int IMG_isXCF(SDL_RWops *src)
foreign import ccall unsafe "IMG_isXCF" imgIsXCF :: Ptr RWopsStruct -> IO Int
isXCFRW :: RWops -> IO Bool
isXCFRW :: RWops -> IO Bool
isXCFRW RWops
rw
    = RWops -> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RWops
rw ((Ptr RWopsStruct -> IO Bool) -> IO Bool)
-> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr RWopsStruct
rwPtr ->
      (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Ptr RWopsStruct -> IO Int
imgIsXCF Ptr RWopsStruct
rwPtr)

isXCF :: FilePath -> IO Bool
isXCF :: String -> IO Bool
isXCF String
path = String -> String -> (RWops -> IO Bool) -> IO Bool
forall a. String -> String -> (RWops -> IO a) -> IO a
RW.with String
path String
"rb" ((RWops -> IO Bool) -> IO Bool) -> (RWops -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$
             RWops -> IO Bool
isXCFRW


-- int IMG_isPCX(SDL_RWops *src)
foreign import ccall unsafe "IMG_isPCX" imgIsPCX :: Ptr RWopsStruct -> IO Int
isPCXRW :: RWops -> IO Bool
isPCXRW :: RWops -> IO Bool
isPCXRW RWops
rw
    = RWops -> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RWops
rw ((Ptr RWopsStruct -> IO Bool) -> IO Bool)
-> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr RWopsStruct
rwPtr ->
      (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Ptr RWopsStruct -> IO Int
imgIsPCX Ptr RWopsStruct
rwPtr)

isPCX :: FilePath -> IO Bool
isPCX :: String -> IO Bool
isPCX String
path = String -> String -> (RWops -> IO Bool) -> IO Bool
forall a. String -> String -> (RWops -> IO a) -> IO a
RW.with String
path String
"rb" ((RWops -> IO Bool) -> IO Bool) -> (RWops -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$
             RWops -> IO Bool
isPCXRW


-- int IMG_isGIF(SDL_RWops *src)
foreign import ccall unsafe "IMG_isGIF" imgIsGIF :: Ptr RWopsStruct -> IO Int
isGIFRW :: RWops -> IO Bool
isGIFRW :: RWops -> IO Bool
isGIFRW RWops
rw
    = RWops -> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RWops
rw ((Ptr RWopsStruct -> IO Bool) -> IO Bool)
-> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr RWopsStruct
rwPtr ->
      (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Ptr RWopsStruct -> IO Int
imgIsGIF Ptr RWopsStruct
rwPtr)

isGIF :: FilePath -> IO Bool
isGIF :: String -> IO Bool
isGIF String
path = String -> String -> (RWops -> IO Bool) -> IO Bool
forall a. String -> String -> (RWops -> IO a) -> IO a
RW.with String
path String
"rb" ((RWops -> IO Bool) -> IO Bool) -> (RWops -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$
             RWops -> IO Bool
isGIFRW


-- int IMG_isJPG(SDL_RWops *src)
foreign import ccall unsafe "IMG_isJPG" imgIsJPG :: Ptr RWopsStruct -> IO Int
isJPGRW :: RWops -> IO Bool
isJPGRW :: RWops -> IO Bool
isJPGRW RWops
rw
    = RWops -> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RWops
rw ((Ptr RWopsStruct -> IO Bool) -> IO Bool)
-> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr RWopsStruct
rwPtr ->
      (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Ptr RWopsStruct -> IO Int
imgIsJPG Ptr RWopsStruct
rwPtr)

isJPG :: FilePath -> IO Bool
isJPG :: String -> IO Bool
isJPG String
path = String -> String -> (RWops -> IO Bool) -> IO Bool
forall a. String -> String -> (RWops -> IO a) -> IO a
RW.with String
path String
"rb" ((RWops -> IO Bool) -> IO Bool) -> (RWops -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$
             RWops -> IO Bool
isJPGRW


-- int IMG_isTIF(SDL_RWops *src)
foreign import ccall unsafe "IMG_isTIF" imgIsTIF :: Ptr RWopsStruct -> IO Int
isTIFRW :: RWops -> IO Bool
isTIFRW :: RWops -> IO Bool
isTIFRW RWops
rw
    = RWops -> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RWops
rw ((Ptr RWopsStruct -> IO Bool) -> IO Bool)
-> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr RWopsStruct
rwPtr ->
      (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Ptr RWopsStruct -> IO Int
imgIsTIF Ptr RWopsStruct
rwPtr)

isTIF :: FilePath -> IO Bool
isTIF :: String -> IO Bool
isTIF String
path = String -> String -> (RWops -> IO Bool) -> IO Bool
forall a. String -> String -> (RWops -> IO a) -> IO a
RW.with String
path String
"rb" ((RWops -> IO Bool) -> IO Bool) -> (RWops -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$
             RWops -> IO Bool
isTIFRW


-- int IMG_isPNG(SDL_RWops *src)
foreign import ccall unsafe "IMG_isPNG" imgIsPNG :: Ptr RWopsStruct -> IO Int
isPNGRW :: RWops -> IO Bool
isPNGRW :: RWops -> IO Bool
isPNGRW RWops
rw
    = RWops -> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RWops
rw ((Ptr RWopsStruct -> IO Bool) -> IO Bool)
-> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr RWopsStruct
rwPtr ->
      (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Ptr RWopsStruct -> IO Int
imgIsPNG Ptr RWopsStruct
rwPtr)

isPNG :: FilePath -> IO Bool
isPNG :: String -> IO Bool
isPNG String
path = String -> String -> (RWops -> IO Bool) -> IO Bool
forall a. String -> String -> (RWops -> IO a) -> IO a
RW.with String
path String
"rb" ((RWops -> IO Bool) -> IO Bool) -> (RWops -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$
             RWops -> IO Bool
isPNGRW


-- int IMG_isLBM(SDL_RWops *src)
foreign import ccall unsafe "IMG_isLBM" imgIsLBM :: Ptr RWopsStruct -> IO Int
isLBMRW :: RWops -> IO Bool
isLBMRW :: RWops -> IO Bool
isLBMRW RWops
rw
    = RWops -> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr RWops
rw ((Ptr RWopsStruct -> IO Bool) -> IO Bool)
-> (Ptr RWopsStruct -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr RWopsStruct
rwPtr ->
      (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Ptr RWopsStruct -> IO Int
imgIsLBM Ptr RWopsStruct
rwPtr)

isLBM :: FilePath -> IO Bool
isLBM :: String -> IO Bool
isLBM String
path = String -> String -> (RWops -> IO Bool) -> IO Bool
forall a. String -> String -> (RWops -> IO a) -> IO a
RW.with String
path String
"rb" ((RWops -> IO Bool) -> IO Bool) -> (RWops -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$
             RWops -> IO Bool
isLBMRW