diff --git a/Codec/Image/STB.hs b/Codec/Image/STB.hs --- a/Codec/Image/STB.hs +++ b/Codec/Image/STB.hs @@ -1,16 +1,16 @@ --- +-------------------------------------------------------------------------------- -- Module : Codec.Image.STB --- Version : 0.1.2 +-- Version : 0.2 -- License : Public Domain -- Author : Balazs Komuves -- Maintainer : bkomuves (plus) hackage (at) gmail (dot) com -- Stability : experimental -- Portability : portable(?), requires FFI and CPP -- Tested with : GHC 6.10.1 --- +-------------------------------------------------------------------------------- --- |A wrapper around @stb_image@, Sean Barrett's public domain JPEG\/PNG decoder. +-- | A wrapper around @stb_image@, Sean Barrett's public domain JPEG\/PNG decoder. -- The original can be found at . -- The version of @stb_image@ used here is @stbi-1.18@. -- The current list of (partially) supported formats is JPEG, PNG, TGA, BMP, PSD. @@ -19,16 +19,18 @@ {-# LANGUAGE ForeignFunctionInterface, CPP #-} {-# CFILES cbits/stb_image.c #-} -- for Hugs (?) module Codec.Image.STB - ( Image - , withImage - , rawImage - , resolution - , components + ( Bitmap + , Image , decodeImage + , decodeImage' , loadImage , loadImage' ) where +-------------------------------------------------------------------------------- + +import Data.Bitmap.IO + import Control.Monad (liftM) import Control.Exception import Data.ByteString (ByteString) @@ -44,54 +46,11 @@ import Data.ByteString.Internal #endif --- |The type representing a simple rectangular image. --- Internally it stores the resolution, the pixel format, and the raw pixel data --- as a strict 'ByteString'. -data Image = Image - { i_ptr :: ImgPtr -- ^ \"pointer\" to the raw data - , i_res :: (Int,Int) -- ^ resolution - , i_fmt :: Format -- ^ pixel format - } - -type Format = Int -- number of components, see below -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 - -{-# SPECIALIZE withImage :: Image -> (Ptr Word8 -> (Int,Int) -> Int -> IO b) -> IO b #-} - --- |Access to the raw data. The user action receives a pointer, the spatial resolution and the --- number of (8-bit) components per pixel. --- --- Data format (bytes per pixel -> components): --- --- * 1 -> grey --- --- * 2 -> grey, alpha --- --- * 3 -> red, green, blue --- --- * 4 -> red, green, blue, alpha -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) +-------------------------------------------------------------------------------- --- |Access the raw data as a strict 'ByteString'. -rawImage :: Image -> ByteString -rawImage (Image bs _ _) = bs - -{-# SPECIALIZE resolution :: Image -> (Int,Int) #-} --- |Returns the spatial resolution of an image. -resolution :: Integral a => Image -> (a,a) -resolution (Image _ (x,y) _) = (fromIntegral x , fromIntegral y) +type Image = Bitmap Word8 -{-# SPECIALIZE components :: Image -> Int #-} --- |Returns the number of (8-bit) components per pixel. -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) @@ -102,6 +61,8 @@ foreign import ccall safe "stb_image.h stbi_failure_reason" stbi_failure_reason :: IO (Ptr CChar) +-------------------------------------------------------------------------------- + -- |Decodes an image from a compressed format stored in a strict 'ByteString'. -- Supported formats (see @stb_image.c@ for details!): -- @@ -115,28 +76,30 @@ -- -- * PSD (composite view only, no extra channels) -- --- If the operation fails, returns an error message. +-- If the operation fails, we return an error message. decodeImage :: ByteString -> IO (Either String Image) decodeImage = decodeImage' 0 --- |Decodes an image, with the number of components per pixel forced by the user. +-- | Decodes an image, with the number of components per pixel forced by the user. 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 +decodeImage' forcecomp bs = do + let (fptr,ofs,len) = toForeignPtr bs + 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 bm = bitmapFromForeignPtrUnsafe (xres,yres) comp 1 0 fr + return (Right bm) #if (BASE_MAJOR_VERSION >= 4) @@ -153,7 +116,7 @@ #endif --- |Loads an image from a file. Catches IO exceptions and converts them to an error message. +-- | Loads an image from a file. Catches IO exceptions and converts them to an error message. loadImage :: FilePath -> IO (Either String Image) loadImage path = handle ioHandler $ do h <- openBinaryFile path ReadMode @@ -161,11 +124,13 @@ hClose h decodeImage b --- |Force the number of components in the image. +-- | Force the number of components in the image. loadImage':: FilePath -> Int -> IO (Either String Image) loadImage' path ncomps = handle ioHandler $ do h <- openBinaryFile path ReadMode b <- B.hGetContents h hClose h decodeImage' ncomps b + +-------------------------------------------------------------------------------- diff --git a/cbits/stb_image.h b/cbits/stb_image.h new file mode 100644 --- /dev/null +++ b/cbits/stb_image.h @@ -0,0 +1,54 @@ + +typedef unsigned char stbi_uc; + +#ifdef __cplusplus +extern "C" { +#endif + +extern stbi_uc *stbi_load_from_memory(stbi_uc *buffer, int len, int *x, int *y, int *comp, int req_comp); + +#ifndef STBI_NO_HDR +extern float *stbi_loadf_from_memory(stbi_uc *buffer, int len, int *x, int *y, int *comp, int req_comp); +extern void stbi_hdr_to_ldr_gamma(float gamma); +extern void stbi_hdr_to_ldr_scale(float scale); +extern void stbi_ldr_to_hdr_gamma(float gamma); +extern void stbi_ldr_to_hdr_scale(float scale); +#endif // STBI_NO_HDR + +extern char *stbi_failure_reason (void); + +// free the loaded image -- this is just free() +extern void stbi_image_free (void *retval_from_stbi_load); + +// get image dimensions & components without fully decoding +extern int stbi_info_from_memory(stbi_uc *buffer, int len, int *x, int *y, int *comp); +extern int stbi_is_hdr_from_memory(stbi_uc *buffer, int len); + +// format tests +extern int stbi_jpeg_test_memory (stbi_uc *buffer, int len); +extern int stbi_png_test_memory (stbi_uc *buffer, int len); +extern int stbi_bmp_test_memory (stbi_uc *buffer, int len); +extern int stbi_tga_test_memory (stbi_uc *buffer, int len); +extern int stbi_psd_test_memory (stbi_uc *buffer, int len); +extern int stbi_hdr_test_memory (stbi_uc *buffer, int len); + +#if !defined(STBI_NO_WRITE) && !defined(STBI_NO_STDIO) +// write a BMP/TGA file given tightly packed 'comp' channels (no padding, nor bmp-stride-padding) +// (you must include the appropriate extension in the filename). +// returns TRUE on success, FALSE if couldn't open file, error writing file +extern int stbi_write_bmp (char *filename, int x, int y, int comp, void *data); +extern int stbi_write_tga (char *filename, int x, int y, int comp, void *data); +#endif + +// ZLIB client - used by PNG, available for other purposes + +extern char *stbi_zlib_decode_malloc_guesssize(int initial_size, int *outlen); +extern char *stbi_zlib_decode_malloc(char *buffer, int len, int *outlen); +extern int stbi_zlib_decode_buffer(char *obuffer, int olen, char *ibuffer, int ilen); + +extern char *stbi_zlib_decode_noheader_malloc(char *buffer, int len, int *outlen); +extern int stbi_zlib_decode_noheader_buffer(char *obuffer, int olen, char *ibuffer, int ilen); + +#ifdef __cplusplus +} +#endif diff --git a/example/viewer.hs b/example/viewer.hs --- a/example/viewer.hs +++ b/example/viewer.hs @@ -1,13 +1,19 @@ --- |Very simple image viewer using OpenGL\/GLUT, provided as an example\/test for 'Codec.Image.STB'. +-- | Very simple image viewer using OpenGL\/GLUT, provided +-- as an example\/test for 'Codec.Image.STB'. module Main where +-------------------------------------------------------------------------------- + import Data.Bits import Graphics.Rendering.OpenGL import Graphics.UI.GLUT +import Data.Bitmap.IO +import Data.Bitmap.OpenGL + import Codec.Image.STB import System.Environment @@ -15,8 +21,10 @@ import System.IO.Unsafe import Control.Monad -import Foreign +--import Foreign +-------------------------------------------------------------------------------- + main = do initialDisplayMode $= [ RGBAMode, DoubleBuffered ] @@ -31,26 +39,16 @@ Left err -> putStrLn err >> exitFailure Right img -> return img - withImage img $ \p (x,y) c -> do - putStrLn $ "\"" ++ fname ++ "\" loaded" - putStrLn $ "resolution = " ++ show x ++ " x " ++ show y ++ ", " ++ show c ++ " bytes per pixel" + let (x,y) = bitmapSize img + c = bitmapNChannels img + putStrLn $ "\"" ++ fname ++ "\" loaded" + putStrLn $ "resolution = " ++ show x ++ " x " ++ show y ++ ", " ++ show c ++ " bytes per pixel" + createWindow ("viewer - " ++ show fname) - tex <- withExtendedImage img $ \p (x,y) c -> do - let (pf,pif) = case c of - { 1 -> ( Luminance, Luminance8 ) - ; 2 -> ( LuminanceAlpha, Luminance8Alpha8 ) - ; 3 -> ( RGB, RGB8 ) - ; 4 -> ( RGBA, RGBA8 ) - } - let size = TextureSize2D (fromIntegral x) (fromIntegral y) - pdata = PixelData pf UnsignedByte p - [tex] <- genObjectNames 1 - textureBinding Texture2D $= Just tex - texImage2D Nothing NoProxy 0 pif size 0 pdata - textureFilter Texture2D $= ((Linear',Nothing),Linear') - return tex + eimg <- extendImage img + tex <- makeSimpleBitmapTexture eimg displayCallback $= display img tex reshapeCallback $= Just reshape @@ -69,17 +67,22 @@ case key of Char '\ESC' -> exitWith ExitSuccess _ -> return () + +-------------------------------------------------------------------------------- -- glVertex2d / glTexCoord2d, convenient because the OpenGL vertex / texCoord functions are too polymorphic vt :: Double -> Double -> IO () -vt x y = vertex (Vertex2 x y) +vt x y = vertex (Vertex2 (realToFrac x :: GLdouble) (realToFrac y :: GLdouble)) tc :: Double -> Double -> IO () -tc x y = texCoord (TexCoord2 x y) +tc x y = texCoord (TexCoord2 (realToFrac x :: GLdouble) (realToFrac y :: GLdouble)) +-------------------------------------------------------------------------------- + -- display callback -display img tex = withImage img $ \_ (xsize,ysize) _ -> do +display img tex = do + let (xsize,ysize) = bitmapSize img clear [ColorBuffer] size@(Size xres yres) <- get windowSize @@ -102,6 +105,8 @@ swapBuffers +-------------------------------------------------------------------------------- + log2 :: Int -> Int log2 n = case n of 0 -> -1 @@ -110,14 +115,12 @@ nextPowerOfTwo :: Int -> Int nextPowerOfTwo n = 2 ^ ( 1 + log2 (n-1) ) --- extend the image to have power-of-two sizes -withExtendedImage :: Image -> (Ptr Word8 -> (Int,Int) -> Int -> IO a) -> IO a -withExtendedImage img action = withImage img $ \p (oldx,oldy) c -> do - let (newx,newy) = (nextPowerOfTwo oldx, nextPowerOfTwo oldy) - allocaArray (newx*newy*c) $ \q -> do - forM_ [0..oldy-1] $ \i -> copyArray - (q `advancePtr` (i*c*newx)) -- destination - (p `advancePtr` (i*c*oldx)) -- source - (oldx*c) -- number of bytes - action q (newx,newy) c +-- extend the image to have power-of-two sizes, for old videocards +extendImage :: Image -> IO Image +extendImage bm = do + let (oldx,oldy) = bitmapSize bm + (newx,newy) = (nextPowerOfTwo oldx, nextPowerOfTwo newx) + copySubImage' bm (0,0) (oldx,oldy) (newx,newy) (0,0) + +-------------------------------------------------------------------------------- diff --git a/stb-image.cabal b/stb-image.cabal --- a/stb-image.cabal +++ b/stb-image.cabal @@ -1,5 +1,5 @@ Name: stb-image -Version: 0.1.3 +Version: 0.2 Synopsis: A wrapper around Sean Barrett's JPEG/PNG decoder Description: Partial implementation of JPEG, PNG, TGA, BMP, PSD decoders, with a really simple API. @@ -9,12 +9,14 @@ Maintainer: bkomuves (plus) hackage (at) gmail (dot) com Homepage: http://code.haskell.org/~bkomuves/ Stability: Experimental -Category: Codec +Category: Codec, Graphics Tested-With: GHC == 6.10.1, GHC == 6.8.3 Cabal-Version: >= 1.2 Build-Type: Simple -Extra-Source-Files: example/viewer.hs +Extra-Source-Files: example/viewer.hs, + cbits/stb_image.h + Flag splitBase Description: Choose the new smaller, split-up base package. @@ -23,9 +25,10 @@ Library if flag(splitBase) - Build-Depends: bytestring + Build-Depends: bytestring >= 0.9, + bitmap < 0.1 if flag(base4) - Build-Depends: base >= 4 + Build-Depends: base >= 4 && < 5 cpp-options: -DBASE_MAJOR_VERSION=4 else Build-Depends: base >= 3 && < 4 @@ -35,9 +38,12 @@ cpp-options: -DBASE_MAJOR_VERSION=2 Exposed-Modules: Codec.Image.STB + Hs-Source-Dirs: . Extensions: ForeignFunctionInterface, CPP ghc-options: -Wall + C-Sources: cbits/stb_image.c Include-Dirs: cbits - cc-options: -DSTBI_NO_HDR -DSTBI_NO_STDIO -DSTBI_FAILURE_USERMSG + + cc-options: -O3 -DSTBI_NO_HDR -DSTBI_NO_STDIO -DSTBI_FAILURE_USERMSG