{-# 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 = wrapNewGObject 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 ())))