module Codec.Image.DevIL
( ilInit
, readImage, writeImage, writeImageFromPtr
, Word8
)
where
import Data.Int
import Data.Word
import Foreign hiding (newArray)
import Foreign.C
import Data.Array.Storable
import Data.Array.Unboxed
import Control.Applicative
import Control.Monad
import System.IO.Unsafe (unsafeInterleaveIO)
type ILuint = Word32
type ILsizei = Word32
type ILboolean = Word8
type ILenum = Word32
type ILint = Int32
type ILubyte = Word8
newtype ImageName = ImageName { fromImageName :: ILuint }
foreign import CALLTYPE "ilInit" ilInitC :: IO ()
foreign import CALLTYPE "ilOriginFunc" ilOriginFuncC :: ILenum -> IO ILboolean
foreign import CALLTYPE "ilEnable" ilEnableC :: ILenum -> IO ILboolean
ilInit :: IO ()
ilInit = do
ilInitC
ilOriginFuncC (1537)
ilEnableC (1536)
return ()
readImage :: FilePath -> IO (UArray (Int,Int,Int) Word8)
readImage x =
do [inname] <- ilGenImages 1
ilBindImage inname
ilLoadImage x
a <- toArrayRGBA
ilDeleteImages [inname]
return a
writeImage :: FilePath -> UArray (Int,Int,Int) Word8 -> IO ()
writeImage f a =
do [outname] <- ilGenImages 1
ilBindImage outname
fromArrayRGBA a
ilSaveImage f
ilDeleteImages [outname]
foreign import CALLTYPE "ilGenImages" ilGenImagesC
:: ILsizei -> Ptr ILuint -> IO ()
ilGenImages :: Int -> IO [ImageName]
ilGenImages num = do
ar <- newArray (0, num1) 0
withStorableArray ar $ \p -> do
ilGenImagesC (fromIntegral num) p
map ImageName <$> getElems ar
foreign import CALLTYPE "ilBindImage" ilBindImageC :: ILuint -> IO ()
ilBindImage :: ImageName -> IO ()
ilBindImage (ImageName name) = ilBindImageC name
foreign import CALLTYPE "ilDeleteImages" ilDeleteImagesC
:: ILsizei -> Ptr ILuint -> IO ()
ilDeleteImages :: [ImageName] -> IO ()
ilDeleteImages names = do
ar <- newListArray (0, length names1) (fromImageName <$> names)
withStorableArray ar $ \p -> do
ilDeleteImagesC (fromIntegral $ length names) p
foreign import CALLTYPE "ilLoadImage" ilLoadImageC :: CString -> IO ILboolean
ilLoadImage :: FilePath -> IO Bool
ilLoadImage file = do
(0 /=) <$> withCString file ilLoadImageC
foreign import CALLTYPE "ilSaveImage" ilSaveImageC :: CString -> IO ILboolean
ilSaveImage :: FilePath -> IO Bool
ilSaveImage file = do
(0 /=) <$> withCString file ilSaveImageC
foreign import CALLTYPE "ilConvertImage" ilConvertImageC
:: ILenum -> ILenum -> IO Bool
foreign import CALLTYPE "ilGetInteger" ilGetIntegerC
:: ILenum -> IO ILint
foreign import CALLTYPE "ilCopyPixels" ilCopyPixelsC
:: ILuint -> ILuint -> ILuint
-> ILuint -> ILuint -> ILuint
-> ILenum -> ILenum
-> Ptr ()
-> IO ()
foreign import CALLTYPE "ilSetPixels" ilSetPixelsC
:: ILuint -> ILuint -> ILuint
-> ILuint -> ILuint -> ILuint
-> ILenum -> ILenum
-> Ptr ()
-> IO ()
foreign import CALLTYPE "ilTexImage" ilTexImageC
:: ILuint -> ILuint -> ILuint
-> ILubyte -> ILenum -> ILenum
-> Ptr ()
-> IO Bool
il_RGBA = (6408) :: ILenum
il_UNSIGNED_BYTE = (5121) :: ILenum
il_IMAGE_HEIGHT = (3557) :: ILenum
il_IMAGE_WIDTH = (3556) :: ILenum
toArrayRGBA :: IO (UArray (Int,Int,Int) Word8)
toArrayRGBA = do
columns <- ilGetIntegerC il_IMAGE_WIDTH
rows <- ilGetIntegerC il_IMAGE_HEIGHT
let bounds = ((0,0,0), (fromIntegral rows1, fromIntegral columns1, 3))
ar <- newArray_ bounds
withStorableArray ar $ \p -> do
ilCopyPixelsC 0 0 0
(fromIntegral columns) (fromIntegral rows) 1
il_RGBA il_UNSIGNED_BYTE
(castPtr p)
listArray bounds <$> lazyElems ar
lazyElems ar = do
ixs <- range <$> getBounds ar
go ixs
where
go [] = return []
go (ix:ixs) = unsafeInterleaveIO $ liftM2 (:) (readArray ar ix) (go ixs)
fromArrayRGBA :: UArray (Int,Int,Int) Word8 -> IO ()
fromArrayRGBA dat = do
let ((0,0,0), (maxrow,maxcol,3)) = bounds dat
ar <- unsafeThaw dat
withStorableArray ar $ \p -> do
ilTexImageC (fromIntegral maxcol+1) (fromIntegral maxrow+1) 1
4 il_RGBA il_UNSIGNED_BYTE
(castPtr p)
return ()
writeImageFromPtr :: FilePath -> (Int,Int) -> Ptr Word8 -> IO ()
writeImageFromPtr f (rows,cols) p = do
[outname] <- ilGenImages 1
ilBindImage outname
fromPtrRGBA (rows,cols) p
ilSaveImage f
ilDeleteImages [outname]
fromPtrRGBA :: (Int,Int) -> Ptr Word8 -> IO ()
fromPtrRGBA (rows,cols) p = do
ilTexImageC (fromIntegral cols) (fromIntegral rows) 1
4 il_RGBA il_UNSIGNED_BYTE
(castPtr p)
return ()