{-# LINE 1 "Graphics/GD/Internal.hsc" #-}
module Graphics.GD.Internal where
import Control.Exception (bracket)
import Control.Monad (liftM, unless)
import Data.Bits
import Foreign (Ptr,FunPtr,ForeignPtr)
import Foreign (peek,peekByteOff)
import qualified Foreign as F
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 :: FilePath -> FilePath -> IO (Ptr CFILE)
fopen FilePath
file FilePath
mode =
FilePath -> IO (Ptr CFILE) -> IO (Ptr CFILE)
forall a. FilePath -> IO (Ptr a) -> IO (Ptr a)
C.throwErrnoIfNull FilePath
file (IO (Ptr CFILE) -> IO (Ptr CFILE))
-> IO (Ptr CFILE) -> IO (Ptr CFILE)
forall a b. (a -> b) -> a -> b
$ FilePath -> (CString -> IO (Ptr CFILE)) -> IO (Ptr CFILE)
forall a. FilePath -> (CString -> IO a) -> IO a
C.withCString FilePath
file ((CString -> IO (Ptr CFILE)) -> IO (Ptr CFILE))
-> (CString -> IO (Ptr CFILE)) -> IO (Ptr CFILE)
forall a b. (a -> b) -> a -> b
$
\CString
f -> FilePath -> (CString -> IO (Ptr CFILE)) -> IO (Ptr CFILE)
forall a. FilePath -> (CString -> IO a) -> IO a
C.withCString FilePath
mode ((CString -> IO (Ptr CFILE)) -> IO (Ptr CFILE))
-> (CString -> IO (Ptr CFILE)) -> IO (Ptr CFILE)
forall a b. (a -> b) -> a -> b
$ \CString
m -> CString -> CString -> IO (Ptr CFILE)
c_fopen CString
f CString
m
fclose :: Ptr CFILE -> IO ()
fclose :: Ptr CFILE -> IO ()
fclose Ptr CFILE
p = (CInt -> Bool) -> FilePath -> IO CInt -> IO ()
forall a. (a -> Bool) -> FilePath -> IO a -> IO ()
C.throwErrnoIf_ (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== -CInt
1) FilePath
"fclose" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CFILE -> IO CInt
c_fclose Ptr CFILE
p
{-# LINE 26 "Graphics/GD/Internal.hsc" #-}
withCFILE :: FilePath -> String -> (Ptr CFILE -> IO a) -> IO a
withCFILE :: forall a. FilePath -> FilePath -> (Ptr CFILE -> IO a) -> IO a
withCFILE FilePath
file FilePath
mode = IO (Ptr CFILE)
-> (Ptr CFILE -> IO ()) -> (Ptr CFILE -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> FilePath -> IO (Ptr CFILE)
fopen FilePath
file FilePath
mode) Ptr CFILE -> IO ()
fclose
data GDImage = GDImage
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)
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)
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)
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 ())
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-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
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 ()
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
foreign import ccall "gd.h &gdFree" gdFree
:: FunPtr (Ptr a -> IO ())
newtype Image = Image (ForeignPtr (Ptr GDImage))
type Size = (Int,Int)
type Point = (Int,Int)
type Color = CInt
mkImage :: Ptr GDImage -> IO Image
mkImage :: Ptr GDImage -> IO Image
mkImage Ptr GDImage
img = do ForeignPtr (Ptr GDImage)
fp <- IO (ForeignPtr (Ptr GDImage))
forall a. Storable a => IO (ForeignPtr a)
F.mallocForeignPtr
ForeignPtr (Ptr GDImage) -> (Ptr (Ptr GDImage) -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr (Ptr GDImage)
fp ((Ptr (Ptr GDImage) -> IO ()) -> IO ())
-> (Ptr (Ptr GDImage) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr GDImage)
p -> Ptr (Ptr GDImage) -> Ptr GDImage -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
F.poke Ptr (Ptr GDImage)
p Ptr GDImage
img
FinalizerPtr (Ptr GDImage) -> ForeignPtr (Ptr GDImage) -> IO ()
forall a. FinalizerPtr a -> ForeignPtr a -> IO ()
F.addForeignPtrFinalizer FinalizerPtr (Ptr GDImage)
ptr_gdImagePtrDestroyIfNotNull ForeignPtr (Ptr GDImage)
fp
Image -> IO Image
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Image -> IO Image) -> Image -> IO Image
forall a b. (a -> b) -> a -> b
$ ForeignPtr (Ptr GDImage) -> Image
Image ForeignPtr (Ptr GDImage)
fp
withImage :: IO Image
-> (Image -> IO b)
-> IO b
withImage :: forall b. IO Image -> (Image -> IO b) -> IO b
withImage IO Image
ini Image -> IO b
f = IO Image -> (Image -> IO ()) -> (Image -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Image
ini Image -> IO ()
freeImage Image -> IO b
f
freeImage :: Image -> IO ()
freeImage :: Image -> IO ()
freeImage (Image ForeignPtr (Ptr GDImage)
fp) = ForeignPtr (Ptr GDImage) -> (Ptr (Ptr GDImage) -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr (Ptr GDImage)
fp ((Ptr (Ptr GDImage) -> IO ()) -> IO ())
-> (Ptr (Ptr GDImage) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Ptr (Ptr GDImage)
pp -> do Ptr GDImage
p <- Ptr (Ptr GDImage) -> IO (Ptr GDImage)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GDImage)
pp
Ptr (Ptr GDImage) -> Ptr GDImage -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
F.poke Ptr (Ptr GDImage)
pp Ptr GDImage
forall a. Ptr a
F.nullPtr
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ptr GDImage
p Ptr GDImage -> Ptr GDImage -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr GDImage
forall a. Ptr a
F.nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr GDImage -> IO ()
gdImageDestroy Ptr GDImage
p
withImagePtr :: Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr :: forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr (Image ForeignPtr (Ptr GDImage)
fp) Ptr GDImage -> IO a
f = ForeignPtr (Ptr GDImage) -> (Ptr (Ptr GDImage) -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr (Ptr GDImage)
fp ((Ptr (Ptr GDImage) -> IO a) -> IO a)
-> (Ptr (Ptr GDImage) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
\Ptr (Ptr GDImage)
pp -> Ptr (Ptr GDImage) -> IO (Ptr GDImage)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GDImage)
pp IO (Ptr GDImage) -> (Ptr GDImage -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr GDImage
p ->
if Ptr GDImage
p Ptr GDImage -> Ptr GDImage -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr GDImage
forall a. Ptr a
F.nullPtr then FilePath -> IO a
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Image has been freed." else Ptr GDImage -> IO a
f Ptr GDImage
p
newImage :: Size -> IO Image
newImage :: Size -> IO Image
newImage (Int
w,Int
h) = CInt -> CInt -> IO Image
newImage_ (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
w) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
h)
newImage_ :: CInt -> CInt -> IO Image
newImage_ :: CInt -> CInt -> IO Image
newImage_ CInt
w CInt
h = do Ptr GDImage
p <- FilePath -> IO (Ptr GDImage) -> IO (Ptr GDImage)
forall a. FilePath -> IO (Ptr a) -> IO (Ptr a)
F.throwIfNull FilePath
"gdImageCreateTrueColor" (IO (Ptr GDImage) -> IO (Ptr GDImage))
-> IO (Ptr GDImage) -> IO (Ptr GDImage)
forall a b. (a -> b) -> a -> b
$
CInt -> CInt -> IO (Ptr GDImage)
gdImageCreateTrueColor CInt
w CInt
h
Ptr GDImage -> IO Image
mkImage Ptr GDImage
p
onNewImage :: CInt -> CInt -> (Ptr GDImage -> IO a) -> IO Image
onNewImage :: forall a. CInt -> CInt -> (Ptr GDImage -> IO a) -> IO Image
onNewImage CInt
w CInt
h Ptr GDImage -> IO a
f = CInt -> CInt -> IO Image
newImage_ CInt
w CInt
h IO Image -> (Image -> IO Image) -> IO Image
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Image
i -> Image -> (Ptr GDImage -> IO a) -> IO a
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i Ptr GDImage -> IO a
f IO a -> IO Image -> IO Image
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Image -> IO Image
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image
i
copyImage :: Image -> IO Image
copyImage :: Image -> IO Image
copyImage Image
i = Image -> (Ptr GDImage -> IO Image) -> IO Image
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i Ptr GDImage -> IO Image
f
where f :: Ptr GDImage -> IO Image
f Ptr GDImage
p = do (CInt
w,CInt
h) <- Ptr GDImage -> IO (CInt, CInt)
imageSize_ Ptr GDImage
p
CInt -> CInt -> (Ptr GDImage -> IO ()) -> IO Image
forall a. CInt -> CInt -> (Ptr GDImage -> IO a) -> IO Image
onNewImage CInt
w CInt
h (\Ptr GDImage
p' -> Ptr GDImage
-> Ptr GDImage
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> IO ()
gdImageCopy Ptr GDImage
p' Ptr GDImage
p CInt
0 CInt
0 CInt
0 CInt
0 CInt
w CInt
h)
copyRegion :: Point
-> Size
-> Image
-> Point
-> Image
-> IO ()
copyRegion :: Size -> Size -> Image -> Size -> Image -> IO ()
copyRegion (Int
srcX, Int
srcY) (Int
w, Int
h) Image
srcIPtr (Int
dstX, Int
dstY) Image
dstIPtr
= Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
dstIPtr ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Ptr GDImage
dstImg -> Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
srcIPtr ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Ptr GDImage
srcImg -> Ptr GDImage
-> Ptr GDImage
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> IO ()
gdImageCopy Ptr GDImage
dstImg Ptr GDImage
srcImg (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
dstX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
dstY)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
srcX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
srcY) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
w) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
h)
copyRegionScaled :: Point
-> Size
-> Image
-> Point
-> Size
-> Image
-> IO ()
copyRegionScaled :: Size -> Size -> Image -> Size -> Size -> Image -> IO ()
copyRegionScaled (Int
srcX, Int
srcY) (Int
srcW, Int
srcH) Image
srcIPtr (Int
dstX, Int
dstY) (Int
dstW, Int
dstH)
Image
dstIPtr
= Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
dstIPtr ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Ptr GDImage
dstImg -> Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
srcIPtr ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Ptr GDImage
srcImg -> Ptr GDImage
-> Ptr GDImage
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> IO ()
gdImageCopyResampled Ptr GDImage
dstImg Ptr GDImage
srcImg (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
dstX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
dstY)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
srcX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
srcY) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
dstW) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
dstH)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
srcW) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
srcH)
getPixel :: (Int,Int) -> Image -> IO Color
getPixel :: Size -> Image -> IO CInt
getPixel (Int
x,Int
y) Image
i = Image -> (Ptr GDImage -> IO CInt) -> IO CInt
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i Ptr GDImage -> IO CInt
f
where f :: Ptr GDImage -> IO CInt
f Ptr GDImage
p' = Ptr GDImage -> CInt -> CInt -> IO CInt
gdImageGetPixel Ptr GDImage
p' (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
x) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
y)
imageSize :: Image -> IO (Int,Int)
imageSize :: Image -> IO Size
imageSize Image
i = ((CInt, CInt) -> Size) -> IO (CInt, CInt) -> IO Size
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (CInt, CInt) -> Size
f (IO (CInt, CInt) -> IO Size) -> IO (CInt, CInt) -> IO Size
forall a b. (a -> b) -> a -> b
$ Image -> (Ptr GDImage -> IO (CInt, CInt)) -> IO (CInt, CInt)
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i Ptr GDImage -> IO (CInt, CInt)
imageSize_
where f :: (CInt, CInt) -> Size
f = (\ (CInt
w,CInt
h) -> (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
w, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
h))
imageSize_ :: Ptr GDImage -> IO (CInt,CInt)
imageSize_ :: Ptr GDImage -> IO (CInt, CInt)
imageSize_ Ptr GDImage
p = do CInt
w <- (\Ptr GDImage
hsc_ptr -> Ptr GDImage -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr GDImage
hsc_ptr Int
8) Ptr GDImage
p
{-# LINE 270 "Graphics/GD/Internal.hsc" #-}
CInt
h <- (\Ptr GDImage
hsc_ptr -> Ptr GDImage -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr GDImage
hsc_ptr Int
12) Ptr GDImage
p
{-# LINE 271 "Graphics/GD/Internal.hsc" #-}
(CInt, CInt) -> IO (CInt, CInt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
w, CInt
h)
resizeImage :: Int
-> Int
-> Image
-> IO Image
resizeImage :: Int -> Int -> Image -> IO Image
resizeImage Int
w Int
h Image
i = Image -> (Ptr GDImage -> IO Image) -> IO Image
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i Ptr GDImage -> IO Image
f
where
f :: Ptr GDImage -> IO Image
f Ptr GDImage
p = do let (CInt
outW,CInt
outH) = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w, Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
(CInt
inW, CInt
inH) <- Ptr GDImage -> IO (CInt, CInt)
imageSize_ Ptr GDImage
p
CInt -> CInt -> (Ptr GDImage -> IO ()) -> IO Image
forall a. CInt -> CInt -> (Ptr GDImage -> IO a) -> IO Image
onNewImage CInt
outW CInt
outH ((Ptr GDImage -> IO ()) -> IO Image)
-> (Ptr GDImage -> IO ()) -> IO Image
forall a b. (a -> b) -> a -> b
$ \Ptr GDImage
p' ->
Ptr GDImage
-> Ptr GDImage
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> IO ()
gdImageCopyResampled Ptr GDImage
p' Ptr GDImage
p CInt
0 CInt
0 CInt
0 CInt
0 CInt
outW CInt
outH CInt
inW CInt
inH
rotateImage :: Int
-> Image
-> IO Image
rotateImage :: Int -> Image -> IO Image
rotateImage Int
r Image
i = Image -> (Ptr GDImage -> IO Image) -> IO Image
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i Ptr GDImage -> IO Image
f
where f :: Ptr GDImage -> IO Image
f Ptr GDImage
p = do (CInt
inW,CInt
inH) <- Ptr GDImage -> IO (CInt, CInt)
imageSize_ Ptr GDImage
p
let q :: CInt
q = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
r Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4)
(CInt
outW,CInt
outH) | Int
r Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (CInt
inW,CInt
inH)
| Bool
otherwise = (CInt
inH,CInt
inW)
srcX :: CInt
srcX = if CInt
q CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1 Bool -> Bool -> Bool
|| CInt
q CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
2 then CInt
inWCInt -> CInt -> CInt
forall a. Num a => a -> a -> a
-CInt
1 else CInt
0;
srcY :: CInt
srcY = if CInt
q CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
2 Bool -> Bool -> Bool
|| CInt
q CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
3 then CInt
inHCInt -> CInt -> CInt
forall a. Num a => a -> a -> a
-CInt
1 else CInt
0;
CInt -> CInt -> (Ptr GDImage -> IO ()) -> IO Image
forall a. CInt -> CInt -> (Ptr GDImage -> IO a) -> IO Image
onNewImage CInt
outW CInt
outH (\Ptr GDImage
p' ->
Ptr GDImage
-> Ptr GDImage
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> IO ()
gdImageCopyRotated90 Ptr GDImage
p' Ptr GDImage
p CInt
0 CInt
0 CInt
srcX CInt
srcY CInt
inW CInt
inH CInt
q)
fillImage :: Color -> Image -> IO ()
fillImage :: CInt -> Image -> IO ()
fillImage CInt
c Image
i = do Size
sz <- Image -> IO Size
imageSize Image
i
Size -> Size -> CInt -> Image -> IO ()
drawFilledRectangle (Int
0,Int
0) Size
sz CInt
c Image
i
drawFilledRectangle :: Point
-> Point
-> Color -> Image -> IO ()
drawFilledRectangle :: Size -> Size -> CInt -> Image -> IO ()
drawFilledRectangle (Int
x1,Int
y1) (Int
x2,Int
y2) CInt
c Image
i =
Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GDImage
p ->
Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> IO ()
gdImageFilledRectangle Ptr GDImage
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
x1) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
y1) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
x2) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
y2) CInt
c
drawFilledEllipse :: Point
-> Size
-> Color -> Image -> IO ()
drawFilledEllipse :: Size -> Size -> CInt -> Image -> IO ()
drawFilledEllipse (Int
cx,Int
cy) (Int
w,Int
h) CInt
c Image
i =
Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GDImage
p ->
Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> IO ()
gdImageFilledEllipse Ptr GDImage
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
cx) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
cy) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
w) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
h) CInt
c
drawLine :: Point
-> Point
-> Color -> Image -> IO ()
drawLine :: Size -> Size -> CInt -> Image -> IO ()
drawLine (Int
x1,Int
y1) (Int
x2,Int
y2) CInt
c Image
i =
Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GDImage
p ->
Ptr GDImage -> CInt -> CInt -> CInt -> CInt -> CInt -> IO ()
gdImageLine Ptr GDImage
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
x1) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
y1) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
x2) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
y2) CInt
c
drawArc :: Point
-> Size
-> Int
-> Int
-> Color -> Image -> IO ()
drawArc :: Size -> Size -> Int -> Int -> CInt -> Image -> IO ()
drawArc (Int
cx,Int
cy) (Int
w,Int
h) Int
sp Int
ep CInt
c Image
i =
Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GDImage
p ->
Ptr GDImage
-> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO ()
gdImageArc Ptr GDImage
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
cx) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
cy) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
w) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
h) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
sp) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
ep) CInt
c
antiAliased :: (Color -> Image -> IO a) -> Color -> Image -> IO a
antiAliased :: forall a. (CInt -> Image -> IO a) -> CInt -> Image -> IO a
antiAliased CInt -> Image -> IO a
f CInt
c Image
i =
do Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i (\Ptr GDImage
p -> Ptr GDImage -> CInt -> IO ()
gdImageSetAntiAliased Ptr GDImage
p CInt
c)
CInt -> Image -> IO a
f (-CInt
7) Image
i
{-# LINE 349 "Graphics/GD/Internal.hsc" #-}
setPixel :: Point -> Color -> Image -> IO ()
setPixel :: Size -> CInt -> Image -> IO ()
setPixel (Int
x,Int
y) CInt
c Image
i =
Image -> (Ptr GDImage -> IO ()) -> IO ()
forall a. Image -> (Ptr GDImage -> IO a) -> IO a
withImagePtr Image
i ((Ptr GDImage -> IO ()) -> IO ())
-> (Ptr GDImage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GDImage
p ->
Ptr GDImage -> CInt -> CInt -> CInt -> IO ()
gdImageSetPixel Ptr GDImage
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
x) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
y) CInt
c
rgb :: Int
-> Int
-> Int
-> Color
rgb :: Int -> Int -> Int -> CInt
rgb Int
r Int
g Int
b = Int -> Int -> Int -> Int -> CInt
rgba Int
r Int
g Int
b Int
0
rgba :: Int
-> Int
-> Int
-> Int
-> Color
rgba :: Int -> Int -> Int -> Int -> CInt
rgba Int
r Int
g Int
b Int
a =
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
a CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`F.shiftL` Int
24) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
r CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`F.shiftL` Int
16) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
g CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
`F.shiftL` Int
8) CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|.
Int -> CInt
forall a b. (Integral a, Num b) => a -> b
int Int
b
toRGBA :: Color -> (Int, Int, Int, Int)
toRGBA :: CInt -> (Int, Int, Int, Int)
toRGBA CInt
c = (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
r, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
g, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
b, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
a)
where
b :: CInt
b = CInt
c CInt -> CInt -> CInt
forall a. Integral a => a -> a -> a
`mod` CInt
byte
g :: CInt
g = CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
shiftR CInt
c Int
8 CInt -> CInt -> CInt
forall a. Integral a => a -> a -> a
`mod` CInt
byte
r :: CInt
r = CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
shiftR CInt
c Int
16 CInt -> CInt -> CInt
forall a. Integral a => a -> a -> a
`mod` CInt
byte
a :: CInt
a = CInt -> Int -> CInt
forall a. Bits a => a -> Int -> a
shiftR CInt
c Int
24 CInt -> CInt -> CInt
forall a. Integral a => a -> a -> a
`mod` CInt
byte
byte :: CInt
byte = CInt
2 CInt -> Int -> CInt
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
8::Int)
useFontConfig :: Bool -> IO Bool
useFontConfig :: Bool -> IO Bool
useFontConfig Bool
use = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ CInt -> IO CInt
gdFTUseFontConfig (CInt -> IO CInt) -> CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ if Bool
use then CInt
1 else CInt
0
int :: (Integral a, Num b) => a -> b
int :: forall a b. (Integral a, Num b) => a -> b
int = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral
double :: (Real a, Fractional b) => a -> b
double :: forall a b. (Real a, Fractional b) => a -> b
double = a -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac