ImageView.chs

{-# LANGUAGE CPP #-}
-- -*-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#}
{#import Graphics.UI.Gtk.ImageView.Types#}
{#import System.Glib.Properties#}

{# context lib="gtk" prefix="gtk" #}

-- | 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) $
  {# call unsafe gtk_image_view_new #}

-- | 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 $
              {#call gtk_image_view_get_viewport #}
                (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 $
              {#call gtk_image_view_get_draw_rect #}
                (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
  {# call unsafe gtk_image_view_get_check_colors #}
    (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 $
  {#call gtk_image_view_image_to_widget_rect #}
    (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 = 
  {#call gtk_image_view_set_offset #}
    (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 =
  {#call gtk_image_view_set_transp #}
    (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 $
  {#call gtk_image_view_get_fitting #}
    (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 =
  {#call gtk_image_view_set_fitting #}
    (toImageView view)
    (fromBool fitting)

-- | Returns the pixbuf this view shows.
imageViewGetPixbuf :: ImageViewClass view => view
                   -> IO Pixbuf -- ^ returns The pixbuf this view shows. 
imageViewGetPixbuf view =
  makeNewGObject mkPixbuf $
  {#call gtk_image_view_get_pixbuf #}
    (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 = 
    {#call gtk_image_view_set_pixbuf #}
    (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 $
  {#call gtk_image_view_get_zoom #}
    (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 =
  {#call gtk_image_view_set_zoom #}
    (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 =
  {#call gtk_image_view_set_black_bg #}
    (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 $
  {#call gtk_image_view_get_black_bg #}
    (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 =
  {#call gtk_image_view_set_show_frame #}
    (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 $
  {#call gtk_image_view_get_show_frame #}
    (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 =
  {#call gtk_image_view_set_interpolation #}
    (toImageView view)  
    ((fromIntegral . fromEnum) interp)

-- | Returns the current interpolation mode of the view.
imageViewGetInterpolation :: ImageViewClass view => view
                          -> IO InterpType
imageViewGetInterpolation view =
  liftM (toEnum . fromIntegral) $
  {#call gtk_image_view_get_interpolation #}
    (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 =
  {#call gtk_image_view_set_show_cursor #}
    (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 $
  {#call gtk_image_view_get_show_cursor #}
    (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 =
  {#call gtk_image_view_set_tool #}
    (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 $
  {#call gtk_image_view_get_tool #}
    (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 =
  {#call gtk_image_view_zoom_in #}
    (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 =
  {#call gtk_image_view_zoom_out #}
    (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:
-- 
--     // Drawing something cool in the area 20,20 - 60,60 here...  ...  // And force an update
--     '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 ->
    {#call gtk_image_view_damage_pixels #}
      (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 = 
  {#call gtk_image_view_library_version #}
  >>= 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")