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