{-# LINE 2 "./Graphics/UI/Gtk/ImageView/ImageToolSelector.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget ImageToolSelector
--
-- 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.ImageToolSelector (
-- * Details
-- | 'ImageToolSelector' is a tool for selecting areas of an image. It is useful for cropping an image,
-- for example. The tool is an implementor of the 'IImageTool' inteface which means that it can be
-- plugged into a 'ImageView' by using the 'imageViewSetTool' method.
--
-- 'ImageToolSelector' changes the default display of the 'ImageView'. It darkens down the unselected
-- region of the image which provides a nice effect and makes it clearer what part of the image that is
-- currently selected. Unfortunately, this effect is somewhat incompatible with how 'ImageNav' behaves
-- because that widget will show the image without darkening it.
--
-- The tool also changes the default behaviour of the mouse. When a 'ImageToolSelector' is set on a
-- 'ImageView', mouse presses do not "grab" the image and you cannot scroll by dragging. Instead mouse
-- presses and dragging is used to resize and move the selection rectangle. When the mouse drags the
-- selection rectangle to the border of the widget, the view autoscrolls which is a convenient way for
-- a user to position the selection.
--
-- Please note that 'ImageToolSelector' draws the image in two layers. One darkened and the selection
-- rectangle in normal luminosity. Because it uses two draw operations instead one one like
-- 'ImageToolDragger' does, it is significantly slower than that tool. Therefore, it makes sense for a
-- user of this library to set the interpolation to 'InterpNearest' when using this tool to ensure
-- that performance is acceptable to the users of the program.

-- * Types
   ImageToolSelector,
   ImageToolSelectorClass,

-- * Methods
   imageToolSelectorNew,
   imageToolSelectorGetSelection,
   imageToolSelectorSetSelection,

-- * Signals
   selectionChanged,
) where

import Control.Monad (liftM)
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 System.Glib.Attributes
import System.Glib.FFI
import System.Glib.UTFString

import Graphics.UI.Gtk.ImageView.Signals
{-# LINE 73 "./Graphics/UI/Gtk/ImageView/ImageToolSelector.chs" #-}
import Graphics.UI.Gtk.ImageView.Types
{-# LINE 74 "./Graphics/UI/Gtk/ImageView/ImageToolSelector.chs" #-}
import System.Glib.Properties
{-# LINE 75 "./Graphics/UI/Gtk/ImageView/ImageToolSelector.chs" #-}


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

-- | Creates a new selector tool for the specified view with default values. The default values are:
--
-- * selection : (0, 0) - [0, 0]
imageToolSelectorNew :: ImageViewClass view => view -> IO ImageToolSelector
imageToolSelectorNew view =
  makeNewGObject mkImageToolSelector $
  liftM (castPtr :: Ptr IImageTool -> Ptr ImageToolSelector) $
  (\(ImageView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_tool_selector_new argPtr1)
{-# LINE 86 "./Graphics/UI/Gtk/ImageView/ImageToolSelector.chs" #-}
    (toImageView view)

-- | Fills in rect with the current selection rectangle. If either the width or the height of rect is
-- zero, then nothing is selected and the selection should be considered inactive. See
-- 'selectionChanged' for an example.
imageToolSelectorGetSelection :: ImageToolSelectorClass selector => selector -> IO Rectangle
imageToolSelectorGetSelection selector =
    alloca $ \rPtr -> do
      (\(ImageToolSelector arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_tool_selector_get_selection argPtr1 arg2)
{-# LINE 95 "./Graphics/UI/Gtk/ImageView/ImageToolSelector.chs" #-}
        (toImageToolSelector selector)
        (castPtr rPtr)
      peek rPtr

-- | Sets the selection rectangle for the tool. Setting this attribute will cause the widget to
-- immediately repaint itself if its view is realized.
--
-- This method does nothing under the following circumstances:
--
-- * If the views pixbuf is 'Nothing'.
-- * If rect is wider or taller than the size of the pixbuf
-- * If rect equals the current selection rectangle.
--
-- If the selection falls outside the pixbufs area, its position is moved so that it is within the
-- pixbuf.
--
-- Calling this method causes the 'selectionChanged' signal to be emitted.
--
-- The default selection is (0,0) - [0,0].
imageToolSelectorSetSelection :: ImageToolSelectorClass selector => selector -> Rectangle -> IO ()
imageToolSelectorSetSelection selector rect =
  with rect $ \ rectPtr ->
  (\(ImageToolSelector arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_tool_selector_set_selection argPtr1 arg2)
{-# LINE 118 "./Graphics/UI/Gtk/ImageView/ImageToolSelector.chs" #-}
    (toImageToolSelector selector)
    (castPtr rectPtr)

-- | The 'selectionChanged' signal is emitted when the selection rectangle on the selector is moved or
-- resized. It is inteded to be used by applications that wants to print status information.
selectionChanged :: ImageToolSelectorClass selector => Signal selector (IO ())
selectionChanged = Signal (connect_NONE__NONE "selection-changed")

foreign import ccall unsafe "gtk_image_tool_selector_new"
  gtk_image_tool_selector_new :: ((Ptr ImageView) -> (IO (Ptr IImageTool)))

foreign import ccall safe "gtk_image_tool_selector_get_selection"
  gtk_image_tool_selector_get_selection :: ((Ptr ImageToolSelector) -> ((Ptr ()) -> (IO ())))

foreign import ccall safe "gtk_image_tool_selector_set_selection"
  gtk_image_tool_selector_set_selection :: ((Ptr ImageToolSelector) -> ((Ptr ()) -> (IO ())))