{-# LINE 2 "./Graphics/UI/Gtk/Display/Image.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Image
--
-- Author : Axel Simon
--
-- Created: 23 May 2001
--
-- Copyright (C) 2001-2005 Axel Simon
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- TODO
--
-- Figure out what other functions are useful within Haskell. Maybe we should
-- support loading Pixmaps without exposing them.
--
-- Because Haskell is not the best language to modify large images directly
-- only functions are bound that allow loading images from disc or by stock
-- names.
--
-- Another function for extracting the 'Pixbuf' is added for
-- 'CellRenderer'.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- A widget displaying an image
--
module Graphics.UI.Gtk.Display.Image (
-- * Detail
--
-- | The 'Image' widget displays an image. Various kinds of object can be
-- displayed as an image; most typically, you would load a 'Pixbuf' (\"pixel
-- buffer\") from a file, and then display that. There's a convenience function
-- to do this, 'imageNewFromFile', used as follows: If the file isn't loaded
-- successfully, the image will contain a \"broken image\" icon similar to that
-- used in many web browsers. If you want to handle errors in loading the file
-- yourself, for example by displaying an error message, then load the image
-- with 'Graphics.UI.Gtk.Gdk.Pixbuf.pixbufNewFromFile', then create the
-- 'Image' with 'imageNewFromPixbuf'.
--
-- > image <- imageNewFromFile "myfile.png"
--
-- The image file may contain an animation, if so the 'Image' will display
-- an animation ('PixbufAnimation') instead of a static image.
--
-- 'Image' is a subclass of 'Misc', which implies that you can align it
-- (center, left, right) and add padding to it, using 'Misc' methods.
--
-- 'Image' is a \"no window\" widget (has no 'DrawWindow' of its own), so by
-- default does not receive events. If you want to receive events on the image,
-- such as button clicks, place the image inside a 'EventBox', then connect to
-- the event signals on the event box.
--
-- When handling events on the event box, keep in mind that coordinates in
-- the image may be different from event box coordinates due to the alignment
-- and padding settings on the image (see 'Misc'). The simplest way to solve
-- this is to set the alignment to 0.0 (left\/top), and set the padding to
-- zero. Then the origin of the image will be the same as the origin of the
-- event box.
--
-- Sometimes an application will want to avoid depending on external data
-- files, such as image files. Gtk+ comes with a program to avoid this, called
-- gdk-pixbuf-csource. This program allows you to convert an image into a C
-- variable declaration, which can then be loaded into a 'Pixbuf' using
-- 'Graphics.UI.Gtk.Gdk.Pixbuf.pixbufNewFromInline'.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----'Misc'
-- | +----Image
-- @

-- * Types
  Image,
  ImageClass,
  castToImage, gTypeImage,
  toImage,
  ImageType(..),

-- * Constructors
  imageNewFromFile,
  imageNewFromPixbuf,
  imageNewFromAnimation,
  imageNewFromStock,
  imageNew,

  imageNewFromIconName,


-- * Methods
  imageGetPixbuf,
  imageSetFromPixbuf,
  imageSetFromAnimation,
  imageSetFromFile,
  imageSetFromStock,

  imageSetFromIconName,
  imageSetPixelSize,
  imageGetPixelSize,


  imageClear,


-- * Icon Sizes
  IconSize(..),

-- * Attributes
  imagePixbuf,

  imagePixmap,
  imageMask,

  imageAnimation,
  imageImage,
  imageFile,
  imageStock,
  imageIconSize,

  imagePixelSize,


  imageIconName,

  imageStorageType,
  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types
{-# LINE 152 "./Graphics/UI/Gtk/Display/Image.chs" #-}
import Graphics.UI.Gtk.General.StockItems
import Graphics.UI.Gtk.General.Structs (IconSize(..))


{-# LINE 156 "./Graphics/UI/Gtk/Display/Image.chs" #-}

--------------------
-- Types

-- | Describes the image data representation used by a 'Image'. If you want to
-- get the image from the widget, you can only get the currently-stored
-- representation. e.g. if the 'imageStorageType' is 'ImagePixbuf',
-- then you can call 'imageGetPixbuf' but not 'imageGetStock'. For empty
-- images, you can request any storage type (call any of the "get" functions),
-- but they will all return @Nothing@.
--
data ImageType = ImageEmpty
               | ImagePixmap
               | ImageImage
               | ImagePixbuf
               | ImageStock
               | ImageIconSet
               | ImageAnimation
               | ImageIconName
               | ImageGicon
               deriving (Int -> ImageType
ImageType -> Int
ImageType -> [ImageType]
ImageType -> ImageType
ImageType -> ImageType -> [ImageType]
ImageType -> ImageType -> ImageType -> [ImageType]
(ImageType -> ImageType)
-> (ImageType -> ImageType)
-> (Int -> ImageType)
-> (ImageType -> Int)
-> (ImageType -> [ImageType])
-> (ImageType -> ImageType -> [ImageType])
-> (ImageType -> ImageType -> [ImageType])
-> (ImageType -> ImageType -> ImageType -> [ImageType])
-> Enum ImageType
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 :: ImageType -> ImageType
succ :: ImageType -> ImageType
$cpred :: ImageType -> ImageType
pred :: ImageType -> ImageType
$ctoEnum :: Int -> ImageType
toEnum :: Int -> ImageType
$cfromEnum :: ImageType -> Int
fromEnum :: ImageType -> Int
$cenumFrom :: ImageType -> [ImageType]
enumFrom :: ImageType -> [ImageType]
$cenumFromThen :: ImageType -> ImageType -> [ImageType]
enumFromThen :: ImageType -> ImageType -> [ImageType]
$cenumFromTo :: ImageType -> ImageType -> [ImageType]
enumFromTo :: ImageType -> ImageType -> [ImageType]
$cenumFromThenTo :: ImageType -> ImageType -> ImageType -> [ImageType]
enumFromThenTo :: ImageType -> ImageType -> ImageType -> [ImageType]
Enum,Int -> ImageType -> ShowS
[ImageType] -> ShowS
ImageType -> String
(Int -> ImageType -> ShowS)
-> (ImageType -> String)
-> ([ImageType] -> ShowS)
-> Show ImageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImageType -> ShowS
showsPrec :: Int -> ImageType -> ShowS
$cshow :: ImageType -> String
show :: ImageType -> String
$cshowList :: [ImageType] -> ShowS
showList :: [ImageType] -> ShowS
Show,ImageType -> ImageType -> Bool
(ImageType -> ImageType -> Bool)
-> (ImageType -> ImageType -> Bool) -> Eq ImageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImageType -> ImageType -> Bool
== :: ImageType -> ImageType -> Bool
$c/= :: ImageType -> ImageType -> Bool
/= :: ImageType -> ImageType -> Bool
Eq)

{-# LINE 168 "./Graphics/UI/Gtk/Display/Image.chs" #-}

--------------------
-- Constructors

-- | Creates a new 'Image' displaying the file @filename@. If the file isn't
-- found or can't be loaded, the resulting 'Image' will display a \"broken
-- image\" icon.
--
-- If the file contains an animation, the image will contain an animation.
--
-- If you need to detect failures to load the file, use
-- 'Graphics.UI.Gtk.Gdk.Pixbuf.pixbufNewFromFile'
-- to load the file yourself, then create the 'Image' from the pixbuf. (Or for
-- animations, use
-- 'Graphics.UI.Gtk.Gdk.Pixbuf.pixbufAnimationNewFromFile').
--
-- The storage type ('imageGetStorageType') of the returned image is not
-- defined, it will be whatever is appropriate for displaying the file.
--
imageNewFromFile :: GlibFilePath fp => fp -> IO Image
imageNewFromFile :: forall fp. GlibFilePath fp => fp -> IO Image
imageNewFromFile fp
filename =
  (ForeignPtr Image -> Image, FinalizerPtr Image)
-> IO (Ptr Image) -> IO Image
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Image -> Image, FinalizerPtr Image)
forall {a}. (ForeignPtr Image -> Image, FinalizerPtr a)
mkImage (IO (Ptr Image) -> IO Image) -> IO (Ptr Image) -> IO Image
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Image) -> IO (Ptr Widget) -> IO (Ptr Image)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Image
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Image) (IO (Ptr Widget) -> IO (Ptr Image))
-> IO (Ptr Widget) -> IO (Ptr Image)
forall a b. (a -> b) -> a -> b
$
  fp -> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a. fp -> (CString -> IO a) -> IO a
forall fp a. GlibFilePath fp => fp -> (CString -> IO a) -> IO a
withUTFFilePath fp
filename ((CString -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \CString
filenamePtr ->



  CString -> IO (Ptr Widget)
gtk_image_new_from_file
{-# LINE 196 "./Graphics/UI/Gtk/Display/Image.chs" #-}

    CString
filenamePtr

-- | Creates a new 'Image' displaying a 'Pixbuf'.
--
-- Note that this function just creates an 'Image' from the pixbuf. The
-- 'Image' created will not react to state changes. Should you want that, you
-- should use 'imageNewFromIconSet'.
--
imageNewFromPixbuf :: Pixbuf -> IO Image
imageNewFromPixbuf :: Pixbuf -> IO Image
imageNewFromPixbuf Pixbuf
pixbuf =
  (ForeignPtr Image -> Image, FinalizerPtr Image)
-> IO (Ptr Image) -> IO Image
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Image -> Image, FinalizerPtr Image)
forall {a}. (ForeignPtr Image -> Image, FinalizerPtr a)
mkImage (IO (Ptr Image) -> IO Image) -> IO (Ptr Image) -> IO Image
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Image) -> IO (Ptr Widget) -> IO (Ptr Image)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Image
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Image) (IO (Ptr Widget) -> IO (Ptr Image))
-> IO (Ptr Widget) -> IO (Ptr Image)
forall a b. (a -> b) -> a -> b
$
  (\(Pixbuf ForeignPtr Pixbuf
arg1) -> ForeignPtr Pixbuf
-> (Ptr Pixbuf -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Pixbuf
arg1 ((Ptr Pixbuf -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Pixbuf -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
argPtr1 ->Ptr Pixbuf -> IO (Ptr Widget)
gtk_image_new_from_pixbuf Ptr Pixbuf
argPtr1)
{-# LINE 210 "./Graphics/UI/Gtk/Display/Image.chs" #-}
    pixbuf


imageNewFromAnimation :: (PixbufAnimationClass animation) => animation -> IO Image
imageNewFromAnimation :: forall animation.
PixbufAnimationClass animation =>
animation -> IO Image
imageNewFromAnimation animation
pba = (ForeignPtr Image -> Image, FinalizerPtr Image)
-> IO (Ptr Image) -> IO Image
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Image -> Image, FinalizerPtr Image)
forall {a}. (ForeignPtr Image -> Image, FinalizerPtr a)
mkImage (IO (Ptr Image) -> IO Image) -> IO (Ptr Image) -> IO Image
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Image) -> IO (Ptr Widget) -> IO (Ptr Image)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Image
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Image) (IO (Ptr Widget) -> IO (Ptr Image))
-> IO (Ptr Widget) -> IO (Ptr Image)
forall a b. (a -> b) -> a -> b
$
  (\(PixbufAnimation ForeignPtr PixbufAnimation
arg1) -> ForeignPtr PixbufAnimation
-> (Ptr PixbufAnimation -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PixbufAnimation
arg1 ((Ptr PixbufAnimation -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr PixbufAnimation -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufAnimation
argPtr1 ->Ptr PixbufAnimation -> IO (Ptr Widget)
gtk_image_new_from_animation Ptr PixbufAnimation
argPtr1) (animation -> PixbufAnimation
forall o. PixbufAnimationClass o => o -> PixbufAnimation
toPixbufAnimation animation
pba)


-- | Creates a 'Image' displaying a stock icon. If the stock icon name isn't
-- known, the image will be empty.
--
imageNewFromStock ::
    StockId -- ^ @stockId@ - a stock icon name
 -> IconSize -- ^ @size@ - a stock icon size
 -> IO Image
imageNewFromStock :: StockId -> IconSize -> IO Image
imageNewFromStock StockId
stockId IconSize
size =
  (ForeignPtr Image -> Image, FinalizerPtr Image)
-> IO (Ptr Image) -> IO Image
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Image -> Image, FinalizerPtr Image)
forall {a}. (ForeignPtr Image -> Image, FinalizerPtr a)
mkImage (IO (Ptr Image) -> IO Image) -> IO (Ptr Image) -> IO Image
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Image) -> IO (Ptr Widget) -> IO (Ptr Image)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Image
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Image) (IO (Ptr Widget) -> IO (Ptr Image))
-> IO (Ptr Widget) -> IO (Ptr Image)
forall a b. (a -> b) -> a -> b
$
  StockId -> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
forall a. StockId -> (CString -> IO a) -> IO a
withUTFString StockId
stockId ((CString -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \CString
stockIdPtr ->
  CString -> CInt -> IO (Ptr Widget)
gtk_image_new_from_stock
{-# LINE 231 "./Graphics/UI/Gtk/Display/Image.chs" #-}
    stockIdPtr
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (IconSize -> Int) -> IconSize -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IconSize -> Int
forall a. Enum a => a -> Int
fromEnum) IconSize
size)

-- | Creates a new empty 'Image' widget.
--
imageNew :: IO Image
imageNew :: IO Image
imageNew =
  (ForeignPtr Image -> Image, FinalizerPtr Image)
-> IO (Ptr Image) -> IO Image
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Image -> Image, FinalizerPtr Image)
forall {a}. (ForeignPtr Image -> Image, FinalizerPtr a)
mkImage (IO (Ptr Image) -> IO Image) -> IO (Ptr Image) -> IO Image
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Image) -> IO (Ptr Widget) -> IO (Ptr Image)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Image
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Image) (IO (Ptr Widget) -> IO (Ptr Image))
-> IO (Ptr Widget) -> IO (Ptr Image)
forall a b. (a -> b) -> a -> b
$
  IO (Ptr Widget)
gtk_image_new
{-# LINE 241 "./Graphics/UI/Gtk/Display/Image.chs" #-}


-- | Creates a 'Image' displaying an icon from the current icon theme. If the
-- icon name isn't known, a \"broken image\" icon will be displayed instead. If
-- the current icon theme is changed, the icon will be updated appropriately.
--
-- * Available since Gtk+ version 2.6
--
imageNewFromIconName :: GlibString string
 => string -- ^ @iconName@ - an icon name
 -> IconSize -- ^ @size@ - a stock icon size
 -> IO Image
imageNewFromIconName :: forall string. GlibString string => string -> IconSize -> IO Image
imageNewFromIconName string
iconName IconSize
size =
  (ForeignPtr Image -> Image, FinalizerPtr Image)
-> IO (Ptr Image) -> IO Image
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Image -> Image, FinalizerPtr Image)
forall {a}. (ForeignPtr Image -> Image, FinalizerPtr a)
mkImage (IO (Ptr Image) -> IO Image) -> IO (Ptr Image) -> IO Image
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Image) -> IO (Ptr Widget) -> IO (Ptr Image)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Image
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Image) (IO (Ptr Widget) -> IO (Ptr Image))
-> IO (Ptr Widget) -> IO (Ptr Image)
forall a b. (a -> b) -> a -> b
$
  string -> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
iconName ((CString -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \CString
iconNamePtr ->
  CString -> CInt -> IO (Ptr Widget)
gtk_image_new_from_icon_name
{-# LINE 258 "./Graphics/UI/Gtk/Display/Image.chs" #-}
    iconNamePtr
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (IconSize -> Int) -> IconSize -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IconSize -> Int
forall a. Enum a => a -> Int
fromEnum) IconSize
size)


--------------------
-- Methods

-- | Gets the 'Pixbuf' being displayed by the 'Image'. The storage type of the
-- image must be 'ImageEmpty' or 'ImagePixbuf' (see 'imageGetStorageType').
--
imageGetPixbuf :: Image -> IO Pixbuf
imageGetPixbuf :: Image -> IO Pixbuf
imageGetPixbuf Image
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
makeNewGObject (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
$
  String -> IO (Ptr Pixbuf) -> IO (Ptr Pixbuf)
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwIfNull String
"Image.imageGetPixbuf: The image contains no Pixbuf object." (IO (Ptr Pixbuf) -> IO (Ptr Pixbuf))
-> IO (Ptr Pixbuf) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$
  (\(Image ForeignPtr Image
arg1) -> ForeignPtr Image
-> (Ptr Image -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Image
arg1 ((Ptr Image -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Ptr Image -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr Image
argPtr1 ->Ptr Image -> IO (Ptr Pixbuf)
gtk_image_get_pixbuf Ptr Image
argPtr1)
{-# LINE 273 "./Graphics/UI/Gtk/Display/Image.chs" #-}
    self

-- | Overwrite the current content of the 'Image' with a new 'Pixbuf'.
--
imageSetFromPixbuf :: Image -> Pixbuf -> IO ()
imageSetFromPixbuf :: Image -> Pixbuf -> IO ()
imageSetFromPixbuf Image
self Pixbuf
pixbuf =
  (\(Image ForeignPtr Image
arg1) (Pixbuf ForeignPtr Pixbuf
arg2) -> ForeignPtr Image -> (Ptr Image -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Image
arg1 ((Ptr Image -> IO ()) -> IO ()) -> (Ptr Image -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Image
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 Image -> Ptr Pixbuf -> IO ()
gtk_image_set_from_pixbuf Ptr Image
argPtr1 Ptr Pixbuf
argPtr2)
{-# LINE 280 "./Graphics/UI/Gtk/Display/Image.chs" #-}
    self
    Pixbuf
pixbuf


imageSetFromAnimation :: (PixbufAnimationClass animation) => Image -> animation -> IO ()
imageSetFromAnimation :: forall animation.
PixbufAnimationClass animation =>
Image -> animation -> IO ()
imageSetFromAnimation Image
self animation
pba =
  (\(Image ForeignPtr Image
arg1) (PixbufAnimation ForeignPtr PixbufAnimation
arg2) -> ForeignPtr Image -> (Ptr Image -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Image
arg1 ((Ptr Image -> IO ()) -> IO ()) -> (Ptr Image -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Image
argPtr1 ->ForeignPtr PixbufAnimation
-> (Ptr PixbufAnimation -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PixbufAnimation
arg2 ((Ptr PixbufAnimation -> IO ()) -> IO ())
-> (Ptr PixbufAnimation -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufAnimation
argPtr2 ->Ptr Image -> Ptr PixbufAnimation -> IO ()
gtk_image_set_from_animation Ptr Image
argPtr1 Ptr PixbufAnimation
argPtr2)
{-# LINE 287 "./Graphics/UI/Gtk/Display/Image.chs" #-}
    self
    (animation -> PixbufAnimation
forall o. PixbufAnimationClass o => o -> PixbufAnimation
toPixbufAnimation animation
pba)

-- | See 'imageNewFromFile' for details.
--
imageSetFromFile :: GlibFilePath fp => Image -> fp -> IO ()
imageSetFromFile :: forall fp. GlibFilePath fp => Image -> fp -> IO ()
imageSetFromFile Image
self fp
filename =
  fp -> (CString -> IO ()) -> IO ()
forall a. fp -> (CString -> IO a) -> IO a
forall fp a. GlibFilePath fp => fp -> (CString -> IO a) -> IO a
withUTFFilePath fp
filename ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
filenamePtr ->



  (\(Image ForeignPtr Image
arg1) CString
arg2 -> ForeignPtr Image -> (Ptr Image -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Image
arg1 ((Ptr Image -> IO ()) -> IO ()) -> (Ptr Image -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Image
argPtr1 ->Ptr Image -> CString -> IO ()
gtk_image_set_from_file Ptr Image
argPtr1 CString
arg2)
{-# LINE 299 "./Graphics/UI/Gtk/Display/Image.chs" #-}

    Image
self
    CString
filenamePtr

-- | See 'imageNewFromStock' for details.
--
imageSetFromStock :: Image
 -> StockId -- ^ @stockId@ - a stock icon name
 -> IconSize -- ^ @size@ - a stock icon size
 -> IO ()
imageSetFromStock :: Image -> StockId -> IconSize -> IO ()
imageSetFromStock Image
self StockId
stockId IconSize
size =
  StockId -> (CString -> IO ()) -> IO ()
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
forall a. StockId -> (CString -> IO a) -> IO a
withUTFString StockId
stockId ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
stockIdPtr ->
  (\(Image ForeignPtr Image
arg1) CString
arg2 CInt
arg3 -> ForeignPtr Image -> (Ptr Image -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Image
arg1 ((Ptr Image -> IO ()) -> IO ()) -> (Ptr Image -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Image
argPtr1 ->Ptr Image -> CString -> CInt -> IO ()
gtk_image_set_from_stock Ptr Image
argPtr1 CString
arg2 CInt
arg3)
{-# LINE 312 "./Graphics/UI/Gtk/Display/Image.chs" #-}
    self
    CString
stockIdPtr
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (IconSize -> Int) -> IconSize -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IconSize -> Int
forall a. Enum a => a -> Int
fromEnum) IconSize
size)


-- | See 'imageNewFromIconName' for details.
--
-- * Available since Gtk+ version 2.6
--
imageSetFromIconName :: GlibString string => Image
 -> string -- ^ @iconName@ - an icon name
 -> IconSize -- ^ @size@ - an icon size
 -> IO ()
imageSetFromIconName :: forall string.
GlibString string =>
Image -> string -> IconSize -> IO ()
imageSetFromIconName Image
self string
iconName IconSize
size =
  string -> (CString -> IO ()) -> IO ()
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
iconName ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
iconNamePtr ->
  (\(Image ForeignPtr Image
arg1) CString
arg2 CInt
arg3 -> ForeignPtr Image -> (Ptr Image -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Image
arg1 ((Ptr Image -> IO ()) -> IO ()) -> (Ptr Image -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Image
argPtr1 ->Ptr Image -> CString -> CInt -> IO ()
gtk_image_set_from_icon_name Ptr Image
argPtr1 CString
arg2 CInt
arg3)
{-# LINE 328 "./Graphics/UI/Gtk/Display/Image.chs" #-}
    self
    CString
iconNamePtr
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (IconSize -> Int) -> IconSize -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IconSize -> Int
forall a. Enum a => a -> Int
fromEnum) IconSize
size)

-- | Sets the pixel size to use for named icons. If the pixel size is set to a
-- @value \/= -1@, it is used instead of the icon size set by
-- 'imageSetFromIconName'.
--
-- * Available since Gtk+ version 2.6
--
imageSetPixelSize :: Image
 -> Int -- ^ @pixelSize@ - the new pixel size
 -> IO ()
imageSetPixelSize :: Image -> Int -> IO ()
imageSetPixelSize Image
self Int
pixelSize =
  (\(Image ForeignPtr Image
arg1) CInt
arg2 -> ForeignPtr Image -> (Ptr Image -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Image
arg1 ((Ptr Image -> IO ()) -> IO ()) -> (Ptr Image -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Image
argPtr1 ->Ptr Image -> CInt -> IO ()
gtk_image_set_pixel_size Ptr Image
argPtr1 CInt
arg2)
{-# LINE 343 "./Graphics/UI/Gtk/Display/Image.chs" #-}
    self
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pixelSize)

-- | Gets the pixel size used for named icons.
--
-- * Available since Gtk+ version 2.6
--
imageGetPixelSize :: Image -> IO Int
imageGetPixelSize :: Image -> IO Int
imageGetPixelSize Image
self =
  (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
$
  (\(Image ForeignPtr Image
arg1) -> ForeignPtr Image -> (Ptr Image -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Image
arg1 ((Ptr Image -> IO CInt) -> IO CInt)
-> (Ptr Image -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Image
argPtr1 ->Ptr Image -> IO CInt
gtk_image_get_pixel_size Ptr Image
argPtr1)
{-# LINE 354 "./Graphics/UI/Gtk/Display/Image.chs" #-}
    self



-- | Resets the image to be empty.
--
-- * Available since Gtk+ version 2.8
--
imageClear :: Image -> IO ()
imageClear :: Image -> IO ()
imageClear Image
self =
  (\(Image ForeignPtr Image
arg1) -> ForeignPtr Image -> (Ptr Image -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Image
arg1 ((Ptr Image -> IO ()) -> IO ()) -> (Ptr Image -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Image
argPtr1 ->Ptr Image -> IO ()
gtk_image_clear Ptr Image
argPtr1)
{-# LINE 365 "./Graphics/UI/Gtk/Display/Image.chs" #-}
    self


--------------------
-- Attributes

-- | A 'Pixbuf' to display.
--
imagePixbuf :: PixbufClass pixbuf => ReadWriteAttr Image Pixbuf pixbuf
imagePixbuf :: forall pixbuf.
PixbufClass pixbuf =>
ReadWriteAttr Image Pixbuf pixbuf
imagePixbuf = String -> GType -> ReadWriteAttr Image Pixbuf pixbuf
forall gobj gobj' gobj''.
(GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') =>
String -> GType -> ReadWriteAttr gobj gobj' gobj''
newAttrFromObjectProperty String
"pixbuf"
  GType
gdk_pixbuf_get_type
{-# LINE 376 "./Graphics/UI/Gtk/Display/Image.chs" #-}


imageAnimation :: (PixbufClass pixbuf, PixbufAnimationClass animation) => ReadWriteAttr Image animation pixbuf
imageAnimation :: forall pixbuf animation.
(PixbufClass pixbuf, PixbufAnimationClass animation) =>
ReadWriteAttr Image animation pixbuf
imageAnimation = String -> GType -> ReadWriteAttr Image animation pixbuf
forall gobj gobj' gobj''.
(GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') =>
String -> GType -> ReadWriteAttr gobj gobj' gobj''
newAttrFromObjectProperty String
"pixbuf-animation"
  GType
gdk_pixbuf_get_type
{-# LINE 381 "./Graphics/UI/Gtk/Display/Image.chs" #-}


-- | A 'Pixmap' to display.
--
imagePixmap :: PixmapClass pixmap => ReadWriteAttr Image Pixmap pixmap
imagePixmap :: forall pixmap.
PixmapClass pixmap =>
ReadWriteAttr Image Pixmap pixmap
imagePixmap = String -> GType -> ReadWriteAttr Image Pixmap pixmap
forall gobj gobj' gobj''.
(GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') =>
String -> GType -> ReadWriteAttr gobj gobj' gobj''
newAttrFromObjectProperty String
"pixmap"
  GType
gdk_pixmap_get_type
{-# LINE 388 "./Graphics/UI/Gtk/Display/Image.chs" #-}

-- | Mask bitmap to use with 'Image' or 'Pixmap'.
--
imageMask :: PixmapClass pixmap => ReadWriteAttr Image Pixmap pixmap
imageMask :: forall pixmap.
PixmapClass pixmap =>
ReadWriteAttr Image Pixmap pixmap
imageMask = String -> GType -> ReadWriteAttr Image Pixmap pixmap
forall gobj gobj' gobj''.
(GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') =>
String -> GType -> ReadWriteAttr gobj gobj' gobj''
newAttrFromObjectProperty String
"mask"
  GType
gdk_pixmap_get_type
{-# LINE 394 "./Graphics/UI/Gtk/Display/Image.chs" #-}


-- | A 'Image' to display.
--
imageImage :: ImageClass image => ReadWriteAttr Image Image image
imageImage :: forall image. ImageClass image => ReadWriteAttr Image Image image
imageImage = String -> GType -> ReadWriteAttr Image Image image
forall gobj gobj' gobj''.
(GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') =>
String -> GType -> ReadWriteAttr gobj gobj' gobj''
newAttrFromObjectProperty String
"image"
  GType
gtk_image_get_type
{-# LINE 401 "./Graphics/UI/Gtk/Display/Image.chs" #-}

-- | Filename to load and display.
--
-- Default value: \"\"
--
imageFile :: GlibString string => Attr Image string
imageFile :: forall string. GlibString string => Attr Image string
imageFile = String -> Attr Image string
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> Attr gobj string
newAttrFromStringProperty String
"file"

-- | Stock ID for a stock image to display.
--
-- Default value: \"\"
--
imageStock :: GlibString string => Attr Image string
imageStock :: forall string. GlibString string => Attr Image string
imageStock = String -> Attr Image string
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> Attr gobj string
newAttrFromStringProperty String
"stock"

-- | Symbolic size to use for stock icon, icon set or named icon.
--
-- Allowed values: >= 0
--
-- Default value: 4
--
imageIconSize :: Attr Image Int
imageIconSize :: Attr Image Int
imageIconSize = String -> Attr Image Int
forall gobj. GObjectClass gobj => String -> Attr gobj Int
newAttrFromIntProperty String
"icon-size"


-- | The pixel-size property can be used to specify a fixed size overriding
-- the icon-size property for images of type 'ImageIconName'.
--
-- Allowed values: >= -1
--
-- Default value: -1
--
imagePixelSize :: Attr Image Int
imagePixelSize :: Attr Image Int
imagePixelSize = (Image -> IO Int) -> (Image -> Int -> IO ()) -> Attr Image Int
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  Image -> IO Int
imageGetPixelSize
  Image -> Int -> IO ()
imageSetPixelSize



-- | The name of the icon in the icon theme. If the icon theme is changed, the
-- image will be updated automatically.
--
-- Default value: \"\"
--
imageIconName :: GlibString string => Attr Image string
imageIconName :: forall string. GlibString string => Attr Image string
imageIconName = String -> Attr Image string
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> Attr gobj string
newAttrFromStringProperty String
"icon-name"


-- | The representation being used for image data.
--
-- Default value: 'ImageEmpty'
--
imageStorageType :: ReadAttr Image ImageType
imageStorageType :: ReadAttr Image ImageType
imageStorageType = String -> GType -> ReadAttr Image ImageType
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
String -> GType -> ReadAttr gobj enum
readAttrFromEnumProperty String
"storage-type"
  GType
gtk_image_type_get_type
{-# LINE 456 "./Graphics/UI/Gtk/Display/Image.chs" #-}

foreign import ccall unsafe "gtk_image_new_from_file"
  gtk_image_new_from_file :: ((Ptr CChar) -> (IO (Ptr Widget)))

foreign import ccall unsafe "gtk_image_new_from_pixbuf"
  gtk_image_new_from_pixbuf :: ((Ptr Pixbuf) -> (IO (Ptr Widget)))

foreign import ccall unsafe "gtk_image_new_from_animation"
  gtk_image_new_from_animation :: ((Ptr PixbufAnimation) -> (IO (Ptr Widget)))

foreign import ccall unsafe "gtk_image_new_from_stock"
  gtk_image_new_from_stock :: ((Ptr CChar) -> (CInt -> (IO (Ptr Widget))))

foreign import ccall safe "gtk_image_new"
  gtk_image_new :: (IO (Ptr Widget))

foreign import ccall safe "gtk_image_new_from_icon_name"
  gtk_image_new_from_icon_name :: ((Ptr CChar) -> (CInt -> (IO (Ptr Widget))))

foreign import ccall unsafe "gtk_image_get_pixbuf"
  gtk_image_get_pixbuf :: ((Ptr Image) -> (IO (Ptr Pixbuf)))

foreign import ccall unsafe "gtk_image_set_from_pixbuf"
  gtk_image_set_from_pixbuf :: ((Ptr Image) -> ((Ptr Pixbuf) -> (IO ())))

foreign import ccall unsafe "gtk_image_set_from_animation"
  gtk_image_set_from_animation :: ((Ptr Image) -> ((Ptr PixbufAnimation) -> (IO ())))

foreign import ccall safe "gtk_image_set_from_file"
  gtk_image_set_from_file :: ((Ptr Image) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "gtk_image_set_from_stock"
  gtk_image_set_from_stock :: ((Ptr Image) -> ((Ptr CChar) -> (CInt -> (IO ()))))

foreign import ccall safe "gtk_image_set_from_icon_name"
  gtk_image_set_from_icon_name :: ((Ptr Image) -> ((Ptr CChar) -> (CInt -> (IO ()))))

foreign import ccall safe "gtk_image_set_pixel_size"
  gtk_image_set_pixel_size :: ((Ptr Image) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_image_get_pixel_size"
  gtk_image_get_pixel_size :: ((Ptr Image) -> (IO CInt))

foreign import ccall safe "gtk_image_clear"
  gtk_image_clear :: ((Ptr Image) -> (IO ()))

foreign import ccall unsafe "gdk_pixbuf_get_type"
  gdk_pixbuf_get_type :: CUInt

foreign import ccall unsafe "gdk_pixmap_get_type"
  gdk_pixmap_get_type :: CUInt

foreign import ccall unsafe "gtk_image_get_type"
  gtk_image_get_type :: CUInt

foreign import ccall unsafe "gtk_image_type_get_type"
  gtk_image_type_get_type :: CUInt