{-# LINE 2 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget ImageView
--
-- Author : Andy Stewart
--
-- Created: 19 Aug 2010
--
-- Copyright (C) 2010 Andy Stewart
--
-- 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.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
module Graphics.UI.Gtk.ImageView.ImageView (
-- * Details
-- | 'ImageView' is a full-featured general purpose image viewer widget for GTK. It provides a
-- scrollable, zoomable pane in which a pixbuf can be displayed.

-- * Types
   ImageView,
   ImageViewClass,

-- * Methods
   imageViewNew,
   imageViewGetViewport,
   imageViewGetDrawRect,
   imageViewGetCheckColors,
   imageViewImageToWidgetRect,
   imageViewSetOffset,
   imageViewSetTransp,
   imageViewGetFitting,
   imageViewSetFitting,
   imageViewGetPixbuf,
   imageViewSetPixbuf,
   imageViewGetZoom,
   imageViewSetZoom,
   imageViewSetBlackBg,
   imageViewGetBlackBg,
   imageViewSetShowFrame,
   imageViewGetShowFrame,
   imageViewSetInterpolation,
   imageViewGetInterpolation,
   imageViewSetShowCursor,
   imageViewGetShowCursor,
   imageViewSetTool,
   imageViewGetTool,
   imageViewZoomIn,
   imageViewZoomOut,
   imageViewDamagePixels,
   imageViewLibraryVersion,

-- * Signals
   mouseWheelScroll,
   pixbufChanged,
   scroll,
   setFitting,
   setScrollAdjustments,
   setZoom,
   zoomChanged,
   zoomIn,
   zoomOut,
) where

import Control.Monad (liftM)
import Control.Monad.Reader ( runReaderT )
import Data.Maybe (fromMaybe)

import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.ImageView.Enums
import Graphics.UI.Gtk.Abstract.Widget (Rectangle(..))
import Graphics.UI.Gtk.Gdk.Pixbuf (InterpType (..))
import Graphics.UI.Gtk.Abstract.Range (ScrollType (..))
import Graphics.UI.Gtk.Gdk.EventM (ScrollDirection (..))
import System.Glib.Attributes
import System.Glib.FFI
import System.Glib.UTFString

import Graphics.UI.Gtk.ImageView.Signals
{-# LINE 91 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
import Graphics.UI.Gtk.ImageView.Types
{-# LINE 92 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
import System.Glib.Properties
{-# LINE 93 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}


{-# LINE 95 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}

-- | Creates a new image view with default values. The default values are:
--
-- * black bg : 'False'
-- * fitting : 'True'
-- * image tool : a 'ImageToolDragger' instance
-- * interpolation mode : 'InterpBilinear'
-- * offset : (0, 0) * pixbuf : 'Nothing'
-- * show cursor: 'True'
-- * show frame : 'True'
-- * transp : 'ImageTranspGrid'
-- * zoom : 1.0
imageViewNew :: IO ImageView
imageViewNew =
  makeNewObject mkImageView $
  liftM (castPtr :: Ptr Widget -> Ptr ImageView) $
  gtk_image_view_new
{-# LINE 112 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}

-- | Fills in the rectangle with the current viewport. If pixbuf is 'Nothing', there is no viewport, rect is
-- left untouched and 'False' is returned. If the view is not allocated, the rectangles coordinates are
-- set to the views offset and its width and height to zero.
--
-- The current viewport is defined as the rectangle, in zoomspace coordinates as the area of the loaded
-- pixbuf the 'ImageView' is currently showing.
imageViewGetViewport :: ImageViewClass view => view
                     -> IO (Maybe Rectangle)
imageViewGetViewport view =
  alloca $ \rPtr -> do
    success <- liftM toBool $
              (\(ImageView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_get_viewport argPtr1 arg2)
{-# LINE 125 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
                (toImageView view)
                (castPtr rPtr)
    if success
       then liftM Just $ peek rPtr
       else return Nothing

-- | Get the rectangle in the widget where the pixbuf is painted.
--
-- For example, if the widgets allocated size is 100, 100 and the pixbufs size is 50, 50 and the zoom
-- factor is 1.0, then the pixbuf will be drawn centered on the widget. rect will then be
-- (25,25)-[50,50].
--
-- If the view is not allocated, then the rectangle will be set to (0,0)-[0,0] and 'True' is returned.
--
-- This method is useful when converting from widget to image or zoom space coordinates.
imageViewGetDrawRect :: ImageViewClass view => view
                     -> IO (Maybe Rectangle)
imageViewGetDrawRect view =
  alloca $ \rPtr -> do
    success <- liftM toBool $
              (\(ImageView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_get_draw_rect argPtr1 arg2)
{-# LINE 146 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
                (toImageView view)
                (castPtr rPtr)
    if success
       then liftM Just $ peek rPtr
       else return Nothing

-- | Reads the two colors used to draw transparent parts of images with an alpha channel. Note that if
-- the transp setting of the view is 'ImageTranspBackground' or 'ImageTranspColor', then both
-- colors will be equal.
imageViewGetCheckColors :: ImageViewClass view => view
                        -> IO (Int, Int)
imageViewGetCheckColors view =
  alloca $ \xPtr ->
  alloca $ \yPtr -> do
  (\(ImageView arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_get_check_colors argPtr1 arg2 arg3)
{-# LINE 161 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)
    xPtr
    yPtr
  x <- peek xPtr
  y <- peek yPtr
  return (fromIntegral x, fromIntegral y)

-- | Convert a rectangle in image space coordinates to widget space coordinates. If the view is not
-- realized, or if it contains no pixbuf, then the conversion was unsuccessful, 'False' is returned and
-- @rectOut@ is left unmodified.
--
-- The size of @rectOut@ is rounded up. For example, if the zoom factor is 0.25 and the width of the
-- input rectangle is 2, then its with in widget space coordinates is 0.5 which is rounded up to 1.
--
-- Note that this function may return a rectangle that is not visible on the widget.
imageViewImageToWidgetRect :: ImageViewClass view => view
                           -> Rectangle -- ^ @rectIn@ a 'Rectangle' in image space coordinates to convert
                           -> Rectangle -- ^ @rectOut@ a 'Rectangle' to fill in with the widget space coordinates
                           -> IO Bool -- ^ returns 'True' if the conversion was successful, 'False' otherwise
imageViewImageToWidgetRect view rectIn rectOut =
  with rectIn $ \ rectInPtr ->
  with rectOut $ \ rectOutPtr ->
  liftM toBool $
  (\(ImageView arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_image_to_widget_rect argPtr1 arg2 arg3)
{-# LINE 185 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)
    (castPtr rectInPtr)
    (castPtr rectOutPtr)

-- | Sets the offset of where in the image the 'ImageView' should begin displaying image data.
--
-- The offset is clamped so that it will never cause the 'ImageView' to display pixels outside the
-- pixbuf. Setting this attribute causes the widget to repaint itself if it is realized.
--
-- If invalidate is 'True', the views entire area will be invalidated instead of redrawn immediately. The
-- view is then queued for redraw, which means that additional operations can be performed on it before
-- it is redrawn.
--
-- The difference can sometimes be important like when you are overlaying data and get flicker or
-- artifacts when setting the offset. If that happens, setting invalidate to 'True' could fix the
-- problem. See the source code to 'ImageToolSelector' for an example.
--
-- Normally, invalidate should always be 'False' because it is much faster to repaint immedately than
-- invalidating.
imageViewSetOffset :: ImageViewClass view => view
                   -> Double -- ^ @x@ X-component of the offset in zoom space coordinates.
                   -> Double -- ^ @y@ Y-component of the offset in zoom space coordinates.
                   -> Bool -- ^ @invalidate@ whether to invalidate the view or redraw immediately.
                   -> IO ()
imageViewSetOffset view x y invalidate =
  (\(ImageView arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_set_offset argPtr1 arg2 arg3 arg4)
{-# LINE 211 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)
    (realToFrac x)
    (realToFrac y)
    (fromBool invalidate)

-- | Sets how the view should draw transparent parts of images with an alpha channel. If transp is
-- 'ImageTranspColor', the specified color will be used. Otherwise the @transpColor@ argument is
-- ignored. If it is 'ImageTranspBackground', the background color of the widget will be used. If
-- it is 'ImageTranspGrid', then a grid with light and dark gray boxes will be drawn on the
-- transparent parts.
--
-- Calling this method causes the widget to immediately repaint. It also causes the 'pixbufChanged'
-- signal to be emitted. This is done so that other widgets (such as 'ImageNav') will have a chance to
-- render a view of the pixbuf with the new transparency settings.
--
-- The default values are:
--
-- * transp : 'ImageTranspGrid'
-- * @transpColor@ : 0x000000
imageViewSetTransp :: ImageViewClass view => view
                   -> ImageTransp -- ^ @transp@ The transparency type to use when drawing transparent images.
                   -> Int -- ^ @transpColor@ Color to use when drawing transparent images.
                   -> IO ()
imageViewSetTransp view transp transpColor =
  (\(ImageView arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_set_transp argPtr1 arg2 arg3)
{-# LINE 236 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)
    ((fromIntegral . fromEnum) transp)
    (fromIntegral transpColor)

-- | Returns the fitting setting of the view.
imageViewGetFitting :: ImageViewClass view => view
                    -> IO Bool -- ^ returns 'True' if the view is fitting the image, 'False' otherwise.
imageViewGetFitting view =
  liftM toBool $
  (\(ImageView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_get_fitting argPtr1)
{-# LINE 246 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)

-- | Sets whether to fit or not. If 'True', then the view will adapt the zoom so that the whole pixbuf is
-- visible.
--
-- Setting the fitting causes the widget to immediately repaint itself.
--
-- Fitting is by default 'True'.
imageViewSetFitting :: ImageViewClass view => view
                    -> Bool -- ^ @fitting@ whether to fit the image or not
                    -> IO ()
imageViewSetFitting view fitting =
  (\(ImageView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_set_fitting argPtr1 arg2)
{-# LINE 259 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)
    (fromBool fitting)

-- | Returns the pixbuf this view shows.
imageViewGetPixbuf :: ImageViewClass view => view
                   -> IO Pixbuf -- ^ returns The pixbuf this view shows.
imageViewGetPixbuf view =
  wrapNewGObject mkPixbuf $
  (\(ImageView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_get_pixbuf argPtr1)
{-# LINE 268 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)

-- | Sets the pixbuf to display, or 'Nothing' to not display any pixbuf. Normally, @resetFit@ should be 'True'
-- which enables fitting. Which means that, initially, the whole pixbuf will be shown.
--
-- Sometimes, the fit mode should not be reset. For example, if 'ImageView' is showing an animation,
-- it would be bad to reset the fit mode for each new frame. The parameter should then be 'False' which
-- leaves the fit mode of the view untouched.
--
-- This method should not be used if merely the contents of the pixbuf has changed. See
-- 'imageViewDamagePixels' for that.
--
-- If @resetFit@ is 'True', the 'zoomChanged' signal is emitted, otherwise not. The 'pixbufChanged'
-- signal is also emitted.
--
-- The default pixbuf is 'Nothing'.
imageViewSetPixbuf :: ImageViewClass view => view
                   -> Maybe Pixbuf -- ^ @pixbuf@ The pixbuf to display or 'Nothing'
                   -> Bool -- ^ @resetFit@ Whether to reset fitting or not.
                   -> IO ()
imageViewSetPixbuf view pixbuf resetFit =
    (\(ImageView arg1) (Pixbuf arg2) arg3 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_image_view_set_pixbuf argPtr1 argPtr2 arg3)
{-# LINE 290 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)
    (fromMaybe (Pixbuf nullForeignPtr) pixbuf)
    (fromBool resetFit)

-- | Get the current zoom factor of the view.
imageViewGetZoom :: ImageViewClass view => view
                 -> IO Double -- ^ returns the current zoom factor
imageViewGetZoom view =
  liftM realToFrac $
  (\(ImageView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_get_zoom argPtr1)
{-# LINE 300 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)

-- | Sets the zoom of the view.
--
-- Fitting is always disabled after this method has run. The 'zoomChanged' signal is unconditionally
-- emitted.
--
-- The default value is 1.0.
imageViewSetZoom :: ImageViewClass view => view
                 -> Double -- ^ @zoom@ the new zoom factor
                 -> IO ()
imageViewSetZoom view zoom =
  (\(ImageView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_set_zoom argPtr1 arg2)
{-# LINE 313 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)
    (realToFrac zoom)

-- | If 'True', the view uses a black background. If 'False', the view uses the default (normally gray)
-- background.
--
-- The default value is 'False'.
imageViewSetBlackBg :: ImageViewClass view => view
                    -> Bool -- ^ @blackBg@ Whether to use a black background or not.
                    -> IO ()
imageViewSetBlackBg view blackBg =
  (\(ImageView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_set_black_bg argPtr1 arg2)
{-# LINE 325 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)
    (fromBool blackBg)

-- | Returns whether the view renders the widget on a black background or not.
imageViewGetBlackBg :: ImageViewClass view => view
                    -> IO Bool -- ^ returns 'True' if a black background is used, otherwise 'False'.
imageViewGetBlackBg view =
  liftM toBool $
  (\(ImageView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_get_black_bg argPtr1)
{-# LINE 334 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)

-- | Sets whether to draw a frame around the image or not. When 'True', a one pixel wide frame is shown
-- around the image. Setting this attribute causes the widget to immediately repaint itself.
--
-- The default value is 'True'.
imageViewSetShowFrame :: ImageViewClass view => view
                      -> Bool -- ^ @showFrame@ whether to show a frame around the pixbuf or not
                      -> IO ()
imageViewSetShowFrame view showFrame =
  (\(ImageView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_set_show_frame argPtr1 arg2)
{-# LINE 345 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)
    (fromBool showFrame)

-- | Returns whether a one pixel frame is drawn around the pixbuf or not.
imageViewGetShowFrame :: ImageViewClass view => view
                      -> IO Bool
imageViewGetShowFrame view =
  liftM toBool $
  (\(ImageView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_get_show_frame argPtr1)
{-# LINE 354 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)

-- | Sets the interpolation mode of how the view. 'InterpHyper' is the slowest, but produces the best
-- results. 'InterpNearest' is the fastest, but provides bad rendering quality. 'InterpBilinear'
-- is a good compromise.
--
-- Setting the interpolation mode causes the widget to immediately repaint itself.
--
-- The default interpolation mode is 'InterpBilinear'.
imageViewSetInterpolation :: ImageViewClass view => view
                          -> InterpType -- ^ @interp@ The interpolation to use. One of 'InterpNearest', 'InterpBilinear' and 'InterpHyper'.
                          -> IO ()
imageViewSetInterpolation view interp =
  (\(ImageView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_set_interpolation argPtr1 arg2)
{-# LINE 368 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)
    ((fromIntegral . fromEnum) interp)

-- | Returns the current interpolation mode of the view.
imageViewGetInterpolation :: ImageViewClass view => view
                          -> IO InterpType
imageViewGetInterpolation view =
  liftM (toEnum . fromIntegral) $
  (\(ImageView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_get_interpolation argPtr1)
{-# LINE 377 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)

-- | Sets whether to show the mouse cursor when the mouse is over the widget or not. Hiding the cursor is
-- useful when the widget is fullscreened.
--
-- The default value is 'True'.
imageViewSetShowCursor :: ImageViewClass view => view
                       -> Bool -- ^ @showCursor@ whether to show the cursor or not
                       -> IO ()
imageViewSetShowCursor view showCursor =
  (\(ImageView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_set_show_cursor argPtr1 arg2)
{-# LINE 388 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)
    (fromBool showCursor)

-- | Returns whether to show the mouse cursor when the mouse is over the widget or not.
imageViewGetShowCursor :: ImageViewClass view => view
                       -> IO Bool -- ^ returns 'True' if the cursor is shown, otherwise 'False'.
imageViewGetShowCursor view =
  liftM toBool $
  (\(ImageView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_get_show_cursor argPtr1)
{-# LINE 397 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)

-- | Set the image tool to use. If the new tool is the same as the current tool, then nothing will be
-- done. Otherwise 'iimageToolPixbufChanged' is called so that the tool has a chance to generate
-- initial data for the pixbuf.
--
-- Setting the tool causes the widget to immediately repaint itself.
--
-- The default image tool is a 'ImageToolDragger' instance. See also 'IImageTool'.
imageViewSetTool :: ImageViewClass view => view
                 -> IImageTool -- ^ @tool@ The image tool to usek (must not be 'Nothing')
                 -> IO ()
imageViewSetTool view tool =
  (\(ImageView arg1) (IImageTool arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_image_view_set_tool argPtr1 argPtr2)
{-# LINE 411 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)
    tool

-- | Gets the image tool 'ImageView' uses for rendering and handling input events.
imageViewGetTool :: ImageViewClass view => view
                 -> IO IImageTool
imageViewGetTool view =
  makeNewGObject mkIImageTool $
  (\(ImageView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_get_tool argPtr1)
{-# LINE 420 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)

-- | Zoom in the view one step. Calling this method causes the widget to immediately repaint itself.
imageViewZoomIn :: ImageViewClass view => view -> IO ()
imageViewZoomIn view =
  (\(ImageView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_zoom_in argPtr1)
{-# LINE 426 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)

-- | Zoom out the view one step. Calling this method causes the widget to immediately repaint itself.
imageViewZoomOut :: ImageViewClass view => view -> IO ()
imageViewZoomOut view =
  (\(ImageView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_zoom_out argPtr1)
{-# LINE 432 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
    (toImageView view)

-- | Mark the pixels in the rectangle as damaged. That the pixels are damaged, means that they have been
-- modified and that the view must redraw them to ensure that the visible part of the image corresponds
-- to the pixels in that image. Calling this method emits the 'pixbufChanged' signal.
--
-- This method must be used when modifying the image data:
--
--
-- 'imageViewDamagePixels (View, &(Gdkrectangle){20, 20, 60, 60})';
--
-- If the whole pixbuf has been modified then rect should be 'Nothing' to indicate that a total update is
-- needed.
-- | See also 'imageViewSetPixbuf'.
imageViewDamagePixels :: ImageViewClass view => view
                      -> Maybe Rectangle -- ^ @rect@ rectangle in image space coordinates to mark as damaged or 'Nothing', to mark the whole pixbuf as damaged.
                      -> IO ()
imageViewDamagePixels view rect =
    maybeWith with rect $ \rectPtr ->
    (\(ImageView arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_view_damage_pixels argPtr1 arg2)
{-# LINE 452 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
      (toImageView view)
      (castPtr rectPtr)

-- | Returns a string with the format "major.minor.micro" which denotes the runtime version of
-- 'ImageView' being used.
imageViewLibraryVersion :: IO String
imageViewLibraryVersion =
  gtk_image_view_library_version
{-# LINE 460 "./Graphics/UI/Gtk/ImageView/ImageView.chs" #-}
  >>= peekUTFString

-- | The 'mouseWheelScroll' signal is emitted when the mouse wheel is scrolled on the view and
-- 'ControlMask' is not held down.
mouseWheelScroll :: ImageViewClass view => Signal view (ScrollDirection -> IO ())
mouseWheelScroll = Signal (connect_ENUM__NONE "mouse-wheel-scroll")

-- | The 'pixbufChanged' signal is emitted when the pixbuf the image view shows is changed and when its
-- image data is changed. Listening to this signal is useful if you, for example, have a label that
-- displays the width and height of the pixbuf in the view.
pixbufChanged :: ImageViewClass view => Signal view (IO ())
pixbufChanged = Signal (connect_NONE__NONE "pixbuf-changed")

-- | The 'scroll' signal is a keybinding signal emitted when a key is used to scroll the view. The signal
-- should not be used by clients of this library.
scroll :: ImageViewClass view => Signal view (ScrollType -> ScrollType -> IO ())
scroll = Signal (connect_ENUM_ENUM__NONE "scroll")

-- |
setFitting :: ImageViewClass view => Signal view (Int -> IO ())
setFitting = Signal (connect_INT__NONE "set-fitting")

-- |
setScrollAdjustments :: ImageViewClass view => Signal view (Adjustment -> Adjustment -> IO ())
setScrollAdjustments = Signal (connect_OBJECT_OBJECT__NONE "set-scroll-adjustments")

-- | The 'setZoom' signal is a keybinding signal emitted when GDK_1, GDK_2 or GDK_3 is pressed on the
-- widget which causes the zoom to be set to 100%, 200% or 300%. The signal should not be used by
-- clients of this library.
setZoom :: ImageViewClass view => Signal view (Double -> IO ())
setZoom = Signal (connect_DOUBLE__NONE "set-zoom")

-- | The 'zoomChanged' signal is emitted when the zoom factor of the view changes. Listening to this
-- signal is useful if, for example, you have a label that displays the zoom factor of the view. Use
-- 'imageViewGetZoom' to retrieve the value.
zoomChanged :: ImageViewClass view => Signal view (IO ())
zoomChanged = Signal (connect_NONE__NONE "zoom-changed")

-- |
zoomIn :: ImageViewClass view => Signal view (IO ())
zoomIn = Signal (connect_NONE__NONE "zoom-in")

-- |
zoomOut :: ImageViewClass view => Signal view (IO ())
zoomOut = Signal (connect_NONE__NONE "zoom-out")

foreign import ccall unsafe "gtk_image_view_new"
  gtk_image_view_new :: (IO (Ptr Widget))

foreign import ccall safe "gtk_image_view_get_viewport"
  gtk_image_view_get_viewport :: ((Ptr ImageView) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall safe "gtk_image_view_get_draw_rect"
  gtk_image_view_get_draw_rect :: ((Ptr ImageView) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall unsafe "gtk_image_view_get_check_colors"
  gtk_image_view_get_check_colors :: ((Ptr ImageView) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO ()))))

foreign import ccall safe "gtk_image_view_image_to_widget_rect"
  gtk_image_view_image_to_widget_rect :: ((Ptr ImageView) -> ((Ptr ()) -> ((Ptr ()) -> (IO CInt))))

foreign import ccall safe "gtk_image_view_set_offset"
  gtk_image_view_set_offset :: ((Ptr ImageView) -> (CDouble -> (CDouble -> (CInt -> (IO ())))))

foreign import ccall safe "gtk_image_view_set_transp"
  gtk_image_view_set_transp :: ((Ptr ImageView) -> (CInt -> (CInt -> (IO ()))))

foreign import ccall safe "gtk_image_view_get_fitting"
  gtk_image_view_get_fitting :: ((Ptr ImageView) -> (IO CInt))

foreign import ccall safe "gtk_image_view_set_fitting"
  gtk_image_view_set_fitting :: ((Ptr ImageView) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_image_view_get_pixbuf"
  gtk_image_view_get_pixbuf :: ((Ptr ImageView) -> (IO (Ptr Pixbuf)))

foreign import ccall safe "gtk_image_view_set_pixbuf"
  gtk_image_view_set_pixbuf :: ((Ptr ImageView) -> ((Ptr Pixbuf) -> (CInt -> (IO ()))))

foreign import ccall safe "gtk_image_view_get_zoom"
  gtk_image_view_get_zoom :: ((Ptr ImageView) -> (IO CDouble))

foreign import ccall safe "gtk_image_view_set_zoom"
  gtk_image_view_set_zoom :: ((Ptr ImageView) -> (CDouble -> (IO ())))

foreign import ccall safe "gtk_image_view_set_black_bg"
  gtk_image_view_set_black_bg :: ((Ptr ImageView) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_image_view_get_black_bg"
  gtk_image_view_get_black_bg :: ((Ptr ImageView) -> (IO CInt))

foreign import ccall safe "gtk_image_view_set_show_frame"
  gtk_image_view_set_show_frame :: ((Ptr ImageView) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_image_view_get_show_frame"
  gtk_image_view_get_show_frame :: ((Ptr ImageView) -> (IO CInt))

foreign import ccall safe "gtk_image_view_set_interpolation"
  gtk_image_view_set_interpolation :: ((Ptr ImageView) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_image_view_get_interpolation"
  gtk_image_view_get_interpolation :: ((Ptr ImageView) -> (IO CInt))

foreign import ccall safe "gtk_image_view_set_show_cursor"
  gtk_image_view_set_show_cursor :: ((Ptr ImageView) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_image_view_get_show_cursor"
  gtk_image_view_get_show_cursor :: ((Ptr ImageView) -> (IO CInt))

foreign import ccall safe "gtk_image_view_set_tool"
  gtk_image_view_set_tool :: ((Ptr ImageView) -> ((Ptr IImageTool) -> (IO ())))

foreign import ccall safe "gtk_image_view_get_tool"
  gtk_image_view_get_tool :: ((Ptr ImageView) -> (IO (Ptr IImageTool)))

foreign import ccall safe "gtk_image_view_zoom_in"
  gtk_image_view_zoom_in :: ((Ptr ImageView) -> (IO ()))

foreign import ccall safe "gtk_image_view_zoom_out"
  gtk_image_view_zoom_out :: ((Ptr ImageView) -> (IO ()))

foreign import ccall safe "gtk_image_view_damage_pixels"
  gtk_image_view_damage_pixels :: ((Ptr ImageView) -> ((Ptr ()) -> (IO ())))

foreign import ccall safe "gtk_image_view_library_version"
  gtk_image_view_library_version :: (IO (Ptr CChar))