module Codec.Image.STB
( Image
, withImage
, rawImage
, resolution
, components
, decodeImage
, loadImage
) where
import Control.Monad (liftM)
import Control.Exception
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Foreign
import Foreign.C
import System.IO
import System.IO.Error
#if (__GLASGOW_HASKELL__ == 606)
import Data.ByteString.Base
#else
import Data.ByteString.Internal
#endif
data Image = Image
{ i_ptr :: ImgPtr
, i_res :: (Int,Int)
, i_fmt :: Format
}
type Format = Int
type ImgPtr = ByteString
withImgPtr :: ImgPtr -> (Ptr Word8 -> Int -> IO a) -> IO a
withImgPtr bs f = withForeignPtr fptr g where
(fptr,ofs,len) = toForeignPtr bs
g q = f (plusPtr q ofs) len
withImage :: (Integral a, Integral b) => Image -> (Ptr Word8 -> (a,a) -> b -> IO c) -> IO c
withImage (Image imgptr (x,y) comp) f = withImgPtr imgptr g where
g p _ = f p (fromIntegral x , fromIntegral y) (fromIntegral comp)
rawImage :: Image -> ByteString
rawImage (Image bs _ _) = bs
resolution :: Integral a => Image -> (a,a)
resolution (Image _ (x,y) _) = (fromIntegral x , fromIntegral y)
components :: Integral a => Image -> a
components (Image _ _ c) = fromIntegral c
foreign import ccall safe "stb_image.h stbi_load_from_memory"
stbi_load_from_memory :: Ptr Word8 -> CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> CInt -> IO (Ptr Word8)
foreign import ccall safe "stb_image.h &stbi_image_free"
stbi_image_free :: FunPtr (Ptr a -> IO ())
foreign import ccall safe "stb_image.h stbi_failure_reason"
stbi_failure_reason :: IO (Ptr CChar)
decodeImage :: ByteString -> IO (Either String Image)
decodeImage = decodeImage' 0
decodeImage' :: Int -> ByteString -> IO (Either String Image)
decodeImage' forcecomp bs = let (fptr,ofs,len) = toForeignPtr bs in withForeignPtr fptr $ \q -> do
let ptr = plusPtr q ofs
alloca $ \pxres -> alloca $ \pyres -> alloca $ \pcomp -> do
r <- stbi_load_from_memory ptr (fromIntegral len) pxres pyres pcomp (fromIntegral forcecomp)
if r == nullPtr
then do
e <- stbi_failure_reason
msg <- peekCString e
return $ Left msg
else do
fr <- newForeignPtr stbi_image_free r
xres <- liftM fromIntegral $ peek pxres
yres <- liftM fromIntegral $ peek pyres
comp <- liftM fromIntegral $ peek pcomp
let imgptr = fromForeignPtr fr 0 (xres*yres*comp)
return $ Right $ Image imgptr (xres,yres) comp
#if (BASE_MAJOR_VERSION >= 4)
ioHandler :: IOException -> IO (Either String a)
ioHandler ioerror = return $ Left $ "IO error: " ++ ioeGetErrorString ioerror
#else
ioHandler :: Exception -> IO (Either String a)
ioHandler (IOException ioerror) = return $ Left $ "IO error: " ++ ioeGetErrorString ioerror
ioHandler _ = return $ Left "Unknown error"
#endif
loadImage :: FilePath -> IO (Either String Image)
loadImage path = handle ioHandler $ do
h <- openBinaryFile path ReadMode
b <- B.hGetContents h
hClose h
decodeImage b