module Graphics.GD.ByteString.Lazy (
Image, Size, Point, Color,
newImage, copyImage,
copyRegion, copyRegionScaled,
withImage,
loadJpegFile, loadJpegData, loadJpegByteString,
loadPngFile, loadPngData, loadPngByteString,
loadGifFile, loadGifData, loadGifByteString,
saveJpegFile, saveJpegByteString,
savePngFile, savePngByteString,
saveGifFile, saveGifByteString,
imageSize,
getPixel,
resizeImage, rotateImage,
fillImage,
drawFilledRectangle,
drawFilledEllipse,
drawLine,
drawArc,
antiAliased,
setPixel,
useFontConfig,
drawString,
measureString,
drawStringCircle,
rgb, rgba
) where
import Graphics.GD.Internal
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
import Foreign.C
import Foreign.ForeignPtr
import Foreign.Marshal.Error
loadJpegFile :: FilePath -> IO Image
loadJpegFile = loadImageFile gdImageCreateFromJpeg
loadJpegData :: Int
-> Ptr a
-> IO Image
loadJpegData = loadImageData gdImageCreateFromJpegPtr
loadJpegByteString :: L.ByteString -> IO Image
loadJpegByteString = onByteStringData loadJpegData
loadPngFile :: FilePath -> IO Image
loadPngFile = loadImageFile gdImageCreateFromPng
loadPngData :: Int
-> Ptr a
-> IO Image
loadPngData = loadImageData gdImageCreateFromPngPtr
loadPngByteString :: L.ByteString -> IO Image
loadPngByteString = onByteStringData loadPngData
loadGifFile :: FilePath -> IO Image
loadGifFile = loadImageFile gdImageCreateFromGif
loadGifData :: Int
-> Ptr a
-> IO Image
loadGifData = loadImageData gdImageCreateFromGifPtr
loadGifByteString :: L.ByteString -> IO Image
loadGifByteString = onByteStringData loadGifData
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
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
onByteStringData :: (Int -> Ptr a -> IO b) -> L.ByteString -> IO b
onByteStringData f bstr
= case BI.toForeignPtr (lazyToStrict bstr) of
(fptr, start, sz) -> withForeignPtr fptr (\ptr -> f sz (plusPtr ptr start))
lazyToStrict :: L.ByteString -> B.ByteString
lazyToStrict = foldr1 B.append . L.toChunks
saveJpegFile :: Int
-> FilePath -> Image -> IO ()
saveJpegFile q = saveImageFile (\p h -> gdImageJpeg p h (fromIntegral q))
saveJpegByteString :: Int -> Image -> IO L.ByteString
saveJpegByteString q = saveImageByteString (\p h -> gdImageJpegPtr p h (fromIntegral q))
savePngFile :: FilePath -> Image -> IO ()
savePngFile = saveImageFile gdImagePng
savePngByteString :: Image -> IO L.ByteString
savePngByteString = saveImageByteString gdImagePngPtr
saveGifFile :: FilePath -> Image -> IO ()
saveGifFile = saveImageFile gdImageGif
saveGifByteString :: Image -> IO L.ByteString
saveGifByteString = saveImageByteString gdImageGifPtr
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 (L.ByteString)
saveImageByteString f img = withImagePtr img (\p -> dataByteString (f p))
dataByteString :: (Ptr CInt -> IO (Ptr a)) -> IO L.ByteString
dataByteString f = alloca $ \szPtr -> do datPtr <- f szPtr >>= newForeignPtr gdFree . castPtr
liftM (L.fromChunks . return . BI.fromForeignPtr datPtr 0 . fromIntegral) (peek szPtr)
drawString :: L.ByteString
-> Double
-> Double
-> Point
-> L.ByteString
-> Color -> Image -> IO (Point, Point, Point, Point)
drawString fontName ptSize angle (oriX, oriY) txt color img
= withImagePtr img $ drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt
measureString :: L.ByteString
-> Double
-> Double
-> Point
-> L.ByteString
-> Color -> IO (Point, Point, Point, Point)
measureString fontName ptSize angle (oriX, oriY) txt color
= drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt nullPtr
drawStringImagePtr :: Color -> L.ByteString -> Double -> Double -> Point -> L.ByteString -> Ptr GDImage -> IO (Point, Point, Point, Point)
drawStringImagePtr color fontName ptSize angle (oriX, oriY) txt imgPtr
= allocaArray 8 $
\bboxPtr -> toCStr fontName $
\cFontName -> toCStr 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
drawStringCircle :: Point
-> Double
-> Double
-> Double
-> L.ByteString
-> Double
-> L.ByteString
-> L.ByteString
-> Color
-> Image -> IO ()
drawStringCircle (ctrX, ctrY) rad textRad textFill fontName fontSize topTxt bottomTxt color img
= toCStr fontName $
\cFontName -> toCStr topTxt $
\cTopTxt -> toCStr 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)
toCStr :: L.ByteString -> (CString -> IO a) -> IO a
toCStr = B.useAsCString . lazyToStrict