diff --git a/Graphics/GD.hsc b/Graphics/GD.hsc --- a/Graphics/GD.hsc +++ b/Graphics/GD.hsc @@ -40,14 +40,15 @@ rgb, rgba ) where -import Control.Exception (bracket) -import Control.Monad (liftM, unless) +import Control.Exception (bracket) +import Control.Monad (liftM, unless) import qualified Data.ByteString.Internal as B -import Foreign -import Foreign.C -import Foreign.ForeignPtr -import Foreign.Marshal.Error -import System.IO.Error +import Foreign (Ptr,FunPtr,ForeignPtr) +import Foreign (peekByteOff) +import qualified Foreign as F +import Foreign ((.|.)) +import Foreign.C (CInt,CString,CDouble) +import qualified Foreign.C as C data CFILE = CFILE @@ -58,11 +59,11 @@ fopen :: FilePath -> String -> IO (Ptr CFILE) fopen file mode = - throwErrnoIfNull file $ withCString file $ - \f -> withCString mode $ \m -> c_fopen f m + C.throwErrnoIfNull file $ C.withCString file $ + \f -> C.withCString mode $ \m -> c_fopen f m fclose :: Ptr CFILE -> IO () -fclose p = throwErrnoIf_ (== #{const EOF}) "fclose" $ c_fclose p +fclose p = C.throwErrnoIf_ (== #{const EOF}) "fclose" $ c_fclose p withCFILE :: FilePath -> String -> (Ptr CFILE -> IO a) -> IO a withCFILE file mode = bracket (fopen file mode) fclose @@ -122,7 +123,8 @@ foreign import ccall "gd.h gdImageDestroy" gdImageDestroy :: Ptr GDImage -> IO () -foreign import ccall "gd-extras.h &gdImagePtrDestroyIfNotNull" ptr_gdImagePtrDestroyIfNotNull +foreign import ccall "gd-extras.h &gdImagePtrDestroyIfNotNull" + ptr_gdImagePtrDestroyIfNotNull :: FunPtr (Ptr (Ptr GDImage) -> IO ()) @@ -178,10 +180,12 @@ :: CInt -> IO CInt foreign import ccall "gd.h gdImageStringFT" gdImageStringFT - :: Ptr GDImage -> Ptr CInt -> CInt -> CString -> CDouble -> CDouble -> CInt -> CInt -> CString -> IO CString + :: Ptr GDImage -> Ptr CInt -> CInt -> CString -> CDouble -> CDouble -> + CInt -> CInt -> CString -> IO CString foreign import ccall "gd.h gdImageStringFTCircle" gdImageStringFTCircle - :: Ptr GDImage -> CInt -> CInt -> CDouble -> CDouble -> CDouble -> CString -> CDouble -> CString -> CString -> CInt -> IO CString + :: Ptr GDImage -> CInt -> CInt -> CDouble -> CDouble -> CDouble -> CString + -> CDouble -> CString -> CString -> CInt -> IO CString -- Miscellaneous functions @@ -200,20 +204,21 @@ type Color = CInt mkImage :: Ptr GDImage -> IO Image -mkImage img = do fp <- mallocForeignPtr - withForeignPtr fp $ \p -> poke p img - addForeignPtrFinalizer ptr_gdImagePtrDestroyIfNotNull fp +mkImage img = do fp <- F.mallocForeignPtr + F.withForeignPtr fp $ \p -> F.poke p img + F.addForeignPtrFinalizer ptr_gdImagePtrDestroyIfNotNull fp return $ Image fp -- | Creates an image, performs an operation on the image, and -- frees it. --- This function allows block scoped management of 'Image' objects. --- If you are handling large images, the delay before the finalizer which frees --- the image runs may cause significant temporary extra memory use. --- Use this function to force the image to be freed as soons as you are done with it. --- Note that it is unsafe to hold on to the 'Image' after the --- function is done. -withImage :: IO Image -- ^ Image creation action. +-- This function allows block scoped management of 'Image' +-- objects. If you are handling large images, the delay before +-- the finalizer which frees the image runs may cause significant +-- temporary extra memory use. Use this function to force the +-- image to be freed as soons as you are done with it. Note that +-- it is unsafe to hold on to the 'Image' after the function is +-- done. +withImage :: IO Image -- ^ Image creation action. -> (Image -> IO b) -- ^ Some operation on the image. The result should -- not reference the 'Image'. -> IO b @@ -223,21 +228,22 @@ -- Safe to call twice. Doesn't free the 'ForeignPtr', we rely on the -- GC to do that. freeImage :: Image -> IO () -freeImage (Image fp) = withForeignPtr fp $ - \pp -> do p <- peek pp - poke pp nullPtr - unless (p == nullPtr) $ gdImageDestroy p +freeImage (Image fp) = F.withForeignPtr fp $ + \pp -> do p <- F.peek pp + F.poke pp F.nullPtr + unless (p == F.nullPtr) $ gdImageDestroy p withImagePtr :: Image -> (Ptr GDImage -> IO a) -> IO a -withImagePtr (Image fp) f = withForeignPtr fp $ - \pp -> peek pp >>= \p -> if p == nullPtr then fail "Image has been freed." else f p +withImagePtr (Image fp) f = F.withForeignPtr fp $ + \pp -> F.peek pp >>= \p -> + if p == F.nullPtr then fail "Image has been freed." else f p -- | Create a new empty image. newImage :: Size -> IO Image newImage (w,h) = newImage_ (int w) (int h) newImage_ :: CInt -> CInt -> IO Image -newImage_ w h = do p <- throwIfNull "gdImageCreateTrueColor" $ +newImage_ w h = do p <- F.throwIfNull "gdImageCreateTrueColor" $ gdImageCreateTrueColor w h mkImage p @@ -252,8 +258,8 @@ onNewImage w h (\p' -> gdImageCopy p' p 0 0 0 0 w h) -- | Copy a region of one image into another -copyRegion :: Point -- ^ Source upper left-hand corner - -> Size -- ^ Size of copied region +copyRegion :: Point -- ^ Source upper left-hand corner + -> Size -- ^ Size of copied region -> Image -- ^ Source image -> Point -- ^ Destination upper left-hand corner -> Image -- ^ Destination image @@ -261,20 +267,23 @@ copyRegion (srcX, srcY) (w, h) srcIPtr (dstX, dstY) dstIPtr = withImagePtr dstIPtr $ \dstImg -> withImagePtr srcIPtr $ - \srcImg -> gdImageCopy dstImg srcImg (int dstX) (int dstY) (int srcX) (int srcY) (int w) (int h) + \srcImg -> gdImageCopy dstImg srcImg + (int dstX) (int dstY) (int srcX) (int srcY) (int w) (int h) -- | Copy a region of one image into another, rescaling the region copyRegionScaled :: Point -- ^ Source upper left-hand corner - -> Size -- ^ Size of source region + -> Size -- ^ Size of source region -> Image -- ^ Source image -> Point -- ^ Destination upper left-hand corner - -> Size -- ^ Size of destination region + -> Size -- ^ Size of destination region -> Image -- ^ Destination image -> IO () -copyRegionScaled (srcX, srcY) (srcW, srcH) srcIPtr (dstX, dstY) (dstW, dstH) dstIPtr +copyRegionScaled (srcX,srcY) (srcW,srcH) srcIPtr (dstX,dstY) (dstW,dstH) dstIPtr = withImagePtr dstIPtr $ \dstImg -> withImagePtr srcIPtr $ - \srcImg -> gdImageCopyResampled dstImg srcImg (int dstX) (int dstY) (int srcX) (int srcY) (int dstW) (int dstH) (int srcW) (int srcH) + \srcImg -> gdImageCopyResampled dstImg srcImg + (int dstX) (int dstY) (int srcX) (int srcY) + (int dstW) (int dstH) (int srcW) (int srcH) -- -- * Loading images @@ -285,7 +294,7 @@ loadJpegFile = loadImageFile gdImageCreateFromJpeg -- | Load a JPEG image from a buffer. -loadJpegData :: Int -- ^ Buffer size. +loadJpegData :: Int -- ^ Buffer size. -> Ptr a -- ^ Buffer with image data. -> IO Image loadJpegData = loadImageData gdImageCreateFromJpegPtr @@ -300,7 +309,7 @@ loadPngFile = loadImageFile gdImageCreateFromPng -- | Load a PNG image from a buffer. -loadPngData :: Int -- ^ Buffer size. +loadPngData :: Int -- ^ Buffer size. -> Ptr a -- ^ Buffer with image data. -> IO Image loadPngData = loadImageData gdImageCreateFromPngPtr @@ -314,7 +323,7 @@ loadGifFile = loadImageFile gdImageCreateFromGif -- | Load a GIF image from a buffer. -loadGifData :: Int -- ^ Buffer size. +loadGifData :: Int -- ^ Buffer size. -> Ptr a -- ^ Buffer with image data. -> IO Image loadGifData = loadImageData gdImageCreateFromGifPtr @@ -325,19 +334,20 @@ loadImageFile :: (Ptr CFILE -> IO (Ptr GDImage)) -> FilePath -> IO Image -loadImageFile f file = - do p <- throwIfNull ("Loading image from " ++ file) $ withCFILE file "rb" f - mkImage p +loadImageFile f file = do + p <- F.throwIfNull ("Loading image from " ++ file) $ withCFILE file "rb" f + mkImage p loadImageData :: (CInt -> Ptr a -> IO (Ptr GDImage)) -> Int -> Ptr a -> IO Image -loadImageData f sz buf = - do p <- throwIfNull ("Loading image") $ f (fromIntegral sz) buf - mkImage p +loadImageData f sz buf = do + p <- F.throwIfNull ("Loading image") $ f (fromIntegral sz) buf + mkImage p onByteStringData :: (Int -> Ptr a -> IO b) -> B.ByteString -> IO b -onByteStringData f bstr - = case B.toForeignPtr bstr of - (fptr, start, sz) -> withForeignPtr fptr (\ptr -> f sz (plusPtr ptr start)) +onByteStringData f bstr = + case B.toForeignPtr bstr of + (fptr, start, sz) -> F.withForeignPtr fptr $ + \ptr -> f sz (F.plusPtr ptr start) -- -- * Saving images @@ -350,7 +360,8 @@ -- | Write a JPEG format ByteString of an image. saveJpegByteString :: Int -> Image -> IO B.ByteString -saveJpegByteString q = saveImageByteString (\p h -> gdImageJpegPtr p h (fromIntegral q)) +saveJpegByteString q = + saveImageByteString (\p h -> gdImageJpegPtr p h (fromIntegral q)) -- | Save an image as a PNG file. @@ -370,15 +381,18 @@ saveGifByteString :: Image -> IO B.ByteString saveGifByteString = saveImageByteString gdImageGifPtr -saveImageFile :: (Ptr GDImage -> Ptr CFILE -> IO ()) -> FilePath -> Image -> IO () +saveImageFile :: (Ptr GDImage -> Ptr CFILE -> IO ()) + -> FilePath -> Image -> IO () saveImageFile f file i = withImagePtr i (\p -> withCFILE file "wb" (f p)) -saveImageByteString :: (Ptr GDImage -> Ptr CInt -> IO (Ptr a)) -> Image -> IO (B.ByteString) +saveImageByteString :: (Ptr GDImage -> Ptr CInt -> IO (Ptr a)) -> Image + -> IO (B.ByteString) saveImageByteString f img = withImagePtr img (\p -> dataByteString (f p)) dataByteString :: (Ptr CInt -> IO (Ptr a)) -> IO B.ByteString -dataByteString f = alloca $ \szPtr -> do datPtr <- f szPtr >>= newForeignPtr gdFree . castPtr - liftM (B.fromForeignPtr datPtr 0 . fromIntegral) (peek szPtr) +dataByteString f = F.alloca $ \szPtr -> do + datPtr <- f szPtr >>= F.newForeignPtr gdFree . F.castPtr + liftM (B.fromForeignPtr datPtr 0 . fromIntegral) (F.peek szPtr) -- -- * Getting information about images. @@ -491,9 +505,13 @@ -> Double -- ^ Angle in counterclockwise radians -> Point -- ^ Origin -> String -- ^ Text, including HTML entities - -> Color -> Image -> IO (Point, Point, Point, Point) -- ^ Bounding box of the drawn text + -> Color -> Image + -> IO (Point, Point, Point, Point) -- ^ Bounding box + -- of the drawn + -- text. drawString fontName ptSize angle (oriX, oriY) txt color img - = withImagePtr img $ drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt + = withImagePtr img $ + drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt -- | Measure a string using the FreeType 2.x library. This computes -- the bounding box but does not actually draw the string to any @@ -503,22 +521,31 @@ -> Double -- ^ Angle in counterclockwise radians -> Point -- ^ Origin -> String -- ^ Text, including HTML entities - -> Color -> IO (Point, Point, Point, Point) -- ^ Bounding box of the drawn text + -> Color + -> IO (Point, Point, Point, Point) -- ^ Bounding + -- box of the + -- drawn text measureString fontName ptSize angle (oriX, oriY) txt color - = drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt nullPtr + = drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt F.nullPtr -drawStringImagePtr :: Color -> String -> Double -> Double -> Point -> String -> Ptr GDImage -> IO (Point, Point, Point, Point) +drawStringImagePtr :: Color -> String -> Double -> Double -> Point -> String -> + Ptr GDImage -> IO (Point, Point, Point, Point) drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt imgPtr - = allocaArray 8 $ - \bboxPtr -> withCAString fontName $ - \cFontName -> withCAString txt $ - \cTxt -> do res <- gdImageStringFT imgPtr bboxPtr color cFontName (double ptSize) (double angle) (int oriX) (int oriY) cTxt - if res == nullPtr - then peekArray 8 bboxPtr >>= parseBBox - else peekCAString res >>= ioError . userError - where parseBBox l = case map int l of - [llx, lly, lrx, lry, urx, ury, ulx, uly] -> return ((llx, lly), (lrx, lry), (urx, ury), (ulx, uly)) - _ -> ioError $ userError $ "parseBBox with /= 8 elements: " ++ show l + = F.allocaArray 8 $ + \bboxPtr -> C.withCAString fontName $ + \cFontName -> C.withCAString txt $ + \cTxt -> do res <- gdImageStringFT imgPtr bboxPtr color cFontName + (double ptSize) (double angle) + (int oriX) (int oriY) cTxt + if res == F.nullPtr + then F.peekArray 8 bboxPtr >>= parseBBox + else C.peekCAString res >>= ioError . userError + where parseBBox l = + case map int l of + [llx, lly, lrx, lry, urx, ury, ulx, uly] -> + return ((llx, lly), (lrx, lry), (urx, ury), (ulx, uly)) + _ -> ioError $ userError $ + "parseBBox with /= 8 elements: " ++ show l -- | Draw strings around the top and bottom of a torus drawStringCircle :: Point -- ^ Center of text path circle @@ -531,13 +558,18 @@ -> String -- ^ Text to write on the bottom of the circle -> Color -- ^ Text color -> Image -> IO () -drawStringCircle (ctrX, ctrY) rad textRad textFill fontName fontSize topTxt bottomTxt color img - = withCAString fontName $ - \cFontName -> withCAString topTxt $ - \cTopTxt -> withCAString bottomTxt $ +drawStringCircle (ctrX, ctrY) rad textRad textFill fontName + fontSize topTxt bottomTxt color img + = C.withCAString fontName $ + \cFontName -> C.withCAString topTxt $ + \cTopTxt -> C.withCAString bottomTxt $ \cBottomTxt -> withImagePtr img $ - \imgPtr -> do res <- gdImageStringFTCircle imgPtr (int ctrX) (int ctrY) (double rad) (double textRad) (double textFill) cFontName (double fontSize) cTopTxt cBottomTxt color - unless (res == nullPtr) (peekCAString res >>= ioError . userError) + \imgPtr -> do + res <- gdImageStringFTCircle imgPtr + (int ctrX) (int ctrY) (double rad) (double textRad) + (double textFill) cFontName (double fontSize) + cTopTxt cBottomTxt color + unless (res == F.nullPtr) (C.peekCAString res >>= ioError . userError) -- -- * Colors @@ -555,9 +587,9 @@ -> Int -- ^ Alpha (0-127), 0 is opaque, 127 is transparent -> Color rgba r g b a = - (int a `shiftL` 24) .|. - (int r `shiftL` 16) .|. - (int g `shiftL` 8) .|. + (int a `F.shiftL` 24) .|. + (int r `F.shiftL` 16) .|. + (int g `F.shiftL` 8) .|. int b diff --git a/Graphics/GD/ByteString.hs b/Graphics/GD/ByteString.hs new file mode 100644 --- /dev/null +++ b/Graphics/GD/ByteString.hs @@ -0,0 +1,244 @@ +module Graphics.GD.ByteString ( + -- * Types + Image, Size, Point, Color, + -- * Creating and copying images + GD.newImage, GD.copyImage, + GD.copyRegion, GD.copyRegionScaled, + -- * Memory management + GD.withImage, + -- * Loading images + -- ** JPEG + loadJpegFile, loadJpegData, loadJpegByteString, + -- ** PNG + loadPngFile, loadPngData, loadPngByteString, + -- ** GIF + loadGifFile, loadGifData, loadGifByteString, + -- * Saving images + -- ** JPEG + saveJpegFile, saveJpegByteString, + -- ** PNG + savePngFile, savePngByteString, + -- ** GIF + saveGifFile, saveGifByteString, + -- * Getting image information + GD.imageSize, + -- * Querying + GD.getPixel, + -- * Manipulating images + GD.resizeImage, GD.rotateImage, + -- * Drawing + GD.fillImage, + GD.drawFilledRectangle, + GD.drawFilledEllipse, + GD.drawLine, + GD.drawArc, + GD.antiAliased, + GD.setPixel, + -- * Text + GD.useFontConfig, + drawString, + measureString, + drawStringCircle, + -- * Colors + GD.rgb, GD.rgba + ) where + +import Graphics.GD.Internal (Point,Color,Image,GDImage,CFILE,Size) +import qualified Graphics.GD.Internal as GD + +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as BI + +import Control.Monad (liftM,unless) +import Foreign (Ptr) +import qualified Foreign as F +import Foreign (peek) +import Foreign.C (CInt) +import Foreign.C (peekCAString,peekCAString) + +-- +-- * Loading images +-- + +-- | Load a JPEG image from a file. +loadJpegFile :: FilePath -> IO Image +loadJpegFile = loadImageFile GD.gdImageCreateFromJpeg + +-- | Load a JPEG image from a buffer. +loadJpegData :: Int -- ^ Buffer size. + -> Ptr a -- ^ Buffer with image data. + -> IO Image +loadJpegData = loadImageData GD.gdImageCreateFromJpegPtr + +-- | Load a JPEG image from a ByteString +loadJpegByteString :: B.ByteString -> IO Image +loadJpegByteString = onByteStringData loadJpegData + + +-- | Load a PNG image from a file. +loadPngFile :: FilePath -> IO Image +loadPngFile = loadImageFile GD.gdImageCreateFromPng + +-- | Load a PNG image from a buffer. +loadPngData :: Int -- ^ Buffer size. + -> Ptr a -- ^ Buffer with image data. + -> IO Image +loadPngData = loadImageData GD.gdImageCreateFromPngPtr + +-- | Load a PNG image from a ByteString +loadPngByteString :: B.ByteString -> IO Image +loadPngByteString = onByteStringData loadPngData + +-- | Load a GIF image from a file. +loadGifFile :: FilePath -> IO Image +loadGifFile = loadImageFile GD.gdImageCreateFromGif + +-- | Load a GIF image from a buffer. +loadGifData :: Int -- ^ Buffer size. + -> Ptr a -- ^ Buffer with image data. + -> IO Image +loadGifData = loadImageData GD.gdImageCreateFromGifPtr + +-- | Load a GIF image from a ByteString +loadGifByteString :: B.ByteString -> IO Image +loadGifByteString = onByteStringData loadGifData + + +loadImageFile :: (Ptr CFILE -> IO (Ptr GDImage)) -> FilePath -> IO Image +loadImageFile f file = do + p <- F.throwIfNull ("Loading image from " ++ file) $ GD.withCFILE file "rb" f + GD.mkImage p + +loadImageData :: (CInt -> Ptr a -> IO (Ptr GDImage)) -> Int -> Ptr a -> IO Image +loadImageData f sz buf = + do p <- F.throwIfNull ("Loading image") $ f (fromIntegral sz) buf + GD.mkImage p + +onByteStringData :: (Int -> Ptr a -> IO b) -> B.ByteString -> IO b +onByteStringData f bstr + = case BI.toForeignPtr bstr of + (fptr, start, sz) -> F.withForeignPtr fptr $ + \ptr -> f sz (F.plusPtr ptr start) + +-- +-- * Saving images +-- + +-- | Save an image as a JPEG file. +saveJpegFile :: Int -- ^ quality: 0-95, or negative for default quality. + -> FilePath -> Image -> IO () +saveJpegFile q = saveImageFile (\p h -> GD.gdImageJpeg p h (fromIntegral q)) + +-- | Write a JPEG format ByteString of an image. +saveJpegByteString :: Int -> Image -> IO B.ByteString +saveJpegByteString q = + saveImageByteString (\p h -> GD.gdImageJpegPtr p h (fromIntegral q)) + + +-- | Save an image as a PNG file. +savePngFile :: FilePath -> Image -> IO () +savePngFile = saveImageFile GD.gdImagePng + +-- | Write a PNG format ByteString of an image. +savePngByteString :: Image -> IO B.ByteString +savePngByteString = saveImageByteString GD.gdImagePngPtr + + +-- | Save an image as a GIF file. +saveGifFile :: FilePath -> Image -> IO () +saveGifFile = saveImageFile GD.gdImageGif + +-- | Write a GIF format ByteString of an image. +saveGifByteString :: Image -> IO B.ByteString +saveGifByteString = saveImageByteString GD.gdImageGifPtr + +saveImageFile :: (Ptr GDImage -> Ptr CFILE -> IO ()) -> FilePath -> Image + -> IO () +saveImageFile f file i = GD.withImagePtr i (\p -> GD.withCFILE file "wb" (f p)) + +saveImageByteString :: (Ptr GDImage -> Ptr CInt -> IO (Ptr a)) -> Image -> + IO (B.ByteString) +saveImageByteString f img = GD.withImagePtr img (\p -> dataByteString (f p)) + +dataByteString :: (Ptr CInt -> IO (Ptr a)) -> IO B.ByteString +dataByteString f = F.alloca $ \szPtr -> do + datPtr <- f szPtr >>= F.newForeignPtr GD.gdFree . F.castPtr + liftM (BI.fromForeignPtr datPtr 0 . fromIntegral) (peek szPtr) + +-- +-- * Text +-- + +-- | Draw a string using the FreeType 2.x library +drawString :: B.ByteString -- ^ Font name + -> Double -- ^ Font point size + -> Double -- ^ Angle in counterclockwise radians + -> Point -- ^ Origin + -> B.ByteString -- ^ Text, including HTML entities + -> Color -> Image + -> IO (Point, Point, Point, Point) -- ^ Bounding box + -- of the drawn + -- text +drawString fontName ptSize angle (oriX, oriY) txt color img = + GD.withImagePtr img $ drawStringImagePtr color fontName ptSize angle + (oriX, oriY) txt + +-- | Measure a string using the FreeType 2.x library. This computes +-- the bounding box but does not actually draw the string to any +-- image. +measureString :: B.ByteString -- ^ Font name + -> Double -- ^ Font point size + -> Double -- ^ Angle in counterclockwise radians + -> Point -- ^ Origin + -> B.ByteString -- ^ Text, including HTML entities + -> Color + -> IO (Point, Point, Point, Point) -- ^ Bounding + -- box of the + -- drawn text +measureString fontName ptSize angle (oriX, oriY) txt color + = drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt F.nullPtr + +drawStringImagePtr :: Color -> B.ByteString -> Double -> Double -> Point + -> B.ByteString -> Ptr GDImage + -> IO (Point, Point, Point, Point) +drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt imgPtr + = F.allocaArray 8 $ + \bboxPtr -> B.useAsCString fontName $ + \cFontName -> B.useAsCString txt $ + \cTxt -> do res <- GD.gdImageStringFT imgPtr bboxPtr color cFontName + (GD.double ptSize) (GD.double angle) + (GD.int oriX) (GD.int oriY) cTxt + if res == F.nullPtr + then F.peekArray 8 bboxPtr >>= parseBBox + else peekCAString res >>= ioError . userError + where parseBBox l = + case map GD.int l of + [llx, lly, lrx, lry, urx, ury, ulx, uly] -> + return ((llx, lly), (lrx, lry), (urx, ury), (ulx, uly)) + _ -> ioError $ userError $ + "parseBBox with /= 8 elements: " ++ show l + +-- | Draw strings around the top and bottom of a torus +drawStringCircle :: Point -- ^ Center of text path circle + -> Double -- ^ Outer radius of text + -> Double -- ^ Fraction of radius occupied by text + -> Double -- ^ Portion of circle arc filled by text + -> B.ByteString -- ^ Font name + -> Double -- ^ Font size hint + -> B.ByteString -- ^ Text to write on the top of the circle + -> B.ByteString -- ^ Text to write on the bottom of the circle + -> Color -- ^ Text color + -> Image -> IO () +drawStringCircle (ctrX, ctrY) rad textRad textFill fontName fontSize topTxt + bottomTxt color img + = B.useAsCString fontName $ + \cFontName -> B.useAsCString topTxt $ + \cTopTxt -> B.useAsCString bottomTxt $ + \cBottomTxt -> GD.withImagePtr img $ + \imgPtr -> do + res <- GD.gdImageStringFTCircle imgPtr (GD.int ctrX) (GD.int ctrY) + (GD.double rad) (GD.double textRad) + (GD.double textFill) cFontName + (GD.double fontSize) cTopTxt + cBottomTxt color + unless (res == F.nullPtr) (peekCAString res >>= ioError . userError) diff --git a/Graphics/GD/ByteString/Lazy.hs b/Graphics/GD/ByteString/Lazy.hs new file mode 100644 --- /dev/null +++ b/Graphics/GD/ByteString/Lazy.hs @@ -0,0 +1,248 @@ +module Graphics.GD.ByteString.Lazy ( + -- * Types + Image, Size, Point, Color, + -- * Creating and copying images + GD.newImage, GD.copyImage, + GD.copyRegion, GD.copyRegionScaled, + -- * Memory management + GD.withImage, + -- * Loading images + -- ** JPEG + loadJpegFile, loadJpegData, loadJpegByteString, + -- ** PNG + loadPngFile, loadPngData, loadPngByteString, + -- ** GIF + loadGifFile, loadGifData, loadGifByteString, + -- * Saving images + -- ** JPEG + saveJpegFile, saveJpegByteString, + -- ** PNG + savePngFile, savePngByteString, + -- ** GIF + saveGifFile, saveGifByteString, + -- * Getting image information + GD.imageSize, + -- * Querying + GD.getPixel, + -- * Manipulating images + GD.resizeImage, GD.rotateImage, + -- * Drawing + GD.fillImage, + GD.drawFilledRectangle, + GD.drawFilledEllipse, + GD.drawLine, + GD.drawArc, + GD.antiAliased, + GD.setPixel, + -- * Text + GD.useFontConfig, + drawString, + measureString, + drawStringCircle, + -- * Colors + GD.rgb, GD.rgba + ) where + +import Graphics.GD.Internal (Point,Color,Image,GDImage,CFILE,Size) +import qualified Graphics.GD.Internal as GD + +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Internal as BI + +import Control.Monad (liftM,unless) +import Foreign (Ptr) +import qualified Foreign as F +import Foreign (peek) +import Foreign.C (CInt) +import Foreign.C (peekCAString,peekCAString) + +-- +-- * Loading images +-- + +-- | Load a JPEG image from a file. +loadJpegFile :: FilePath -> IO Image +loadJpegFile = loadImageFile GD.gdImageCreateFromJpeg + +-- | Load a JPEG image from a buffer. +loadJpegData :: Int -- ^ Buffer size. + -> Ptr a -- ^ Buffer with image data. + -> IO Image +loadJpegData = loadImageData GD.gdImageCreateFromJpegPtr + +-- | Load a JPEG image from a ByteString +loadJpegByteString :: L.ByteString -> IO Image +loadJpegByteString = onByteStringData loadJpegData + + +-- | Load a PNG image from a file. +loadPngFile :: FilePath -> IO Image +loadPngFile = loadImageFile GD.gdImageCreateFromPng + +-- | Load a PNG image from a buffer. +loadPngData :: Int -- ^ Buffer size. + -> Ptr a -- ^ Buffer with image data. + -> IO Image +loadPngData = loadImageData GD.gdImageCreateFromPngPtr + +-- | Load a PNG image from a ByteString +loadPngByteString :: L.ByteString -> IO Image +loadPngByteString = onByteStringData loadPngData + +-- | Load a GIF image from a file. +loadGifFile :: FilePath -> IO Image +loadGifFile = loadImageFile GD.gdImageCreateFromGif + +-- | Load a GIF image from a buffer. +loadGifData :: Int -- ^ Buffer size. + -> Ptr a -- ^ Buffer with image data. + -> IO Image +loadGifData = loadImageData GD.gdImageCreateFromGifPtr + +-- | Load a GIF image from a ByteString +loadGifByteString :: L.ByteString -> IO Image +loadGifByteString = onByteStringData loadGifData + + +loadImageFile :: (Ptr CFILE -> IO (Ptr GDImage)) -> FilePath -> IO Image +loadImageFile f file = do + p <- F.throwIfNull ("Loading image from " ++ file) $ GD.withCFILE file "rb" f + GD.mkImage p + +loadImageData :: (CInt -> Ptr a -> IO (Ptr GDImage)) -> Int -> Ptr a -> IO Image +loadImageData f sz buf = + do p <- F.throwIfNull ("Loading image") $ f (fromIntegral sz) buf + GD.mkImage p + +onByteStringData :: (Int -> Ptr a -> IO b) -> L.ByteString -> IO b +onByteStringData f bstr = + case BI.toForeignPtr (lazyToStrict bstr) of + (fptr, start, sz) -> F.withForeignPtr fptr $ + \ptr -> f sz (F.plusPtr ptr start) + where lazyToStrict :: L.ByteString -> B.ByteString + lazyToStrict = foldr1 B.append . L.toChunks + +-- +-- * Saving images +-- + +-- | Save an image as a JPEG file. +saveJpegFile :: Int -- ^ quality: 0-95, or negative for default quality. + -> FilePath -> Image -> IO () +saveJpegFile q = saveImageFile (\p h -> GD.gdImageJpeg p h (fromIntegral q)) + +-- | Write a JPEG format ByteString of an image. +saveJpegByteString :: Int -> Image -> IO L.ByteString +saveJpegByteString q = + saveImageByteString (\p h -> GD.gdImageJpegPtr p h (fromIntegral q)) + + +-- | Save an image as a PNG file. +savePngFile :: FilePath -> Image -> IO () +savePngFile = saveImageFile GD.gdImagePng + +-- | Write a PNG format ByteString of an image. +savePngByteString :: Image -> IO L.ByteString +savePngByteString = saveImageByteString GD.gdImagePngPtr + + +-- | Save an image as a GIF file. +saveGifFile :: FilePath -> Image -> IO () +saveGifFile = saveImageFile GD.gdImageGif + +-- | Write a GIF format ByteString of an image. +saveGifByteString :: Image -> IO L.ByteString +saveGifByteString = saveImageByteString GD.gdImageGifPtr + +saveImageFile :: (Ptr GDImage -> Ptr CFILE -> IO ()) -> FilePath -> Image + -> IO () +saveImageFile f file i = GD.withImagePtr i (\p -> GD.withCFILE file "wb" (f p)) + +saveImageByteString :: (Ptr GDImage -> Ptr CInt -> IO (Ptr a)) -> Image + -> IO (L.ByteString) +saveImageByteString f img = GD.withImagePtr img (\p -> dataByteString (f p)) + +dataByteString :: (Ptr CInt -> IO (Ptr a)) -> IO L.ByteString +dataByteString f = F.alloca $ \szPtr -> do + datPtr <- f szPtr >>= F.newForeignPtr GD.gdFree . F.castPtr + liftM (L.fromChunks . return . BI.fromForeignPtr datPtr 0 . fromIntegral) + (peek szPtr) + +-- +-- * Text +-- + +-- | Draw a string using the FreeType 2.x library +drawString :: B.ByteString -- ^ Font name + -> Double -- ^ Font point size + -> Double -- ^ Angle in counterclockwise radians + -> Point -- ^ Origin + -> B.ByteString -- ^ Text, including HTML entities + -> Color -> Image + -> IO (Point, Point, Point, Point) -- ^ Bounding box + -- of the drawn + -- text +drawString fontName ptSize angle (oriX, oriY) txt color img = + GD.withImagePtr img $ drawStringImagePtr color fontName ptSize angle + (oriX, oriY) txt + +-- | Measure a string using the FreeType 2.x library. This computes +-- the bounding box but does not actually draw the string to any +-- image. +measureString :: B.ByteString -- ^ Font name + -> Double -- ^ Font point size + -> Double -- ^ Angle in counterclockwise radians + -> Point -- ^ Origin + -> B.ByteString -- ^ Text, including HTML entities + -> Color + -> IO (Point, Point, Point, Point) -- ^ Bounding + -- box of the + -- drawn text +measureString fontName ptSize angle (oriX, oriY) txt color + = drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt F.nullPtr + +drawStringImagePtr :: Color -> B.ByteString -> Double -> Double -> Point + -> B.ByteString -> Ptr GDImage + -> IO (Point, Point, Point, Point) +drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt imgPtr + = F.allocaArray 8 $ + \bboxPtr -> B.useAsCString fontName $ + \cFontName -> B.useAsCString txt $ + \cTxt -> do res <- GD.gdImageStringFT imgPtr bboxPtr color cFontName + (GD.double ptSize) (GD.double angle) + (GD.int oriX) (GD.int oriY) cTxt + if res == F.nullPtr + then F.peekArray 8 bboxPtr >>= parseBBox + else peekCAString res >>= ioError . userError + where parseBBox l = + case map GD.int l of + [llx, lly, lrx, lry, urx, ury, ulx, uly] -> + return ((llx, lly), (lrx, lry), (urx, ury), (ulx, uly)) + _ -> ioError $ userError $ + "parseBBox with /= 8 elements: " ++ show l + +-- | Draw strings around the top and bottom of a torus +drawStringCircle :: Point -- ^ Center of text path circle + -> Double -- ^ Outer radius of text + -> Double -- ^ Fraction of radius occupied by text + -> Double -- ^ Portion of circle arc filled by text + -> B.ByteString -- ^ Font name + -> Double -- ^ Font size hint + -> B.ByteString -- ^ Text to write on the top of the circle + -> B.ByteString -- ^ Text to write on the bottom of the circle + -> Color -- ^ Text color + -> Image -> IO () +drawStringCircle (ctrX, ctrY) rad textRad textFill fontName fontSize topTxt + bottomTxt color img + = B.useAsCString fontName $ + \cFontName -> B.useAsCString topTxt $ + \cTopTxt -> B.useAsCString bottomTxt $ + \cBottomTxt -> GD.withImagePtr img $ + \imgPtr -> do + res <- GD.gdImageStringFTCircle imgPtr (GD.int ctrX) (GD.int ctrY) + (GD.double rad) (GD.double textRad) + (GD.double textFill) cFontName + (GD.double fontSize) cTopTxt + cBottomTxt color + unless (res == F.nullPtr) (peekCAString res >>= ioError . userError) diff --git a/Graphics/GD/Internal.hsc b/Graphics/GD/Internal.hsc new file mode 100644 --- /dev/null +++ b/Graphics/GD/Internal.hsc @@ -0,0 +1,392 @@ +module Graphics.GD.Internal where + +import Control.Exception (bracket) +import Control.Monad (liftM, unless) +import Foreign (Ptr,FunPtr,ForeignPtr) +import qualified Foreign as F +import Foreign (peek,peekByteOff,(.|.)) +import Foreign.C (CDouble,CInt,CString) +import qualified Foreign.C as C + +data CFILE = CFILE + +foreign import ccall "stdio.h fopen" c_fopen + :: CString -> CString -> IO (Ptr CFILE) +foreign import ccall "stdio.h fclose" c_fclose + :: Ptr CFILE -> IO CInt + +fopen :: FilePath -> String -> IO (Ptr CFILE) +fopen file mode = + C.throwErrnoIfNull file $ C.withCString file $ + \f -> C.withCString mode $ \m -> c_fopen f m + +fclose :: Ptr CFILE -> IO () +fclose p = C.throwErrnoIf_ (== #{const EOF}) "fclose" $ c_fclose p + +withCFILE :: FilePath -> String -> (Ptr CFILE -> IO a) -> IO a +withCFILE file mode = bracket (fopen file mode) fclose + +#include +#include "gd-extras.h" + +data GDImage = GDImage + +-- JPEG format + +foreign import ccall "gd.h gdImageCreateFromJpeg" gdImageCreateFromJpeg + :: Ptr CFILE -> IO (Ptr GDImage) + +foreign import ccall "gd.h gdImageCreateFromJpegPtr" gdImageCreateFromJpegPtr + :: CInt -> Ptr a -> IO (Ptr GDImage) + +foreign import ccall "gd.h gdImageJpeg" gdImageJpeg + :: Ptr GDImage -> Ptr CFILE -> CInt -> IO () + +foreign import ccall "gd.h gdImageJpegPtr" gdImageJpegPtr + :: Ptr GDImage -> Ptr CInt -> CInt -> IO (Ptr a) + +-- PNG format + +foreign import ccall "gd.h gdImageCreateFromPng" gdImageCreateFromPng + :: Ptr CFILE -> IO (Ptr GDImage) + +foreign import ccall "gd.h gdImageCreateFromPngPtr" gdImageCreateFromPngPtr + :: CInt -> Ptr a -> IO (Ptr GDImage) + +foreign import ccall "gd.h gdImagePng" gdImagePng + :: Ptr GDImage -> Ptr CFILE -> IO () + +foreign import ccall "gd.h gdImagePngPtr" gdImagePngPtr + :: Ptr GDImage -> Ptr CInt -> IO (Ptr a) + +-- GIF format + +foreign import ccall "gd.h gdImageCreateFromGif" gdImageCreateFromGif + :: Ptr CFILE -> IO (Ptr GDImage) + +foreign import ccall "gd.h gdImageCreateFromGifPtr" gdImageCreateFromGifPtr + :: CInt -> Ptr a -> IO (Ptr GDImage) + +foreign import ccall "gd.h gdImageGif" gdImageGif + :: Ptr GDImage -> Ptr CFILE -> IO () + +foreign import ccall "gd.h gdImageGifPtr" gdImageGifPtr + :: Ptr GDImage -> Ptr CInt -> IO (Ptr a) + +-- Creating and destroying images + +foreign import ccall "gd.h gdImageCreateTrueColor" gdImageCreateTrueColor + :: CInt -> CInt -> IO (Ptr GDImage) + +foreign import ccall "gd.h gdImageDestroy" gdImageDestroy + :: Ptr GDImage -> IO () + +foreign import ccall "gd-extras.h &gdImagePtrDestroyIfNotNull" + ptr_gdImagePtrDestroyIfNotNull + :: FunPtr (Ptr (Ptr GDImage) -> IO ()) + + +-- Copying image parts + +foreign import ccall "gd.h gdImageCopy" gdImageCopy + :: Ptr GDImage -> Ptr GDImage + -> CInt -> CInt -> CInt -> CInt + -> CInt -> CInt -> IO () + +foreign import ccall "gd.h gdImageCopyResampled" gdImageCopyResampled + :: Ptr GDImage -> Ptr GDImage + -> CInt -> CInt -> CInt -> CInt + -> CInt -> CInt -> CInt -> CInt -> IO () + +{- +foreign import ccall "gd.h gdImageCopyRotated" gdImageCopyRotated + :: Ptr GDImage -> Ptr GDImage + -> CDouble -> CDouble -> CInt -> CInt + -> CInt -> CInt -> CInt -> IO () +-} + +foreign import ccall "gd-extras.h gdImageCopyRotated90" gdImageCopyRotated90 + :: Ptr GDImage -> Ptr GDImage + -> CInt -> CInt -> CInt -> CInt + -> CInt -> CInt -> CInt -> IO () + +foreign import ccall "gd.h gdImageGetPixel" gdImageGetPixel + :: Ptr GDImage -> CInt -> CInt -> IO CInt + +-- Drawing functions + +foreign import ccall "gd.h gdImageFilledRectangle" gdImageFilledRectangle + :: Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () + +foreign import ccall "gd.h gdImageFilledEllipse" gdImageFilledEllipse + :: Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () + +foreign import ccall "gd.h gdImageLine" gdImageLine + :: Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () + +foreign import ccall "gd.h gdImageArc" gdImageArc + :: Ptr GDImage -> CInt -> CInt -> CInt -> CInt + -> CInt -> CInt -> CInt -> IO () + +foreign import ccall "gd.h gdImageSetAntiAliased" gdImageSetAntiAliased + :: Ptr GDImage -> CInt -> IO () + +foreign import ccall "gd.h gdImageSetPixel" gdImageSetPixel + :: Ptr GDImage -> CInt -> CInt -> CInt -> IO () + +-- Text functions + +foreign import ccall "gd.h gdFTUseFontConfig" gdFTUseFontConfig + :: CInt -> IO CInt + +foreign import ccall "gd.h gdImageStringFT" gdImageStringFT + :: Ptr GDImage -> Ptr CInt -> CInt -> CString -> CDouble -> CDouble -> CInt + -> CInt -> CString -> IO CString + +foreign import ccall "gd.h gdImageStringFTCircle" gdImageStringFTCircle + :: Ptr GDImage -> CInt -> CInt -> CDouble -> CDouble -> CDouble -> CString + -> CDouble -> CString -> CString -> CInt -> IO CString + +-- Miscellaneous functions + +foreign import ccall "gd.h &gdFree" gdFree + :: FunPtr (Ptr a -> IO ()) + +-- We use a second level of indirection to allow storing a null pointer +-- when the image has already been freed. This allows 'withImage' to +-- free the @gdImage@ early. +newtype Image = Image (ForeignPtr (Ptr GDImage)) + +type Size = (Int,Int) + +type Point = (Int,Int) + +type Color = CInt + +mkImage :: Ptr GDImage -> IO Image +mkImage img = do fp <- F.mallocForeignPtr + F.withForeignPtr fp $ \p -> F.poke p img + F.addForeignPtrFinalizer ptr_gdImagePtrDestroyIfNotNull fp + return $ Image fp + +-- | Creates an image, performs an operation on the image, and +-- frees it. +-- This function allows block scoped management of 'Image' +-- objects. If you are handling large images, the delay before +-- the finalizer which frees the image runs may cause significant +-- temporary extra memory use. Use this function to force the +-- image to be freed as soons as you are done with it. Note that +-- it is unsafe to hold on to the 'Image' after the function is +-- done. +withImage :: IO Image -- ^ Image creation action. + -> (Image -> IO b) -- ^ Some operation on the image. The result should + -- not reference the 'Image'. + -> IO b +withImage ini f = bracket ini freeImage f + +-- | Overwrites the pointer with a null pointer, and frees the @gdImage@. +-- Safe to call twice. Doesn't free the 'ForeignPtr', we rely on the +-- GC to do that. +freeImage :: Image -> IO () +freeImage (Image fp) = F.withForeignPtr fp $ + \pp -> do p <- peek pp + F.poke pp F.nullPtr + unless (p == F.nullPtr) $ gdImageDestroy p + +withImagePtr :: Image -> (Ptr GDImage -> IO a) -> IO a +withImagePtr (Image fp) f = F.withForeignPtr fp $ + \pp -> peek pp >>= \p -> + if p == F.nullPtr then fail "Image has been freed." else f p + +-- | Create a new empty image. +newImage :: Size -> IO Image +newImage (w,h) = newImage_ (int w) (int h) + +newImage_ :: CInt -> CInt -> IO Image +newImage_ w h = do p <- F.throwIfNull "gdImageCreateTrueColor" $ + gdImageCreateTrueColor w h + mkImage p + +-- | Create a new empty image and apply a function to it. +onNewImage :: CInt -> CInt -> (Ptr GDImage -> IO a) -> IO Image +onNewImage w h f = newImage_ w h >>= \i -> withImagePtr i f >> return i + +-- | Make a copy of an image. +copyImage :: Image -> IO Image +copyImage i = withImagePtr i f + where f p = do (w,h) <- imageSize_ p + onNewImage w h (\p' -> gdImageCopy p' p 0 0 0 0 w h) + +-- | Copy a region of one image into another +copyRegion :: Point -- ^ Source upper left-hand corner + -> Size -- ^ Size of copied region + -> Image -- ^ Source image + -> Point -- ^ Destination upper left-hand corner + -> Image -- ^ Destination image + -> IO () +copyRegion (srcX, srcY) (w, h) srcIPtr (dstX, dstY) dstIPtr + = withImagePtr dstIPtr $ + \dstImg -> withImagePtr srcIPtr $ + \srcImg -> gdImageCopy dstImg srcImg (int dstX) (int dstY) + (int srcX) (int srcY) (int w) (int h) + +-- | Copy a region of one image into another, rescaling the region +copyRegionScaled :: Point -- ^ Source upper left-hand corner + -> Size -- ^ Size of source region + -> Image -- ^ Source image + -> Point -- ^ Destination upper left-hand corner + -> Size -- ^ Size of destination region + -> Image -- ^ Destination image + -> IO () +copyRegionScaled (srcX, srcY) (srcW, srcH) srcIPtr (dstX, dstY) (dstW, dstH) + dstIPtr + = withImagePtr dstIPtr $ + \dstImg -> withImagePtr srcIPtr $ + \srcImg -> gdImageCopyResampled dstImg srcImg (int dstX) (int dstY) + (int srcX) (int srcY) (int dstW) (int dstH) + (int srcW) (int srcH) + +-- +-- * Querying +-- + +-- | Retrieves the color index or the color values of a particular pixel. +getPixel :: (Int,Int) -> Image -> IO Color +getPixel (x,y) i = withImagePtr i f + where f p' = gdImageGetPixel p' (int x) (int y) + +-- +-- * Getting information about images. +-- + +-- | Get the size of an image. +imageSize :: Image -> IO (Int,Int) -- ^ (width, height) +imageSize i = liftM f $ withImagePtr i imageSize_ + where f = (\ (w,h) -> (fromIntegral w, fromIntegral h)) + +imageSize_ :: Ptr GDImage -> IO (CInt,CInt) +imageSize_ p = do w <- #{peek gdImage, sx} p + h <- #{peek gdImage, sy} p + return (w, h) + +-- +-- * Transforming images. +-- + +-- | Resize an image to a give size. +resizeImage :: Int -- ^ width in pixels of output image + -> Int -- ^ height in pixels of output image + -> Image + -> IO Image +resizeImage w h i = withImagePtr i f + where + f p = do let (outW,outH) = (fromIntegral w, fromIntegral h) + (inW, inH) <- imageSize_ p + onNewImage outW outH $ \p' -> + gdImageCopyResampled p' p 0 0 0 0 outW outH inW inH + +-- | Rotate an image by a multiple of 90 degrees counter-clockwise. +rotateImage :: Int -- ^ 1 for 90 degrees counter-clockwise, + -- 2 for 180 degrees, etc. + -> Image + -> IO Image +rotateImage r i = withImagePtr i f + where f p = do (inW,inH) <- imageSize_ p + let q = fromIntegral (r `mod` 4) + (outW,outH) | r `mod` 2 == 0 = (inW,inH) + | otherwise = (inH,inW) + srcX = if q == 1 || q == 2 then inW-1 else 0; + srcY = if q == 2 || q == 3 then inH-1 else 0; + onNewImage outW outH (\p' -> + gdImageCopyRotated90 p' p 0 0 srcX srcY inW inH q) + +-- +-- * Drawing +-- + +-- | Fill the entire image with the given color. +fillImage :: Color -> Image -> IO () +fillImage c i = do sz <- imageSize i + drawFilledRectangle (0,0) sz c i + +drawFilledRectangle :: Point -- ^ Upper left corner + -> Point -- ^ Lower right corner + -> Color -> Image -> IO () +drawFilledRectangle (x1,y1) (x2,y2) c i = + withImagePtr i $ \p -> + gdImageFilledRectangle p (int x1) (int y1) (int x2) (int y2) c + +drawFilledEllipse :: Point -- ^ Center + -> Size -- ^ Width and height + -> Color -> Image -> IO () +drawFilledEllipse (cx,cy) (w,h) c i = + withImagePtr i $ \p -> + gdImageFilledEllipse p (int cx) (int cy) (int w) (int h) c + +drawLine :: Point -- ^ Start + -> Point -- ^ End + -> Color -> Image -> IO () +drawLine (x1,y1) (x2,y2) c i = + withImagePtr i $ \p -> + gdImageLine p (int x1) (int y1) (int x2) (int y2) c + +drawArc :: Point -- ^ Center + -> Size -- ^ Width and height + -> Int -- ^ Starting position (degrees) + -> Int -- ^ Ending position (degrees) + -> Color -> Image -> IO () +drawArc (cx,cy) (w,h) sp ep c i = + withImagePtr i $ \p -> + gdImageArc p (int cx) (int cy) (int w) (int h) (int sp) (int ep) c + +-- | Use anti-aliasing when performing the given drawing function. +-- This can cause a segault with some gd versions. +antiAliased :: (Color -> Image -> IO a) -> Color -> Image -> IO a +antiAliased f c i = + do withImagePtr i (\p -> gdImageSetAntiAliased p c) + f (#{const gdAntiAliased}) i + +setPixel :: Point -> Color -> Image -> IO () +setPixel (x,y) c i = + withImagePtr i $ \p -> + gdImageSetPixel p (int x) (int y) c + +-- +-- * Colors +-- + +rgb :: Int -- ^ Red (0-255) + -> Int -- ^ Green (0-255) + -> Int -- ^ Blue (0-255) + -> Color +rgb r g b = rgba r g b 0 + +rgba :: Int -- ^ Red (0-255) + -> Int -- ^ Green (0-255) + -> Int -- ^ Blue (0-255) + -> Int -- ^ Alpha (0-127), 0 is opaque, 127 is transparent + -> Color +rgba r g b a = + (int a `F.shiftL` 24) .|. + (int r `F.shiftL` 16) .|. + (int g `F.shiftL` 8) .|. + int b + +-- +-- * Text +-- + +-- | Globally switch from using font file names to fontconfig paths +-- | for fonts in drawString (and measureString). +useFontConfig :: Bool -> IO Bool +useFontConfig use = liftM (/= 0) $ gdFTUseFontConfig $ if use then 1 else 0 + +-- +-- * Utilities +-- + +int :: (Integral a, Num b) => a -> b +int = fromIntegral + +double :: (Real a, Fractional b) => a -> b +double = realToFrac diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE diff --git a/gd.cabal b/gd.cabal --- a/gd.cabal +++ b/gd.cabal @@ -1,9 +1,11 @@ Name: gd -Version: 3000.4.0 +Category: Graphics +License-File: LICENSE +Version: 3000.5.0 Cabal-version: >= 1.2 Build-type: Simple Copyright: Bjorn Bringert -Maintainer: bjorn@bringert.net +Maintainer: Chris Done Author: Bjorn Bringert License: BSD3 Synopsis: A Haskell binding to a subset of the GD graphics library @@ -15,17 +17,13 @@ Flag bytestring-in-base Library - if flag(bytestring-in-base) - -- bytestring was in base-2.0 and 2.1.1 - Build-depends: base >= 2.0 && < 2.2 - else - -- in base 1.0 and 3.0 bytestring is a separate package - Build-depends: base < 2.0 || >= 3, bytestring >= 0.9 + Build-depends: base >= 4 && < 5, bytestring >= 0.9.1.6 Extensions: ForeignFunctionInterface - Exposed-Modules: Graphics.GD + Exposed-Modules: Graphics.GD, Graphics.GD.ByteString, Graphics.GD.ByteString.Lazy Ghc-options: -Wall - Extra-libraries: gd, png, z, jpeg, m, fontconfig, freetype, pthread, expat + Extra-libraries: gd, png, z, jpeg, m, fontconfig, freetype, expat Includes: gd.h Include-dirs: cbits Install-includes: gd-extras.h C-sources: cbits/gd-extras.c + Other-modules: Graphics.GD.Internal