{-# LINE 2 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LINE 3 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LINE 4 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
module Graphics.UI.Gtk.Gdk.Pixbuf (
Pixbuf,
PixbufClass,
castToPixbuf, gTypePixbuf,
toPixbuf,
PixbufError(..),
Colorspace(..),
pixbufNew,
pixbufNewFromData,
pixbufNewFromFile,
pixbufNewFromFileAtSize,
pixbufNewFromFileAtScale,
pixbufNewFromSurface,
pixbufNewFromWindow,
pixbufNewFromInline,
InlineImage,
pixbufNewSubpixbuf,
pixbufNewFromXPMData,
pixbufGetColorSpace,
pixbufGetNChannels,
pixbufGetHasAlpha,
pixbufGetBitsPerSample,
PixbufData,
pixbufGetPixels,
pixbufGetWidth,
pixbufGetHeight,
pixbufGetRowstride,
pixbufGetOption,
ImageFormat,
pixbufGetFormats,
pixbufSave,
pixbufCopy,
InterpType(..),
pixbufScaleSimple,
pixbufScale,
pixbufComposite,
pixbufFlipHorizontally,
pixbufFlipHorazontally,
pixbufFlipVertically,
pixbufRotateSimple,
PixbufRotation(..),
pixbufAddAlpha,
pixbufCopyArea,
pixbufFill,
) where
import Control.Monad (liftM)
import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.GObject
import Graphics.UI.Gtk.Types
{-# LINE 133 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
import System.Glib.GError (GError(..), GErrorClass(..), GErrorDomain,
propagateGError)
import Graphics.UI.Gtk.Gdk.PixbufData ( PixbufData, mkPixbufData )
import Graphics.Rendering.Cairo
import Graphics.Rendering.Cairo.Types
{-# LINE 147 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
data PixbufError = PixbufErrorCorruptImage
| PixbufErrorInsufficientMemory
| PixbufErrorBadOption
| PixbufErrorUnknownType
| PixbufErrorUnsupportedOperation
| PixbufErrorFailed
| PixbufErrorIncompleteAnimation
deriving (Enum)
{-# LINE 151 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
data Colorspace = ColorspaceRgb
deriving (Enum)
{-# LINE 157 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
pixbufGetColorSpace :: Pixbuf -> IO Colorspace
pixbufGetColorSpace :: Pixbuf -> IO Colorspace
pixbufGetColorSpace Pixbuf
pb = (CInt -> Colorspace) -> IO CInt -> IO Colorspace
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Colorspace
forall a. Enum a => Int -> a
toEnum (Int -> Colorspace) -> (CInt -> Int) -> CInt -> Colorspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO Colorspace) -> IO CInt -> IO Colorspace
forall a b. (a -> b) -> a -> b
$
(\(Pixbuf ForeignPtr Pixbuf
arg1) -> ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO CInt) -> IO CInt)
-> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> IO CInt
gdk_pixbuf_get_colorspace Ptr Pixbuf
argPtr1) Pixbuf
pb
pixbufGetNChannels :: Pixbuf -> IO Int
pixbufGetNChannels :: Pixbuf -> IO Int
pixbufGetNChannels Pixbuf
pb = (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
(\(Pixbuf ForeignPtr Pixbuf
arg1) -> ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO CInt) -> IO CInt)
-> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> IO CInt
gdk_pixbuf_get_n_channels Ptr Pixbuf
argPtr1) Pixbuf
pb
pixbufGetHasAlpha :: Pixbuf -> IO Bool
pixbufGetHasAlpha :: Pixbuf -> IO Bool
pixbufGetHasAlpha Pixbuf
pb =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ (\(Pixbuf ForeignPtr Pixbuf
arg1) -> ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO CInt) -> IO CInt)
-> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> IO CInt
gdk_pixbuf_get_has_alpha Ptr Pixbuf
argPtr1) Pixbuf
pb
pixbufGetBitsPerSample :: Pixbuf -> IO Int
pixbufGetBitsPerSample :: Pixbuf -> IO Int
pixbufGetBitsPerSample Pixbuf
pb = (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
(\(Pixbuf ForeignPtr Pixbuf
arg1) -> ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO CInt) -> IO CInt)
-> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> IO CInt
gdk_pixbuf_get_bits_per_sample Ptr Pixbuf
argPtr1) Pixbuf
pb
pixbufGetPixels :: Storable e => Pixbuf -> IO (PixbufData Int e)
pixbufGetPixels :: forall e. Storable e => Pixbuf -> IO (PixbufData Int e)
pixbufGetPixels Pixbuf
pb = do
Ptr CUChar
pixPtr_ <- (\(Pixbuf ForeignPtr Pixbuf
arg1) -> ForeignPtr Pixbuf
-> (Ptr Pixbuf -> IO (Ptr CUChar)) -> IO (Ptr CUChar)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO (Ptr CUChar)) -> IO (Ptr CUChar))
-> (Ptr Pixbuf -> IO (Ptr CUChar)) -> IO (Ptr CUChar)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> IO (Ptr CUChar)
gdk_pixbuf_get_pixels Ptr Pixbuf
argPtr1) Pixbuf
pb
Int
chan <- Pixbuf -> IO Int
pixbufGetNChannels Pixbuf
pb
Int
bits <- Pixbuf -> IO Int
pixbufGetBitsPerSample Pixbuf
pb
Int
w <- Pixbuf -> IO Int
pixbufGetWidth Pixbuf
pb
Int
h <- Pixbuf -> IO Int
pixbufGetHeight Pixbuf
pb
Int
r <- Pixbuf -> IO Int
pixbufGetRowstride Pixbuf
pb
let pixPtr :: Ptr b
pixPtr = Ptr CUChar -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
pixPtr_
let bytes :: Int
bytes = (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*((Int
chanInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
bitsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)
PixbufData Int e -> IO (PixbufData Int e)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pixbuf -> Ptr e -> Int -> PixbufData Int e
forall e. Storable e => Pixbuf -> Ptr e -> Int -> PixbufData Int e
mkPixbufData Pixbuf
pb Ptr e
forall {b}. Ptr b
pixPtr Int
bytes)
pixbufGetWidth :: Pixbuf -> IO Int
pixbufGetWidth :: Pixbuf -> IO Int
pixbufGetWidth Pixbuf
pb = (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
(\(Pixbuf ForeignPtr Pixbuf
arg1) -> ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO CInt) -> IO CInt)
-> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> IO CInt
gdk_pixbuf_get_width Ptr Pixbuf
argPtr1) Pixbuf
pb
pixbufGetHeight :: Pixbuf -> IO Int
pixbufGetHeight :: Pixbuf -> IO Int
pixbufGetHeight Pixbuf
pb = (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
(\(Pixbuf ForeignPtr Pixbuf
arg1) -> ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO CInt) -> IO CInt)
-> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> IO CInt
gdk_pixbuf_get_height Ptr Pixbuf
argPtr1) Pixbuf
pb
pixbufGetRowstride :: Pixbuf -> IO Int
pixbufGetRowstride :: Pixbuf -> IO Int
pixbufGetRowstride Pixbuf
pb = (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
(\(Pixbuf ForeignPtr Pixbuf
arg1) -> ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO CInt) -> IO CInt)
-> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> IO CInt
gdk_pixbuf_get_rowstride Ptr Pixbuf
argPtr1) Pixbuf
pb
pixbufGetOption :: (GlibString string) => Pixbuf -> string -> IO (Maybe string)
pixbufGetOption :: forall string.
GlibString string =>
Pixbuf -> string -> IO (Maybe string)
pixbufGetOption Pixbuf
pb string
key = string -> (Ptr CChar -> IO (Maybe string)) -> IO (Maybe string)
forall a. string -> (Ptr CChar -> IO a) -> IO a
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
withUTFString string
key ((Ptr CChar -> IO (Maybe string)) -> IO (Maybe string))
-> (Ptr CChar -> IO (Maybe string)) -> IO (Maybe string)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
strPtr -> do
Ptr CChar
resPtr <- (\(Pixbuf ForeignPtr Pixbuf
arg1) Ptr CChar
arg2 -> ForeignPtr Pixbuf
-> (Ptr Pixbuf -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO (Ptr CChar)) -> IO (Ptr CChar))
-> (Ptr Pixbuf -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> Ptr CChar -> IO (Ptr CChar)
gdk_pixbuf_get_option Ptr Pixbuf
argPtr1 Ptr CChar
arg2) Pixbuf
pb Ptr CChar
strPtr
if (Ptr CChar
resPtrPtr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr CChar
forall {b}. Ptr b
nullPtr) then Maybe string -> IO (Maybe string)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe string
forall a. Maybe a
Nothing else
(string -> Maybe string) -> IO string -> IO (Maybe string)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM string -> Maybe string
forall a. a -> Maybe a
Just (IO string -> IO (Maybe string)) -> IO string -> IO (Maybe string)
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> IO string
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString Ptr CChar
resPtr
pixbufErrorDomain :: GErrorDomain
pixbufErrorDomain :: CUInt
pixbufErrorDomain = CUInt
gdk_pixbuf_error_quark
{-# LINE 268 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
instance GErrorClass PixbufError where
gerrorDomain :: PixbufError -> CUInt
gerrorDomain PixbufError
_ = CUInt
pixbufErrorDomain
pixbufNewFromFile :: GlibFilePath fp => fp -> IO Pixbuf
pixbufNewFromFile :: forall fp. GlibFilePath fp => fp -> IO Pixbuf
pixbufNewFromFile fp
fname =
(ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf) -> IO (Ptr Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$
(Ptr (Ptr ()) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a. (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError ((Ptr (Ptr ()) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr (Ptr ()) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
errPtrPtr ->
fp -> (Ptr CChar -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a. fp -> (Ptr CChar -> IO a) -> IO a
forall fp a. GlibFilePath fp => fp -> (Ptr CChar -> IO a) -> IO a
withUTFFilePath fp
fname ((Ptr CChar -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr CChar -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
strPtr ->
Ptr CChar -> Ptr (Ptr ()) -> IO (Ptr Pixbuf)
gdk_pixbuf_new_from_file
{-# LINE 290 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
Ptr CChar
strPtr Ptr (Ptr ())
errPtrPtr
pixbufNewFromFileAtSize :: GlibString string => string -> Int -> Int -> IO Pixbuf
pixbufNewFromFileAtSize :: forall string.
GlibString string =>
string -> Int -> Int -> IO Pixbuf
pixbufNewFromFileAtSize string
filename Int
width Int
height =
(ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf) -> IO (Ptr Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$
(Ptr (Ptr ()) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a. (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError ((Ptr (Ptr ()) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr (Ptr ()) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
errPtrPtr ->
string -> (Ptr CChar -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a. string -> (Ptr CChar -> IO a) -> IO a
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
withUTFString string
filename ((Ptr CChar -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr CChar -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
filenamePtr ->
Ptr CChar -> CInt -> CInt -> Ptr (Ptr ()) -> IO (Ptr Pixbuf)
gdk_pixbuf_new_from_file_at_size
{-# LINE 313 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
Ptr CChar
filenamePtr
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
Ptr (Ptr ())
errPtrPtr
pixbufNewFromFileAtScale :: GlibString string
=> string
-> Int
-> Int
-> Bool
-> IO Pixbuf
pixbufNewFromFileAtScale :: forall string.
GlibString string =>
string -> Int -> Int -> Bool -> IO Pixbuf
pixbufNewFromFileAtScale string
filename Int
width Int
height Bool
preserveAspectRatio =
(ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf) -> IO (Ptr Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$
(Ptr (Ptr ()) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a. (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError ((Ptr (Ptr ()) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr (Ptr ()) -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
errPtrPtr ->
string -> (Ptr CChar -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a. string -> (Ptr CChar -> IO a) -> IO a
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
withUTFString string
filename ((Ptr CChar -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr CChar -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
filenamePtr ->
Ptr CChar
-> CInt -> CInt -> CInt -> Ptr (Ptr ()) -> IO (Ptr Pixbuf)
gdk_pixbuf_new_from_file_at_scale
{-# LINE 351 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
Ptr CChar
filenamePtr
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
preserveAspectRatio)
Ptr (Ptr ())
errPtrPtr
pixbufNewFromSurface :: Surface -> Int -> Int -> Int -> Int -> IO Pixbuf
pixbufNewFromSurface :: Surface -> Int -> Int -> Int -> Int -> IO Pixbuf
pixbufNewFromSurface Surface
surface Int
srcX Int
srcY Int
width Int
height =
Surface -> (Ptr Surface -> IO Pixbuf) -> IO Pixbuf
forall {b}. Surface -> (Ptr Surface -> IO b) -> IO b
withSurface Surface
surface ((Ptr Surface -> IO Pixbuf) -> IO Pixbuf)
-> (Ptr Surface -> IO Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$ \Ptr Surface
ss -> (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf) -> IO (Ptr Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$
Ptr () -> CInt -> CInt -> CInt -> CInt -> IO (Ptr Pixbuf)
gdk_pixbuf_get_from_surface
{-# LINE 369 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
(castPtr ss)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcX)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcY)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
pixbufNewFromWindow :: DrawWindowClass self
=> self
-> Int
-> Int
-> Int
-> Int
-> IO Pixbuf
pixbufNewFromWindow :: forall self.
DrawWindowClass self =>
self -> Int -> Int -> Int -> Int -> IO Pixbuf
pixbufNewFromWindow self
window Int
srcX Int
srcY Int
width Int
height =
(ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf) -> IO (Ptr Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$
(\(DrawWindow ForeignPtr DrawWindow
arg1) CInt
arg2 CInt
arg3 CInt
arg4 CInt
arg5 -> ForeignPtr DrawWindow
-> (Ptr DrawWindow -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr DrawWindow -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> CInt -> CInt -> CInt -> CInt -> IO (Ptr Pixbuf)
gdk_pixbuf_get_from_window Ptr DrawWindow
argPtr1 CInt
arg2 CInt
arg3 CInt
arg4 CInt
arg5)
{-# LINE 390 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
(toDrawWindow window)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcX)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcY)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
type ImageFormat = DefaultGlibString
pixbufGetFormats :: [ImageFormat]
pixbufGetFormats :: [ImageFormat]
pixbufGetFormats = [ImageFormat
"png",ImageFormat
"bmp",ImageFormat
"wbmp", ImageFormat
"gif",ImageFormat
"ico",ImageFormat
"ani",ImageFormat
"jpeg",ImageFormat
"pnm",
ImageFormat
"ras",ImageFormat
"tiff",ImageFormat
"xpm",ImageFormat
"xbm",ImageFormat
"tga"]
pixbufSave :: (GlibString string, GlibFilePath fp) => Pixbuf -> fp -> ImageFormat -> [(string, string)] ->
IO ()
pixbufSave :: forall string fp.
(GlibString string, GlibFilePath fp) =>
Pixbuf -> fp -> ImageFormat -> [(string, string)] -> IO ()
pixbufSave Pixbuf
pb fp
fname ImageFormat
iType [(string, string)]
options =
let ([string]
keys, [string]
values) = [(string, string)] -> ([string], [string])
forall a b. [(a, b)] -> ([a], [b])
unzip [(string, string)]
options in
(Ptr (Ptr ()) -> IO ()) -> IO ()
forall a. (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError ((Ptr (Ptr ()) -> IO ()) -> IO ())
-> (Ptr (Ptr ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
errPtrPtr ->
fp -> (Ptr CChar -> IO ()) -> IO ()
forall a. fp -> (Ptr CChar -> IO a) -> IO a
forall fp a. GlibFilePath fp => fp -> (Ptr CChar -> IO a) -> IO a
withUTFFilePath fp
fname ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
fnPtr ->
ImageFormat -> (Ptr CChar -> IO ()) -> IO ()
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
forall a. ImageFormat -> (Ptr CChar -> IO a) -> IO a
withUTFString ImageFormat
iType ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
tyPtr ->
[string] -> (Ptr (Ptr CChar) -> IO ()) -> IO ()
forall s a.
GlibString s =>
[s] -> (Ptr (Ptr CChar) -> IO a) -> IO a
withUTFStringArray0 [string]
keys ((Ptr (Ptr CChar) -> IO ()) -> IO ())
-> (Ptr (Ptr CChar) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
keysPtr ->
[string] -> (Ptr (Ptr CChar) -> IO ()) -> IO ()
forall s a.
GlibString s =>
[s] -> (Ptr (Ptr CChar) -> IO a) -> IO a
withUTFStringArray [string]
values ((Ptr (Ptr CChar) -> IO ()) -> IO ())
-> (Ptr (Ptr CChar) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
valuesPtr -> do
(\(Pixbuf ForeignPtr Pixbuf
arg1) Ptr CChar
arg2 Ptr CChar
arg3 Ptr (Ptr CChar)
arg4 Ptr (Ptr CChar)
arg5 Ptr (Ptr ())
arg6 -> ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO CInt) -> IO CInt)
-> (Ptr Pixbuf -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf
-> Ptr CChar
-> Ptr CChar
-> Ptr (Ptr CChar)
-> Ptr (Ptr CChar)
-> Ptr (Ptr ())
-> IO CInt
gdk_pixbuf_savev Ptr Pixbuf
argPtr1 Ptr CChar
arg2 Ptr CChar
arg3 Ptr (Ptr CChar)
arg4 Ptr (Ptr CChar)
arg5 Ptr (Ptr ())
arg6)
{-# LINE 435 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
Pixbuf
pb Ptr CChar
fnPtr Ptr CChar
tyPtr Ptr (Ptr CChar)
keysPtr Ptr (Ptr CChar)
valuesPtr Ptr (Ptr ())
errPtrPtr
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
pixbufNew :: Colorspace -> Bool -> Int -> Int -> Int -> IO Pixbuf
pixbufNew :: Colorspace -> Bool -> Int -> Int -> Int -> IO Pixbuf
pixbufNew Colorspace
colorspace Bool
hasAlpha Int
bitsPerSample Int
width Int
height =
(ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf) -> IO (Ptr Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$
CInt -> CInt -> CInt -> CInt -> CInt -> IO (Ptr Pixbuf)
gdk_pixbuf_new ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Colorspace -> Int) -> Colorspace -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colorspace -> Int
forall a. Enum a => a -> Int
fromEnum) Colorspace
colorspace)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
hasAlpha) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bitsPerSample) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
pixbufNewFromData :: Ptr CUChar -> Colorspace -> Bool -> Int -> Int -> Int -> Int -> IO Pixbuf
pixbufNewFromData :: Ptr CUChar
-> Colorspace -> Bool -> Int -> Int -> Int -> Int -> IO Pixbuf
pixbufNewFromData Ptr CUChar
imData Colorspace
cSpace Bool
hasAlpha Int
bitsPerSample Int
width Int
height Int
rowStride
= (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf) -> IO (Ptr Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$
Ptr CUChar
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> FunPtr (Ptr CUChar -> Ptr () -> IO ())
-> Ptr ()
-> IO (Ptr Pixbuf)
gdk_pixbuf_new_from_data
{-# LINE 460 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
imData
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Colorspace -> Int) -> Colorspace -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colorspace -> Int
forall a. Enum a => a -> Int
fromEnum (Colorspace -> CInt) -> Colorspace -> CInt
forall a b. (a -> b) -> a -> b
$ Colorspace
cSpace)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
hasAlpha)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bitsPerSample)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rowStride)
FunPtr (Ptr CUChar -> Ptr () -> IO ())
forall a. FunPtr a
nullFunPtr Ptr ()
forall {b}. Ptr b
nullPtr
pixbufNewFromXPMData :: GlibString string => [string] -> IO Pixbuf
pixbufNewFromXPMData :: forall string. GlibString string => [string] -> IO Pixbuf
pixbufNewFromXPMData [string]
s =
[string] -> (Ptr (Ptr CChar) -> IO Pixbuf) -> IO Pixbuf
forall s a.
GlibString s =>
[s] -> (Ptr (Ptr CChar) -> IO a) -> IO a
withUTFStringArray0 [string]
s ((Ptr (Ptr CChar) -> IO Pixbuf) -> IO Pixbuf)
-> (Ptr (Ptr CChar) -> IO Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
strsPtr ->
(ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf) -> IO (Ptr Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr CChar) -> IO (Ptr Pixbuf)
gdk_pixbuf_new_from_xpm_data Ptr (Ptr CChar)
strsPtr
data InlineImage
pixbufNewFromInline :: Ptr InlineImage -> IO Pixbuf
pixbufNewFromInline :: Ptr InlineImage -> IO Pixbuf
pixbufNewFromInline Ptr InlineImage
iPtr = (Ptr (Ptr GError) -> IO Pixbuf) -> IO Pixbuf
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr GError) -> IO Pixbuf) -> IO Pixbuf)
-> (Ptr (Ptr GError) -> IO Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr GError)
errPtrPtr -> do
Ptr Pixbuf
pbPtr <- CInt -> Ptr CUChar -> CInt -> Ptr (Ptr ()) -> IO (Ptr Pixbuf)
gdk_pixbuf_new_from_inline (-CInt
1) (Ptr InlineImage -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr Ptr InlineImage
iPtr)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
False) (Ptr (Ptr GError) -> Ptr (Ptr ())
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr GError)
errPtrPtr)
if Ptr Pixbuf
pbPtrPtr Pixbuf -> Ptr Pixbuf -> Bool
forall a. Eq a => a -> a -> Bool
/=Ptr Pixbuf
forall {b}. Ptr b
nullPtr then (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (Ptr Pixbuf -> IO (Ptr Pixbuf)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Pixbuf
pbPtr)
else do
Ptr GError
errPtr <- Ptr (Ptr GError) -> IO (Ptr GError)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GError)
errPtrPtr
(GError CUInt
dom Int
code ImageFormat
msg) <- Ptr GError -> IO GError
forall a. Storable a => Ptr a -> IO a
peek Ptr GError
errPtr
[Char] -> IO Pixbuf
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO Pixbuf) -> [Char] -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$ ImageFormat -> [Char]
glibToString ImageFormat
msg
pixbufNewSubpixbuf :: Pixbuf -> Int -> Int -> Int -> Int -> IO Pixbuf
pixbufNewSubpixbuf :: Pixbuf -> Int -> Int -> Int -> Int -> IO Pixbuf
pixbufNewSubpixbuf Pixbuf
pb Int
srcX Int
srcY Int
height Int
width =
(ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf) -> IO (Ptr Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$ do
Ptr Pixbuf
pbPtr <- (\(Pixbuf ForeignPtr Pixbuf
arg1) CInt
arg2 CInt
arg3 CInt
arg4 CInt
arg5 -> ForeignPtr Pixbuf
-> (Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> CInt -> CInt -> CInt -> CInt -> IO (Ptr Pixbuf)
gdk_pixbuf_new_subpixbuf Ptr Pixbuf
argPtr1 CInt
arg2 CInt
arg3 CInt
arg4 CInt
arg5) Pixbuf
pb
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcY)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
if Ptr Pixbuf
pbPtrPtr Pixbuf -> Ptr Pixbuf -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr Pixbuf
forall {b}. Ptr b
nullPtr then [Char] -> IO (Ptr Pixbuf)
forall a. HasCallStack => [Char] -> a
error [Char]
"pixbufNewSubpixbuf: invalid bounds"
else Ptr Pixbuf -> IO (Ptr Pixbuf)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Pixbuf
pbPtr
pixbufCopy :: Pixbuf -> IO Pixbuf
pixbufCopy :: Pixbuf -> IO Pixbuf
pixbufCopy Pixbuf
pb = (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf) -> IO (Ptr Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$ (\(Pixbuf ForeignPtr Pixbuf
arg1) -> ForeignPtr Pixbuf
-> (Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> IO (Ptr Pixbuf)
gdk_pixbuf_copy Ptr Pixbuf
argPtr1) Pixbuf
pb
data InterpType = InterpNearest
| InterpTiles
| InterpBilinear
| InterpHyper
deriving (Int -> InterpType
InterpType -> Int
InterpType -> [InterpType]
InterpType -> InterpType
InterpType -> InterpType -> [InterpType]
InterpType -> InterpType -> InterpType -> [InterpType]
(InterpType -> InterpType)
-> (InterpType -> InterpType)
-> (Int -> InterpType)
-> (InterpType -> Int)
-> (InterpType -> [InterpType])
-> (InterpType -> InterpType -> [InterpType])
-> (InterpType -> InterpType -> [InterpType])
-> (InterpType -> InterpType -> InterpType -> [InterpType])
-> Enum InterpType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: InterpType -> InterpType
succ :: InterpType -> InterpType
$cpred :: InterpType -> InterpType
pred :: InterpType -> InterpType
$ctoEnum :: Int -> InterpType
toEnum :: Int -> InterpType
$cfromEnum :: InterpType -> Int
fromEnum :: InterpType -> Int
$cenumFrom :: InterpType -> [InterpType]
enumFrom :: InterpType -> [InterpType]
$cenumFromThen :: InterpType -> InterpType -> [InterpType]
enumFromThen :: InterpType -> InterpType -> [InterpType]
$cenumFromTo :: InterpType -> InterpType -> [InterpType]
enumFromTo :: InterpType -> InterpType -> [InterpType]
$cenumFromThenTo :: InterpType -> InterpType -> InterpType -> [InterpType]
enumFromThenTo :: InterpType -> InterpType -> InterpType -> [InterpType]
Enum)
{-# LINE 579 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
pixbufScaleSimple ::
Pixbuf
-> Int
-> Int
-> InterpType
-> IO Pixbuf
pixbufScaleSimple :: Pixbuf -> Int -> Int -> InterpType -> IO Pixbuf
pixbufScaleSimple Pixbuf
pb Int
width Int
height InterpType
interp =
(ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf) -> IO (Ptr Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$ (Ptr Pixbuf -> Ptr Pixbuf) -> IO (Ptr Pixbuf) -> IO (Ptr Pixbuf)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Ptr Pixbuf -> Ptr Pixbuf
forall a b. Ptr a -> Ptr b
castPtr (IO (Ptr Pixbuf) -> IO (Ptr Pixbuf))
-> IO (Ptr Pixbuf) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$
(\(Pixbuf ForeignPtr Pixbuf
arg1) CInt
arg2 CInt
arg3 CInt
arg4 -> ForeignPtr Pixbuf
-> (Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> CInt -> CInt -> CInt -> IO (Ptr Pixbuf)
gdk_pixbuf_scale_simple Ptr Pixbuf
argPtr1 CInt
arg2 CInt
arg3 CInt
arg4) (Pixbuf -> Pixbuf
forall o. PixbufClass o => o -> Pixbuf
toPixbuf Pixbuf
pb)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ InterpType -> Int
forall a. Enum a => a -> Int
fromEnum InterpType
interp)
pixbufScale ::
Pixbuf
-> Pixbuf
-> Int
-> Int
-> Int
-> Int
-> Double
-> Double
-> Double
-> Double
-> InterpType
-> IO ()
pixbufScale :: Pixbuf
-> Pixbuf
-> Int
-> Int
-> Int
-> Int
-> Double
-> Double
-> Double
-> Double
-> InterpType
-> IO ()
pixbufScale Pixbuf
src Pixbuf
dest Int
destX Int
destY Int
destWidth Int
destHeight Double
offsetX Double
offsetY
Double
scaleX Double
scaleY InterpType
interp =
(\(Pixbuf ForeignPtr Pixbuf
arg1) (Pixbuf ForeignPtr Pixbuf
arg2) CInt
arg3 CInt
arg4 CInt
arg5 CInt
arg6 CDouble
arg7 CDouble
arg8 CDouble
arg9 CDouble
arg10 CInt
arg11 -> ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO ()) -> IO ()) -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg2 ((Ptr Pixbuf -> IO ()) -> IO ()) -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr2 ->Ptr Pixbuf
-> Ptr Pixbuf
-> CInt
-> CInt
-> CInt
-> CInt
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> CInt
-> IO ()
gdk_pixbuf_scale Ptr Pixbuf
argPtr1 Ptr Pixbuf
argPtr2 CInt
arg3 CInt
arg4 CInt
arg5 CInt
arg6 CDouble
arg7 CDouble
arg8 CDouble
arg9 CDouble
arg10 CInt
arg11) Pixbuf
src Pixbuf
dest
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
destX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
destY)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
destWidth) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
destHeight)
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
offsetX) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
offsetY)
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
scaleX) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
scaleY)
((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (InterpType -> Int) -> InterpType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpType -> Int
forall a. Enum a => a -> Int
fromEnum) InterpType
interp)
pixbufComposite ::
Pixbuf
-> Pixbuf
-> Int
-> Int
-> Int
-> Int
-> Double
-> Double
-> Double
-> Double
-> InterpType
-> Word8
-> IO ()
pixbufComposite :: Pixbuf
-> Pixbuf
-> Int
-> Int
-> Int
-> Int
-> Double
-> Double
-> Double
-> Double
-> InterpType
-> Word8
-> IO ()
pixbufComposite Pixbuf
src Pixbuf
dest Int
destX Int
destY Int
destWidth Int
destHeight
Double
offsetX Double
offsetY Double
scaleX Double
scaleY InterpType
interp Word8
alpha =
(\(Pixbuf ForeignPtr Pixbuf
arg1) (Pixbuf ForeignPtr Pixbuf
arg2) CInt
arg3 CInt
arg4 CInt
arg5 CInt
arg6 CDouble
arg7 CDouble
arg8 CDouble
arg9 CDouble
arg10 CInt
arg11 CInt
arg12 -> ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO ()) -> IO ()) -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg2 ((Ptr Pixbuf -> IO ()) -> IO ()) -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr2 ->Ptr Pixbuf
-> Ptr Pixbuf
-> CInt
-> CInt
-> CInt
-> CInt
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> CInt
-> CInt
-> IO ()
gdk_pixbuf_composite Ptr Pixbuf
argPtr1 Ptr Pixbuf
argPtr2 CInt
arg3 CInt
arg4 CInt
arg5 CInt
arg6 CDouble
arg7 CDouble
arg8 CDouble
arg9 CDouble
arg10 CInt
arg11 CInt
arg12) Pixbuf
src Pixbuf
dest
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
destX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
destY) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
destWidth)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
destHeight) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
offsetX) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
offsetY)
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
scaleX) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
scaleY)
((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (InterpType -> Int) -> InterpType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpType -> Int
forall a. Enum a => a -> Int
fromEnum) InterpType
interp) (Word8 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
alpha)
pixbufFlipHorizontally :: Pixbuf -> IO Pixbuf
pixbufFlipHorizontally :: Pixbuf -> IO Pixbuf
pixbufFlipHorizontally Pixbuf
self =
(ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf) -> IO (Ptr Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$
(\(Pixbuf ForeignPtr Pixbuf
arg1) CInt
arg2 -> ForeignPtr Pixbuf
-> (Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> CInt -> IO (Ptr Pixbuf)
gdk_pixbuf_flip Ptr Pixbuf
argPtr1 CInt
arg2)
{-# LINE 678 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
self
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
True)
pixbufFlipHorazontally :: Pixbuf -> IO Pixbuf
pixbufFlipHorazontally = Pixbuf -> IO Pixbuf
pixbufFlipHorizontally
pixbufFlipVertically :: Pixbuf -> IO Pixbuf
pixbufFlipVertically :: Pixbuf -> IO Pixbuf
pixbufFlipVertically Pixbuf
self =
(ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf) -> IO (Ptr Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$
(\(Pixbuf ForeignPtr Pixbuf
arg1) CInt
arg2 -> ForeignPtr Pixbuf
-> (Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> CInt -> IO (Ptr Pixbuf)
gdk_pixbuf_flip Ptr Pixbuf
argPtr1 CInt
arg2)
{-# LINE 688 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
self
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
False)
pixbufRotateSimple :: Pixbuf -> PixbufRotation -> IO Pixbuf
pixbufRotateSimple :: Pixbuf -> PixbufRotation -> IO Pixbuf
pixbufRotateSimple Pixbuf
self PixbufRotation
angle =
(ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
-> IO (Ptr Pixbuf) -> IO Pixbuf
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr Pixbuf)
forall {a}. (ForeignPtr Pixbuf -> Pixbuf, FinalizerPtr a)
mkPixbuf (IO (Ptr Pixbuf) -> IO Pixbuf) -> IO (Ptr Pixbuf) -> IO Pixbuf
forall a b. (a -> b) -> a -> b
$
(\(Pixbuf ForeignPtr Pixbuf
arg1) CInt
arg2 -> ForeignPtr Pixbuf
-> (Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> CInt -> IO (Ptr Pixbuf)
gdk_pixbuf_rotate_simple Ptr Pixbuf
argPtr1 CInt
arg2)
{-# LINE 698 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
self
((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (PixbufRotation -> Int) -> PixbufRotation -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixbufRotation -> Int
forall a. Enum a => a -> Int
fromEnum) PixbufRotation
angle)
data PixbufRotation = PixbufRotateNone
| PixbufRotateCounterclockwise
| PixbufRotateUpsidedown
| PixbufRotateClockwise
instance Enum PixbufRotation where
fromEnum :: PixbufRotation -> Int
fromEnum PixbufRotation
PixbufRotateNone = Int
0
fromEnum PixbufRotation
PixbufRotateCounterclockwise = Int
90
fromEnum PixbufRotation
PixbufRotateUpsidedown = Int
180
fromEnum PixbufRotation
PixbufRotateClockwise = Int
270
toEnum :: Int -> PixbufRotation
toEnum Int
0 = PixbufRotation
PixbufRotateNone
toEnum Int
90 = PixbufRotation
PixbufRotateCounterclockwise
toEnum Int
180 = PixbufRotation
PixbufRotateUpsidedown
toEnum Int
270 = PixbufRotation
PixbufRotateClockwise
toEnum Int
unmatched = [Char] -> PixbufRotation
forall a. HasCallStack => [Char] -> a
error ([Char]
"PixbufRotation.toEnum: Cannot match " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
unmatched)
succ PixbufRotateNone = PixbufRotateCounterclockwise
succ PixbufRotateCounterclockwise = PixbufRotateUpsidedown
succ PixbufRotateUpsidedown = PixbufRotateClockwise
succ _ = undefined
pred :: PixbufRotation -> PixbufRotation
pred PixbufRotation
PixbufRotateCounterclockwise = PixbufRotation
PixbufRotateNone
pred PixbufRotation
PixbufRotateUpsidedown = PixbufRotation
PixbufRotateCounterclockwise
pred PixbufRotation
PixbufRotateClockwise = PixbufRotation
PixbufRotateUpsidedown
pred PixbufRotation
_ = PixbufRotation
forall a. HasCallStack => a
undefined
enumFromTo :: PixbufRotation -> PixbufRotation -> [PixbufRotation]
enumFromTo PixbufRotation
x PixbufRotation
y | PixbufRotation -> Int
forall a. Enum a => a -> Int
fromEnum PixbufRotation
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== PixbufRotation -> Int
forall a. Enum a => a -> Int
fromEnum PixbufRotation
y = [ PixbufRotation
y ]
| Bool
otherwise = PixbufRotation
x PixbufRotation -> [PixbufRotation] -> [PixbufRotation]
forall a. a -> [a] -> [a]
: PixbufRotation -> PixbufRotation -> [PixbufRotation]
forall a. Enum a => a -> a -> [a]
enumFromTo (PixbufRotation -> PixbufRotation
forall a. Enum a => a -> a
succ PixbufRotation
x) PixbufRotation
y
enumFrom :: PixbufRotation -> [PixbufRotation]
enumFrom PixbufRotation
x = PixbufRotation -> PixbufRotation -> [PixbufRotation]
forall a. Enum a => a -> a -> [a]
enumFromTo PixbufRotation
x PixbufRotation
PixbufRotateClockwise
enumFromThen :: PixbufRotation -> PixbufRotation -> [PixbufRotation]
enumFromThen PixbufRotation
_ PixbufRotation
_ = [Char] -> [PixbufRotation]
forall a. HasCallStack => [Char] -> a
error [Char]
"Enum PixbufRotation: enumFromThen not implemented"
enumFromThenTo :: PixbufRotation
-> PixbufRotation -> PixbufRotation -> [PixbufRotation]
enumFromThenTo PixbufRotation
_ PixbufRotation
_ PixbufRotation
_ = [Char] -> [PixbufRotation]
forall a. HasCallStack => [Char] -> a
error [Char]
"Enum PixbufRotation: enumFromThenTo not implemented"
{-# LINE 706 "./Graphics/UI/Gtk/Gdk/Pixbuf.chs" #-}
pixbufAddAlpha :: Pixbuf -> Maybe (Word8, Word8, Word8) -> IO Pixbuf
pixbufAddAlpha pb Nothing = wrapNewGObject mkPixbuf $
(\(Pixbuf arg1) arg2 arg3 arg4 arg5 -> withForeignPtr arg1 $ \argPtr1 ->gdk_pixbuf_add_alpha argPtr1 arg2 arg3 arg4 arg5) pb (fromBool False) 0 0 0
pixbufAddAlpha pb (Just (r,g,b)) = wrapNewGObject mkPixbuf $
(\(Pixbuf arg1) arg2 arg3 arg4 arg5 -> withForeignPtr arg1 $ \argPtr1 ->gdk_pixbuf_add_alpha argPtr1 arg2 arg3 arg4 arg5) pb (fromBool True)
(fromIntegral r) (fromIntegral g) (fromIntegral b)
pixbufCopyArea ::
Pixbuf
-> Int
-> Int
-> Int
-> Int
-> Pixbuf
-> Int
-> Int
-> IO ()
pixbufCopyArea :: Pixbuf -> Int -> Int -> Int -> Int -> Pixbuf -> Int -> Int -> IO ()
pixbufCopyArea Pixbuf
src Int
srcX Int
srcY Int
srcWidth Int
srcHeight Pixbuf
dest Int
destX Int
destY =
(\(Pixbuf ForeignPtr Pixbuf
arg1) CInt
arg2 CInt
arg3 CInt
arg4 CInt
arg5 (Pixbuf ForeignPtr Pixbuf
arg6) CInt
arg7 CInt
arg8 -> ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO ()) -> IO ()) -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg6 ((Ptr Pixbuf -> IO ()) -> IO ()) -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr6 ->Ptr Pixbuf
-> CInt
-> CInt
-> CInt
-> CInt
-> Ptr Pixbuf
-> CInt
-> CInt
-> IO ()
gdk_pixbuf_copy_area Ptr Pixbuf
argPtr1 CInt
arg2 CInt
arg3 CInt
arg4 CInt
arg5 Ptr Pixbuf
argPtr6 CInt
arg7 CInt
arg8) Pixbuf
src
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcY)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcWidth) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
srcHeight)
Pixbuf
dest (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
destX) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
destY)
pixbufFill :: Pixbuf -> Word8 -> Word8 -> Word8 -> Word8 -> IO ()
pixbufFill :: Pixbuf -> Word8 -> Word8 -> Word8 -> Word8 -> IO ()
pixbufFill Pixbuf
pb Word8
red Word8
green Word8
blue Word8
alpha = (\(Pixbuf ForeignPtr Pixbuf
arg1) CUInt
arg2 -> ForeignPtr Pixbuf -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO ()) -> IO ()) -> (Ptr Pixbuf -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> CUInt -> IO ()
gdk_pixbuf_fill Ptr Pixbuf
argPtr1 CUInt
arg2) Pixbuf
pb
((Word8 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
red) CUInt -> Int -> CUInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
24 CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|.
(Word8 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
green) CUInt -> Int -> CUInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
16 CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|.
(Word8 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
blue) CUInt -> Int -> CUInt
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|.
(Word8 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
alpha))
foreign import ccall unsafe "gdk_pixbuf_get_colorspace"
gdk_pixbuf_get_colorspace :: ((Ptr Pixbuf) -> (IO CInt))
foreign import ccall unsafe "gdk_pixbuf_get_n_channels"
gdk_pixbuf_get_n_channels :: ((Ptr Pixbuf) -> (IO CInt))
foreign import ccall unsafe "gdk_pixbuf_get_has_alpha"
gdk_pixbuf_get_has_alpha :: ((Ptr Pixbuf) -> (IO CInt))
foreign import ccall unsafe "gdk_pixbuf_get_bits_per_sample"
gdk_pixbuf_get_bits_per_sample :: ((Ptr Pixbuf) -> (IO CInt))
foreign import ccall unsafe "gdk_pixbuf_get_pixels"
gdk_pixbuf_get_pixels :: ((Ptr Pixbuf) -> (IO (Ptr CUChar)))
foreign import ccall unsafe "gdk_pixbuf_get_width"
gdk_pixbuf_get_width :: ((Ptr Pixbuf) -> (IO CInt))
foreign import ccall unsafe "gdk_pixbuf_get_height"
gdk_pixbuf_get_height :: ((Ptr Pixbuf) -> (IO CInt))
foreign import ccall unsafe "gdk_pixbuf_get_rowstride"
gdk_pixbuf_get_rowstride :: ((Ptr Pixbuf) -> (IO CInt))
foreign import ccall unsafe "gdk_pixbuf_get_option"
gdk_pixbuf_get_option :: ((Ptr Pixbuf) -> ((Ptr CChar) -> (IO (Ptr CChar))))
foreign import ccall unsafe "gdk_pixbuf_error_quark"
gdk_pixbuf_error_quark :: CUInt
foreign import ccall unsafe "gdk_pixbuf_new_from_file"
gdk_pixbuf_new_from_file :: ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO (Ptr Pixbuf))))
foreign import ccall safe "gdk_pixbuf_new_from_file_at_size"
gdk_pixbuf_new_from_file_at_size :: ((Ptr CChar) -> (CInt -> (CInt -> ((Ptr (Ptr ())) -> (IO (Ptr Pixbuf))))))
foreign import ccall safe "gdk_pixbuf_new_from_file_at_scale"
gdk_pixbuf_new_from_file_at_scale :: ((Ptr CChar) -> (CInt -> (CInt -> (CInt -> ((Ptr (Ptr ())) -> (IO (Ptr Pixbuf)))))))
foreign import ccall safe "gdk_pixbuf_get_from_surface"
gdk_pixbuf_get_from_surface :: ((Ptr ()) -> (CInt -> (CInt -> (CInt -> (CInt -> (IO (Ptr Pixbuf)))))))
foreign import ccall safe "gdk_pixbuf_get_from_window"
gdk_pixbuf_get_from_window :: ((Ptr DrawWindow) -> (CInt -> (CInt -> (CInt -> (CInt -> (IO (Ptr Pixbuf)))))))
foreign import ccall unsafe "gdk_pixbuf_savev"
gdk_pixbuf_savev :: ((Ptr Pixbuf) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr (Ptr CChar)) -> ((Ptr (Ptr CChar)) -> ((Ptr (Ptr ())) -> (IO CInt)))))))
foreign import ccall safe "gdk_pixbuf_new"
gdk_pixbuf_new :: (CInt -> (CInt -> (CInt -> (CInt -> (CInt -> (IO (Ptr Pixbuf)))))))
foreign import ccall safe "gdk_pixbuf_new_from_data"
gdk_pixbuf_new_from_data :: ((Ptr CUChar) -> (CInt -> (CInt -> (CInt -> (CInt -> (CInt -> (CInt -> ((FunPtr ((Ptr CUChar) -> ((Ptr ()) -> (IO ())))) -> ((Ptr ()) -> (IO (Ptr Pixbuf)))))))))))
foreign import ccall safe "gdk_pixbuf_new_from_xpm_data"
gdk_pixbuf_new_from_xpm_data :: ((Ptr (Ptr CChar)) -> (IO (Ptr Pixbuf)))
foreign import ccall unsafe "gdk_pixbuf_new_from_inline"
gdk_pixbuf_new_from_inline :: (CInt -> ((Ptr CUChar) -> (CInt -> ((Ptr (Ptr ())) -> (IO (Ptr Pixbuf))))))
foreign import ccall unsafe "gdk_pixbuf_new_subpixbuf"
gdk_pixbuf_new_subpixbuf :: ((Ptr Pixbuf) -> (CInt -> (CInt -> (CInt -> (CInt -> (IO (Ptr Pixbuf)))))))
foreign import ccall unsafe "gdk_pixbuf_copy"
gdk_pixbuf_copy :: ((Ptr Pixbuf) -> (IO (Ptr Pixbuf)))
foreign import ccall safe "gdk_pixbuf_scale_simple"
gdk_pixbuf_scale_simple :: ((Ptr Pixbuf) -> (CInt -> (CInt -> (CInt -> (IO (Ptr Pixbuf))))))
foreign import ccall unsafe "gdk_pixbuf_scale"
gdk_pixbuf_scale :: ((Ptr Pixbuf) -> ((Ptr Pixbuf) -> (CInt -> (CInt -> (CInt -> (CInt -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (CInt -> (IO ()))))))))))))
foreign import ccall unsafe "gdk_pixbuf_composite"
gdk_pixbuf_composite :: ((Ptr Pixbuf) -> ((Ptr Pixbuf) -> (CInt -> (CInt -> (CInt -> (CInt -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (CInt -> (CInt -> (IO ())))))))))))))
foreign import ccall safe "gdk_pixbuf_flip"
gdk_pixbuf_flip :: ((Ptr Pixbuf) -> (CInt -> (IO (Ptr Pixbuf))))
foreign import ccall safe "gdk_pixbuf_rotate_simple"
gdk_pixbuf_rotate_simple :: ((Ptr Pixbuf) -> (CInt -> (IO (Ptr Pixbuf))))
foreign import ccall unsafe "gdk_pixbuf_add_alpha"
gdk_pixbuf_add_alpha :: ((Ptr Pixbuf) -> (CInt -> (CUChar -> (CUChar -> (CUChar -> (IO (Ptr Pixbuf)))))))
foreign import ccall unsafe "gdk_pixbuf_copy_area"
gdk_pixbuf_copy_area :: ((Ptr Pixbuf) -> (CInt -> (CInt -> (CInt -> (CInt -> ((Ptr Pixbuf) -> (CInt -> (CInt -> (IO ())))))))))
foreign import ccall unsafe "gdk_pixbuf_fill"
gdk_pixbuf_fill :: ((Ptr Pixbuf) -> (CUInt -> (IO ())))