diff --git a/Data/Array/Repa/IO/DevIL.hs b/Data/Array/Repa/IO/DevIL.hs deleted file mode 100644 --- a/Data/Array/Repa/IO/DevIL.hs +++ /dev/null @@ -1,129 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - --- | --- Module : Data/Array/Repa/IO/DevIL.hs --- Copyright : (c) Don Stewart 2011 --- --- License : BSD3 --- --- Maintainer: Don Stewart --- Stability : provisional --- Portability: Repa interface to the DevIL image loading library. --- --- Read and write images in many formats, representing them in Haskell --- as a 3-dimensional /repa/ array. Image parsing and decoding is done --- by the /Developers Image Library/, DevIL. --- --- * Many formats are supported, including .png, .bmp, .jpg, .tif --- --- * Image format parsing is determined by the filepath extension type. --- --- Example: read a .png file into a 3D repa array, and write it out as a .jpg --- --- > main = runIL $ do --- > x <- readImage "/tmp/y.png" --- > writeImage "/tmp/x.jpg" x --- --- Note that as DevIL is stateful, we ensure the library is initialized --- by running image manipulation functions in the /IL/ monad, a wrapper --- over IO that ensures the library has been initialized. It is a type --- error to call image functions outside of the /IL/ monad. --- - -module Data.Array.Repa.IO.DevIL ( - - -- * The IL monad - runIL, IL, - - -- * Image IO - readImage, writeImage - - ) where - --- transformers -import Control.Monad.IO.Class (MonadIO(..)) - --- codec-image-devil -import qualified Codec.Image.DevIL as D - --- repa -import qualified Data.Array.Repa as R -import Data.Array.Repa - --- base / arrays -import Data.Array.Base -import Data.Word - ------------------------------------------------------------------------- - --- | The IL monad. Provides statically-guaranteed access to an initialized IL context. -newtype IL a = IL { unIL :: IO a } - deriving (Monad, MonadIO) - --- | Running code in the /IL/ monad. This is a simple wrapper over /IO/ --- that guarantees the DevIL library has been initialized before you run --- functions on it. --- -runIL :: IL a -> IO a -runIL (IL a) = do - D.ilInit - a - --- | Reads an image into an RGBA array. Indices are (row,column,color-channel). --- --- Example: --- --- > main = do --- > x <- runIL $ readImage "/tmp/x.png" --- > .. operations on x .. --- --- --- /Note:/ The image input type is determined by the filename extension. --- -readImage :: FilePath -> IL (R.Array DIM3 Word8) -readImage f = do - uarr <- liftIO (D.readImage f) :: IL (UArray (Int, Int, Int) Word8) - return $! toRepa uarr -{-# INLINE readImage #-} - --- | Writes an RGBA array to a file. Indices are the row, column, and color-channel. --- --- /Note:/ The image output type is determined by the filename extension. --- -writeImage :: FilePath -> R.Array DIM3 Word8 -> IL () -writeImage f a = do - liftIO $ D.writeImage f (fromRepa a) -{-# INLINE writeImage #-} - ------------------------------------------------------------------------- - --- lazily stream an unboxed (3d) array to a repa array -toRepa :: UArray (Int,Int,Int) Word8 -> R.Array DIM3 Word8 -toRepa uarr = - let ((ni,nj,nk),(mi, mj, mk)) = bounds uarr - (i,j,k) = (1 + mi - ni, 1 + mj - nj, 1 + mk - nk) - es = elems uarr - in R.fromList (R.Z :. i :. j :. k) es -{-# INLINE toRepa #-} - --- lazily stream a repa array to an unboxed (3d) array -fromRepa :: R.Array DIM3 Word8 -> UArray (Int,Int,Int) Word8 -fromRepa arr = - let es = R.toList arr - (R.Z :. i :. j :. k) = extent arr - in listArray ((0,0,0), (i-1, j-1, k-1)) es -{-# INLINE fromRepa #-} - -{- - -TODO: O(1) conversion: - -toRepa uarr@(UArray l u n arr) = undefined - - -- data UArray i e = UArray !i !i !Int ByteArray# - - -- data Vector a = Vector {-# UNPACK #-} !Int - {-# UNPACK #-} !Int - {-# UNPACK #-} !ByteArray --} - diff --git a/Data/Array/Repa/IO/DevIL.hsc b/Data/Array/Repa/IO/DevIL.hsc new file mode 100644 --- /dev/null +++ b/Data/Array/Repa/IO/DevIL.hsc @@ -0,0 +1,261 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- | +-- Module : Data/Array/Repa/IO/DevIL.hs +-- Copyright : (c) Don Stewart 2011, Raphael Javaux 2012 +-- +-- License : BSD3 +-- +-- Maintainer: Don Stewart +-- , Raphael Javaux main = runIL $ do +-- > x <- readImage "/tmp/y.png" +-- > writeImage "/tmp/x.jpg" x +-- +-- Note that as DevIL is stateful, we ensure the library is initialized +-- by running image manipulation functions in the /IL/ monad, a wrapper +-- over IO that ensures the library has been initialized. It is a type +-- error to call image functions outside of the /IL/ monad. +-- + +module Data.Array.Repa.IO.DevIL ( + -- * The Image array type + Image (..) + + -- * The IL monad + , IL, runIL + + -- * Image IO + , readImage, writeImage + ) where + +import Control.Applicative (Applicative, (<$>)) +import Control.Monad (when) +import Control.Monad.IO.Class (MonadIO (..)) + +import Data.Int +import Data.Word + +import Foreign.C.String (CString, withCString) +import Foreign.ForeignPtr (withForeignPtr) +import Foreign.Concurrent (newForeignPtr) +import Foreign.Marshal.Alloc (alloca) +import Foreign.Ptr (Ptr, castPtr) +import Foreign.Storable (peek) +import Foreign.Marshal.Utils (with) + +import Data.Array.Repa (Array (..), Z (..), (:.) (..), DIM2, DIM3, extent) +import Data.Array.Repa.Repr.ForeignPtr (F, fromForeignPtr, toForeignPtr) + +#include "IL/il.h" + +type ILuint = #type ILuint +type ILsizei = #type ILsizei +type ILboolean = #type ILboolean +type ILenum = #type ILenum +type ILint = #type ILint +type ILubyte = #type ILubyte + +-- DevIL uses unsigned integers as names for each image in processing. +newtype ImageName = ImageName ILuint + +-- ---------------------------------------------------------------------- + +-- | RGBA and RGB images are 3D repa arrays where indices are +-- /Z :. row :. column :. color channel/. Grey images are 2D repa arrays. +-- +-- The origin (/Z :. 0 :. 0/) is on the lower left point of the image. +data Image = RGBA (Array F DIM3 Word8) + | RGB (Array F DIM3 Word8) + | Grey (Array F DIM2 Word8) + +-- | The IL monad. Provides statically-guaranteed access to an initialized IL +-- context. +newtype IL a = IL (IO a) + deriving (Monad, MonadIO, Functor, Applicative) + +-- | Running code in the /IL/ monad. This is a simple wrapper over /IO/ +-- that guarantees the DevIL library has been initialized before you run +-- functions on it. +runIL :: IL a -> IO a +runIL (IL a) = ilInit >> a +{-# INLINE runIL #-} + +-- | Reads an image into a repa array. It uses directly the C array using the +-- repa\'s foreign arrays wrapper. +-- +-- Example: +-- +-- > main = do +-- > x <- runIL $ readImage "/tmp/x.png" +-- > .. operations on x .. +-- +-- /Note:/ The image input type is determined by the filename extension. +readImage :: FilePath -> IL Image +readImage f = liftIO $ do + name <- ilGenImageName + ilBindImage name + + success <- ilLoadImage f + when (not success) $ + error "Unable to load the image." + + toRepa name + +-- | Writes an 'Image' to a file. The image array must be represented as foreign +-- buffers. You can use 'copyS' or 'copyP' to convert the array. +-- +-- /Note:/ The image output type is determined by the filename extension. +writeImage :: FilePath -> Image -> IL () +writeImage f i = liftIO $ do + name <- ilGenImageName + ilBindImage name + + successCopy <- fromRepa i + when (not successCopy) $ + error "Unable to copy the image to the DevIL buffer." + + successSave <- ilSaveImage f + when (not successSave) $ + error "Unable to the save the image to the file." + + ilDeleteImage name + +-- ---------------------------------------------------------------------- + +foreign import ccall "ilInit" ilInitC :: IO () +foreign import ccall "ilOriginFunc" ilOriginFuncC :: ILenum -> IO ILboolean +foreign import ccall "ilEnable" ilEnableC :: ILenum -> IO ILboolean + +-- | Initialize the library. +ilInit :: IO () +ilInit = do + ilInitC + -- By default, origin is undefined and depends on the image type + ilOriginFuncC (#const IL_ORIGIN_LOWER_LEFT) + ilEnableC (#const IL_ORIGIN_SET) + return () +{-# INLINE ilInit #-} + +foreign import ccall "ilGenImages" ilGenImagesC + :: ILsizei -> Ptr ILuint -> IO () + +-- | Allocates a new image name. +ilGenImageName :: IO ImageName +ilGenImageName = do + alloca $ \pName -> do + ilGenImagesC 1 pName + name <- peek pName + return $! ImageName name +{-# INLINE ilGenImageName #-} + +foreign import ccall "ilBindImage" ilBindImageC :: ILuint -> IO () + +-- | Sets the image name as the current image for processing. +ilBindImage :: ImageName -> IO () +ilBindImage (ImageName name) = ilBindImageC name +{-# INLINE ilBindImage #-} + +foreign import ccall "ilLoadImage" ilLoadImageC :: CString -> IO ILboolean + +-- | Loads the image as the current DevIL image name. +ilLoadImage :: FilePath -> IO Bool +ilLoadImage f = (0 /=) <$> withCString f ilLoadImageC +{-# INLINE ilLoadImage #-} + +foreign import ccall "ilGetInteger" ilGetIntegerC :: ILenum -> IO ILint + +il_RGB = (#const IL_RGB) :: ILint +il_RGBA = (#const IL_RGBA) :: ILint +il_LUMINANCE = (#const IL_LUMINANCE) :: ILint + +il_IMAGE_HEIGHT = (#const IL_IMAGE_HEIGHT) :: ILenum +il_IMAGE_WIDTH = (#const IL_IMAGE_WIDTH) :: ILenum +il_IMAGE_FORMAT = (#const IL_IMAGE_FORMAT) :: ILenum +il_UNSIGNED_BYTE = (#const IL_UNSIGNED_BYTE) :: ILenum + +foreign import ccall "ilGetData" ilGetDataC :: IO (Ptr ILubyte) + +-- | Puts the current image inside a repa array. +toRepa :: ImageName -> IO Image +toRepa name = do + width' <- ilGetIntegerC il_IMAGE_WIDTH + height' <- ilGetIntegerC il_IMAGE_HEIGHT + let (width, height) = (fromIntegral width', fromIntegral height') + format <- ilGetIntegerC il_IMAGE_FORMAT + pixels <- ilGetDataC + + -- Destroys the image when the array will be garbage collected + managedPixels <- newForeignPtr pixels (ilDeleteImage name) + + return $! imageFromFormat format width height managedPixels + where + -- Create an 'Image' object with the right format. + imageFromFormat format width height managedPixels + | format == il_RGB = + RGB $! fromForeignPtr (Z :. height :. width :. 3) managedPixels + | format == il_RGBA = + RGBA $! fromForeignPtr (Z :. height :. width :. 4) managedPixels + | format == il_LUMINANCE = + Grey $! fromForeignPtr (Z :. height :. width) managedPixels + | otherwise = + error "Unsupported image format." + {-# INLINE imageFromFormat #-} + +foreign import ccall "ilTexImage" ilTexImageC + :: ILuint -> ILuint -> ILuint -- w h depth + -> ILubyte -> ILenum -> ILenum -- numberOfChannels format type + -> Ptr () -- data (copy from this pointer) + -> IO ILboolean + +-- | Copies the repa array to the current image buffer. +fromRepa :: Image -> IO Bool +fromRepa (RGB i) = + let Z :. h :. w :. _ = extent i + in (0 /=) <$> (withForeignPtr (toForeignPtr i) $ \p -> + ilTexImageC (fromIntegral w) (fromIntegral h) 1 3 + (fromIntegral il_RGB) il_UNSIGNED_BYTE (castPtr p)) +fromRepa (RGBA i) = + let Z :. h :. w :. _ = extent i + in (0 /=) <$> (withForeignPtr (toForeignPtr i) $ \p -> + ilTexImageC (fromIntegral w) (fromIntegral h) 1 4 + (fromIntegral il_RGBA) il_UNSIGNED_BYTE (castPtr p)) +fromRepa (Grey i) = + let Z :. h :. w = extent i + in (0 /=) <$> (withForeignPtr (toForeignPtr i) $ \p -> + ilTexImageC (fromIntegral w) (fromIntegral h) 1 1 + (fromIntegral il_LUMINANCE) il_UNSIGNED_BYTE + (castPtr p)) + +foreign import ccall "ilSaveImage" ilSaveImageC :: CString -> IO ILboolean + +-- | Saves the current image. +ilSaveImage :: FilePath -> IO Bool +ilSaveImage file = do + (0 /=) <$> withCString file ilSaveImageC +{-# INLINE ilSaveImage #-} + +foreign import ccall "ilDeleteImages" ilDeleteImagesC + :: ILsizei -> Ptr ILuint -> IO () + +-- | Releases an image with its name. +ilDeleteImage :: ImageName -> IO () +ilDeleteImage (ImageName name) = + with name $ \pName -> + ilDeleteImagesC 1 pName +{-# INLINE ilDeleteImage #-} diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c)2011, Don Stewart +Copyright (c) 2011 Don Stewart, 2012 Raphael Javaux All rights reserved. diff --git a/repa-devil.cabal b/repa-devil.cabal --- a/repa-devil.cabal +++ b/repa-devil.cabal @@ -1,6 +1,6 @@ Name: repa-devil -Version: 0.1.2 -Synopsis: Support for image reading and writing of Repa arrays +Version: 0.3.0 +Synopsis: Support for image reading and writing of Repa arrays using in-place FFI calls Description: The repa-image library adds support for reading and writing images in many formats based on the DevIL @@ -24,40 +24,38 @@ . * -Homepage: http://code.haskell.org/~dons/code/repa-devil +Homepage: https://github.com/RaphaelJ/repa-devil License: BSD3 License-file: LICENSE -Author: Don Stewart -Maintainer: dons00@gmail.com -Copyright: Don Stewart (c) 2011 +Author: Don Stewart, Raphael Javaux +Maintainer: Raphael Javaux +Copyright: Don Stewart (c) 2011, Raphael Javaux (c) 2012 Category: Data Structures Build-type: Simple Cabal-version: >=1.6 + Library - Exposed-modules: --- Note: future versions will use their own binding --- Image.DevIL.Base + Exposed-modules: Data.Array.Repa.IO.DevIL - -- Packages needed in order to build this package. Build-depends: - base >= 3 && < 5, - array >= 0.3 && < 0.4, - repa >= 2 && < 2.3, - Codec-Image-DevIL >= 0.2 && < 0.3, + base >= 4.5 && < 5.0, + repa >= 3.1.0.0 && < 4.0, transformers >= 0.2 && < 0.3 Build-tools: hsc2hs + + GHC-Options: -Wall Extensions: CPP, ForeignFunctionInterface --- Extra-Libraries: IL + Extra-Libraries: + IL source-repository head - type: darcs - location: http://code.haskell.org/~dons/code/repa-devil - + type: git + location: https://github.com/RaphaelJ/repa-devil