stb-image 0.1.3 → 0.2
raw patch · 4 files changed
+141/−113 lines, 4 filesdep +bitmapdep ~basedep ~bytestring
Dependencies added: bitmap
Dependency ranges changed: base, bytestring
Files
- Codec/Image/STB.hs +40/−75
- cbits/stb_image.h +54/−0
- example/viewer.hs +35/−32
- stb-image.cabal +12/−6
Codec/Image/STB.hs view
@@ -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 <http://nothings.org/stb_image.c>. -- 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 + +--------------------------------------------------------------------------------
+ cbits/stb_image.h view
@@ -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
example/viewer.hs view
@@ -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)+ +--------------------------------------------------------------------------------
stb-image.cabal view
@@ -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