{-# LINE 2 "./Graphics/UI/Gtk/Gdk/Gdk.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Gdk
--
-- Author : Jens Petersen <petersen@haskell.org>
--
-- Created: 6 June 2003
--
-- Copyright (C) 2003-2005 Jens-Ulrik Holger Petersen
--
-- 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)
--
-- Gdk general functions.
--
module Graphics.UI.Gtk.Gdk.Gdk (
  flush,
  screenWidth,
  screenHeight,
  screenWidthMM,
  screenHeightMM,
  GrabStatus(..),
  pointerGrab,
  pointerUngrab,
  pointerIsGrabbed,
  keyboardGrab,
  keyboardUngrab,
  beep



  ) where

import Control.Monad (liftM)

import System.Glib.Flags (fromFlags)
import System.Glib.FFI
import Graphics.UI.Gtk.Types
{-# LINE 51 "./Graphics/UI/Gtk/Gdk/Gdk.chs" #-}
import Graphics.UI.Gtk.Gdk.Cursor (Cursor(..))
import Graphics.UI.Gtk.Gdk.Events
import Graphics.UI.Gtk.Gdk.Enums (EventMask, GrabStatus(..))





{-# LINE 59 "./Graphics/UI/Gtk/Gdk/Gdk.chs" #-}

-- | Emits a short beep.
--
beep :: IO ()
beep :: IO ()
beep = IO ()
gdk_beep
{-# LINE 64 "./Graphics/UI/Gtk/Gdk/Gdk.chs" #-}

-- | Flushes the X output buffer and waits until all requests have been
-- processed by the server. This is rarely needed by applications.
--
flush :: IO ()
flush :: IO ()
flush = IO ()
gdk_flush
{-# LINE 70 "./Graphics/UI/Gtk/Gdk/Gdk.chs" #-}

-- | Returns the width of the default screen in pixels.
--
screenWidth :: IO Int
screenWidth :: IO Int
screenWidth = (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ IO CInt
gdk_screen_width
{-# LINE 75 "./Graphics/UI/Gtk/Gdk/Gdk.chs" #-}

-- | Returns the height of the default screen in pixels.
--
screenHeight :: IO Int
screenHeight :: IO Int
screenHeight = (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ IO CInt
gdk_screen_height
{-# LINE 80 "./Graphics/UI/Gtk/Gdk/Gdk.chs" #-}

-- | Returns the width of the default screen in millimeters. Note that on many
-- X servers this value will not be correct.
--
screenWidthMM :: IO Int
screenWidthMM :: IO Int
screenWidthMM = (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ IO CInt
gdk_screen_width_mm
{-# LINE 86 "./Graphics/UI/Gtk/Gdk/Gdk.chs" #-}

-- | Returns the height of the default screen in millimeters. Note that on many
-- X servers this value will not be correct.
--
screenHeightMM :: IO Int
screenHeightMM :: IO Int
screenHeightMM = (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ IO CInt
gdk_screen_height_mm
{-# LINE 92 "./Graphics/UI/Gtk/Gdk/Gdk.chs" #-}

-- | Grabs the pointer (usually a mouse) so that all events are passed to this
-- application until the pointer is ungrabbed with 'pointerUngrab', or the grab
-- window becomes unviewable. This overrides any previous pointer grab by this
-- client.
--
-- Pointer grabs are used for operations which need complete control over mouse
-- events, even if the mouse leaves the application. For example in GTK+ it is
-- used for Drag and Drop, for dragging the handle in the GtkHPaned and
-- GtkVPaned widgets, and for resizing columns in GtkCList widgets.
--
-- Note that if the event mask of an X window has selected both button press
-- and button release events, then a button press event will cause an automatic
-- pointer grab until the button is released. X does this automatically since
-- most applications expect to receive button press and release events in
-- pairs. It is equivalent to a pointer grab on the window with @owner_events@
-- set to @True@.
--
-- If you set up anything at the time you take the grab that needs to be
-- cleaned up when the grab ends, you should handle the GdkEventGrabBroken
-- events that are emitted when the grab ends unvoluntarily.
--
pointerGrab :: (DrawWindowClass window, DrawWindowClass confine_to) =>
    window -- ^ @window@ - the 'DrawWindow' which will own the grab (the grab
           -- window).
  -> Bool -- ^ @owner_events@ - if @False@ then all pointer events are
           -- reported with respect to @window@ and are only reported if
           -- selected by @event_mask@. If @True@ then pointer events for this
           -- application are reported as normal, but pointer events outside
           -- this application are reported with respect to @window@ and only
           -- if selected by @event_mask@. In either mode, unreported events
           -- are discarded.
  -> [EventMask] -- ^ @event_mask@ - specifies the event mask, which is used in
                 -- accordance with @owner_events@. Note that only pointer
                 -- events (i.e. button and motion events) may be selected.
  -> Maybe confine_to -- ^ @confine_to@ If supplied, the pointer will be
                      -- confined to this window during the grab. If the
                      -- pointer is outside @confine_to@, it will automatically
                      -- be moved to the closest edge of @confine_to@ and enter
                      -- and leave events will be generated as necessary.
  -> Maybe Cursor -- ^ @cursor@ - the cursor to display while the grab is
                  -- active. If this is @Nothing@ then the normal cursors are
                  -- used for @window@ and its descendants, and the cursor for
                  -- @window@ is used for all other windows.
  -> TimeStamp -- ^ @time@ - the timestamp of the event which led to this
               -- pointer grab. This usually comes from an 'Event', though
               -- 'currentTime' can be used if the time isn't known.
  -> IO GrabStatus -- ^ @Returns@ - 'GrabSuccess' if the grab was successful.
pointerGrab :: forall window confine_to.
(DrawWindowClass window, DrawWindowClass confine_to) =>
window
-> Bool
-> [EventMask]
-> Maybe confine_to
-> Maybe Cursor
-> TimeStamp
-> IO GrabStatus
pointerGrab window
window Bool
owner_events [EventMask]
event_mask Maybe confine_to
mbConfine_to Maybe Cursor
mbCursor TimeStamp
time =
  (CInt -> GrabStatus) -> IO CInt -> IO GrabStatus
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> GrabStatus
forall a. Enum a => Int -> a
toEnum (Int -> GrabStatus) -> (CInt -> Int) -> CInt -> GrabStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO GrabStatus) -> IO CInt -> IO GrabStatus
forall a b. (a -> b) -> a -> b
$
  (\(DrawWindow ForeignPtr DrawWindow
arg1) CInt
arg2 CInt
arg3 (DrawWindow ForeignPtr DrawWindow
arg4) (Cursor ForeignPtr Cursor
arg5) CUInt
arg6 -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO CInt) -> IO CInt)
-> (Ptr DrawWindow -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg4 ((Ptr DrawWindow -> IO CInt) -> IO CInt)
-> (Ptr DrawWindow -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr4 ->ForeignPtr Cursor -> (Ptr Cursor -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Cursor
arg5 ((Ptr Cursor -> IO CInt) -> IO CInt)
-> (Ptr Cursor -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Cursor
argPtr5 ->Ptr DrawWindow
-> CInt -> CInt -> Ptr DrawWindow -> Ptr Cursor -> CUInt -> IO CInt
gdk_pointer_grab Ptr DrawWindow
argPtr1 CInt
arg2 CInt
arg3 Ptr DrawWindow
argPtr4 Ptr Cursor
argPtr5 CUInt
arg6)
{-# LINE 143 "./Graphics/UI/Gtk/Gdk/Gdk.chs" #-}
    (toDrawWindow window)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
owner_events)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ [EventMask] -> Int
forall a. Flags a => [a] -> Int
fromFlags [EventMask]
event_mask)
    (DrawWindow
-> (confine_to -> DrawWindow) -> Maybe confine_to -> DrawWindow
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ForeignPtr DrawWindow -> DrawWindow
DrawWindow ForeignPtr DrawWindow
forall a. ForeignPtr a
nullForeignPtr) confine_to -> DrawWindow
forall o. DrawWindowClass o => o -> DrawWindow
toDrawWindow Maybe confine_to
mbConfine_to)
    (Cursor -> (Cursor -> Cursor) -> Maybe Cursor -> Cursor
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ForeignPtr Cursor -> Cursor
Cursor ForeignPtr Cursor
forall a. ForeignPtr a
nullForeignPtr) Cursor -> Cursor
forall a. a -> a
id Maybe Cursor
mbCursor)
    (TimeStamp -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral TimeStamp
time)

-- | Ungrabs the pointer on the default display, if it is grabbed by this
-- application.
--
pointerUngrab ::
    TimeStamp -- ^ @time@ - a timestamp from an 'Event', or 'currentTime' if no
              -- timestamp is available.
  -> IO ()
pointerUngrab :: TimeStamp -> IO ()
pointerUngrab TimeStamp
time = CUInt -> IO ()
gdk_pointer_ungrab (TimeStamp -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral TimeStamp
time)

-- | Returns @True@ if the pointer on the default display is currently grabbed
-- by this application.
--
-- Note that this does not take the inmplicit pointer grab on button presses
-- into account.
--
pointerIsGrabbed :: IO Bool
pointerIsGrabbed :: IO Bool
pointerIsGrabbed = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ IO CInt
gdk_pointer_is_grabbed
{-# LINE 167 "./Graphics/UI/Gtk/Gdk/Gdk.chs" #-}

-- | Grabs the keyboard so that all events are passed to this application until
-- the keyboard is ungrabbed with 'keyboardUngrab'. This overrides any previous
-- keyboard grab by this client.
--
-- If you set up anything at the time you take the grab that needs to be
-- cleaned up when the grab ends, you should handle the GdkEventGrabBroken
-- events that are emitted when the grab ends unvoluntarily.
keyboardGrab :: (DrawWindowClass window) =>
    window -- ^ @window@ - the 'DrawWindow' which will own the grab (the grab
           -- window).
  -> Bool -- ^ @owner_events@ - if @False@ then all keyboard events are
           -- reported with respect to @window@. If @True@ then keyboard events
           -- for this application are reported as normal, but keyboard events
           -- outside this application are reported with respect to @window@.
           -- Both key press and key release events are always reported,
           -- independent of the event mask set by the application.
  -> TimeStamp -- ^ @time@ - a timestamp from an 'Event', or 'currentTime' if
               -- no timestamp is available.
  -> IO GrabStatus -- ^ @Returns@ - 'GrabSuccess' if the grab was successful.
keyboardGrab :: forall window.
DrawWindowClass window =>
window -> Bool -> TimeStamp -> IO GrabStatus
keyboardGrab window
window Bool
owner_events TimeStamp
time =
  (CInt -> GrabStatus) -> IO CInt -> IO GrabStatus
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> GrabStatus
forall a. Enum a => Int -> a
toEnum (Int -> GrabStatus) -> (CInt -> Int) -> CInt -> GrabStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO GrabStatus) -> IO CInt -> IO GrabStatus
forall a b. (a -> b) -> a -> b
$
  (\(DrawWindow ForeignPtr DrawWindow
arg1) CInt
arg2 CUInt
arg3 -> ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg1 ((Ptr DrawWindow -> IO CInt) -> IO CInt)
-> (Ptr DrawWindow -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr1 ->Ptr DrawWindow -> CInt -> CUInt -> IO CInt
gdk_keyboard_grab Ptr DrawWindow
argPtr1 CInt
arg2 CUInt
arg3)
{-# LINE 190 "./Graphics/UI/Gtk/Gdk/Gdk.chs" #-}
    (toDrawWindow window)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
owner_events)
    (TimeStamp -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral TimeStamp
time)

-- | Ungrabs the keyboard on the default display, if it is grabbed by this
-- application.
keyboardUngrab ::
    TimeStamp -- ^ @time@ - a timestamp from an 'Event', or 'currentTime' if no
              -- timestamp is available.
  -> IO ()
keyboardUngrab :: TimeStamp -> IO ()
keyboardUngrab TimeStamp
time = CUInt -> IO ()
gdk_keyboard_ungrab (TimeStamp -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral TimeStamp
time)

foreign import ccall safe "gdk_beep"
  gdk_beep :: (IO ())

foreign import ccall safe "gdk_flush"
  gdk_flush :: (IO ())

foreign import ccall safe "gdk_screen_width"
  gdk_screen_width :: (IO CInt)

foreign import ccall safe "gdk_screen_height"
  gdk_screen_height :: (IO CInt)

foreign import ccall safe "gdk_screen_width_mm"
  gdk_screen_width_mm :: (IO CInt)

foreign import ccall safe "gdk_screen_height_mm"
  gdk_screen_height_mm :: (IO CInt)

foreign import ccall safe "gdk_pointer_grab"
  gdk_pointer_grab :: ((Ptr DrawWindow) -> (CInt -> (CInt -> ((Ptr DrawWindow) -> ((Ptr Cursor) -> (CUInt -> (IO CInt)))))))

foreign import ccall safe "gdk_pointer_ungrab"
  gdk_pointer_ungrab :: (CUInt -> (IO ()))

foreign import ccall safe "gdk_pointer_is_grabbed"
  gdk_pointer_is_grabbed :: (IO CInt)

foreign import ccall safe "gdk_keyboard_grab"
  gdk_keyboard_grab :: ((Ptr DrawWindow) -> (CInt -> (CUInt -> (IO CInt))))

foreign import ccall safe "gdk_keyboard_ungrab"
  gdk_keyboard_ungrab :: (CUInt -> (IO ()))