{-# LINE 2 "./Graphics/UI/Gtk/ImageView/ImageNav.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget ImageNav
--
-- 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.ImageNav (
-- * Details
-- | 'ImageNav' is a popup window that shows a downscaled preview of the pixbuf that 'ImageView' is
-- showing. The user can drag around a rectangle which indicates the current view of the image.
--
-- This class is used by 'ImageScrollWin' itself. It is probably not very useful for clients of this
-- library.
--
-- 'ImageNav' has the same keybindings that 'ImageView' has. All keypresses that it receives are
-- passed along to the view.

-- * Types
   ImageNav,
   ImageNavClass,

-- * Methods
   imageNavNew,
   imageNavGetPixbuf,
   imageNavGrab,
   imageNavRelease,
   imageNavShowAndGrab,
) where

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

import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.ImageView.Enums
import System.Glib.Attributes
import System.Glib.FFI
import System.Glib.UTFString

import Graphics.UI.Gtk.ImageView.Signals
{-# LINE 59 "./Graphics/UI/Gtk/ImageView/ImageNav.chs" #-}
import Graphics.UI.Gtk.ImageView.Types
{-# LINE 60 "./Graphics/UI/Gtk/ImageView/ImageNav.chs" #-}
import System.Glib.Properties
{-# LINE 61 "./Graphics/UI/Gtk/ImageView/ImageNav.chs" #-}


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

-- | Creates a new 'ImageNav' for showing thumbnails of the view.
imageNavNew :: ImageViewClass view => view -> IO ImageNav
imageNavNew view =
  makeNewObject mkImageNav $
  liftM (castPtr :: Ptr Widget -> Ptr ImageNav) $
  (\(ImageView arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_nav_new argPtr1)
{-# LINE 70 "./Graphics/UI/Gtk/ImageView/ImageNav.chs" #-}
    (toImageView view)

-- | Returns the downscaled pixbuf of the views pixbuf that this 'ImageNav' shows, or 'Nothing' if that
-- pixbuf has not been created yet.
imageNavGetPixbuf :: ImageNavClass nav => nav
                  -> IO (Maybe Pixbuf) -- ^ returns the pixbuf in the navigation area this image navigator shows, or 'Nothing' if none exist.
imageNavGetPixbuf nav =
  maybeNull (wrapNewGObject mkPixbuf) $
  (\(ImageNav arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_nav_get_pixbuf argPtr1)
{-# LINE 79 "./Graphics/UI/Gtk/ImageView/ImageNav.chs" #-}
    (toImageNav nav)

-- |
imageNavGrab :: ImageNavClass nav => nav -> IO ()
imageNavGrab nav =
  (\(ImageNav arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_nav_grab argPtr1)
{-# LINE 85 "./Graphics/UI/Gtk/ImageView/ImageNav.chs" #-}
    (toImageNav nav)

-- |
imageNavRelease :: ImageNavClass nav => nav -> IO ()
imageNavRelease nav =
  (\(ImageNav arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_nav_release argPtr1)
{-# LINE 91 "./Graphics/UI/Gtk/ImageView/ImageNav.chs" #-}
    (toImageNav nav)

-- | Show the 'ImageNav' centered around the point (@centerX@, @centerY@) and grab mouse and keyboard
-- events. The grab continues until a button release event is received which causes the widget to hide.
imageNavShowAndGrab :: ImageNavClass nav => nav
                    -> Int -- ^ @centerX@ x coordinate of center position
                    -> Int -- ^ @centerY@ y coordinate of center position
                    -> IO ()
imageNavShowAndGrab nav centerX centerY =
  (\(ImageNav arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->gtk_image_nav_show_and_grab argPtr1 arg2 arg3)
{-# LINE 101 "./Graphics/UI/Gtk/ImageView/ImageNav.chs" #-}
    (toImageNav nav)
    (fromIntegral centerX)
    (fromIntegral centerY)

foreign import ccall unsafe "gtk_image_nav_new"
  gtk_image_nav_new :: ((Ptr ImageView) -> (IO (Ptr Widget)))

foreign import ccall safe "gtk_image_nav_get_pixbuf"
  gtk_image_nav_get_pixbuf :: ((Ptr ImageNav) -> (IO (Ptr Pixbuf)))

foreign import ccall safe "gtk_image_nav_grab"
  gtk_image_nav_grab :: ((Ptr ImageNav) -> (IO ()))

foreign import ccall safe "gtk_image_nav_release"
  gtk_image_nav_release :: ((Ptr ImageNav) -> (IO ()))

foreign import ccall safe "gtk_image_nav_show_and_grab"
  gtk_image_nav_show_and_grab :: ((Ptr ImageNav) -> (CInt -> (CInt -> (IO ()))))