{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

The 'GI.Gdk.Structs.Geometry.Geometry' struct gives the window manager information about
a window’s geometry constraints. Normally you would set these on
the GTK+ level using @/gtk_window_set_geometry_hints()/@. @/GtkWindow/@
then sets the hints on the 'GI.Gdk.Objects.Window.Window' it creates.

'GI.Gdk.Objects.Window.windowSetGeometryHints' expects the hints to be fully valid already
and simply passes them to the window manager; in contrast,
@/gtk_window_set_geometry_hints()/@ performs some interpretation. For example,
@/GtkWindow/@ will apply the hints to the geometry widget instead of the
toplevel window, if you set a geometry widget. Also, the
/@minWidth@/\//@minHeight@/\//@maxWidth@/\//@maxHeight@/ fields may be set to -1, and
@/GtkWindow/@ will substitute the size request of the window or geometry widget.
If the minimum size hint is not provided, @/GtkWindow/@ will use its requisition
as the minimum size. If the minimum size is provided and a geometry widget is
set, @/GtkWindow/@ will take the minimum size as the minimum size of the
geometry widget rather than the entire window. The base size is treated
similarly.

The canonical use-case for @/gtk_window_set_geometry_hints()/@ is to get a
terminal widget to resize properly. Here, the terminal text area should be
the geometry widget; @/GtkWindow/@ will then automatically set the base size to
the size of other widgets in the terminal window, such as the menubar and
scrollbar. Then, the /@widthInc@/ and /@heightInc@/ fields should be set to the
size of one character in the terminal. Finally, the base size should be set
to the size of one character. The net effect is that the minimum size of the
terminal will have a 1x1 character terminal area, and only terminal sizes on
the “character grid” will be allowed.

Here’s an example of how the terminal example would be implemented, assuming
a terminal area widget called “terminal” and a toplevel window “toplevel”:


=== /C code/
>
>	GdkGeometry hints;
>
>	hints.base_width = terminal->char_width;
>        hints.base_height = terminal->char_height;
>        hints.min_width = terminal->char_width;
>        hints.min_height = terminal->char_height;
>        hints.width_inc = terminal->char_width;
>        hints.height_inc = terminal->char_height;
>
> gtk_window_set_geometry_hints (GTK_WINDOW (toplevel),
>                                GTK_WIDGET (terminal),
>                                &hints,
>                                GDK_HINT_RESIZE_INC |
>                                GDK_HINT_MIN_SIZE |
>                                GDK_HINT_BASE_SIZE);


The other useful fields are the /@minAspect@/ and /@maxAspect@/ fields; these
contain a width\/height ratio as a floating point number. If a geometry widget
is set, the aspect applies to the geometry widget rather than the entire
window. The most common use of these hints is probably to set /@minAspect@/ and
/@maxAspect@/ to the same value, thus forcing the window to keep a constant
aspect ratio.
-}

module GI.Gdk.Structs.Geometry
    ( 

-- * Exported types
    Geometry(..)                            ,
    newZeroGeometry                         ,
    noGeometry                              ,


 -- * Properties
-- ** baseHeight #attr:baseHeight#
    geometry_baseHeight                     ,
    getGeometryBaseHeight                   ,
    setGeometryBaseHeight                   ,


-- ** baseWidth #attr:baseWidth#
    geometry_baseWidth                      ,
    getGeometryBaseWidth                    ,
    setGeometryBaseWidth                    ,


-- ** heightInc #attr:heightInc#
    geometry_heightInc                      ,
    getGeometryHeightInc                    ,
    setGeometryHeightInc                    ,


-- ** maxAspect #attr:maxAspect#
    geometry_maxAspect                      ,
    getGeometryMaxAspect                    ,
    setGeometryMaxAspect                    ,


-- ** maxHeight #attr:maxHeight#
    geometry_maxHeight                      ,
    getGeometryMaxHeight                    ,
    setGeometryMaxHeight                    ,


-- ** maxWidth #attr:maxWidth#
    geometry_maxWidth                       ,
    getGeometryMaxWidth                     ,
    setGeometryMaxWidth                     ,


-- ** minAspect #attr:minAspect#
    geometry_minAspect                      ,
    getGeometryMinAspect                    ,
    setGeometryMinAspect                    ,


-- ** minHeight #attr:minHeight#
    geometry_minHeight                      ,
    getGeometryMinHeight                    ,
    setGeometryMinHeight                    ,


-- ** minWidth #attr:minWidth#
    geometry_minWidth                       ,
    getGeometryMinWidth                     ,
    setGeometryMinWidth                     ,


-- ** widthInc #attr:widthInc#
    geometry_widthInc                       ,
    getGeometryWidthInc                     ,
    setGeometryWidthInc                     ,


-- ** winGravity #attr:winGravity#
    geometry_winGravity                     ,
    getGeometryWinGravity                   ,
    setGeometryWinGravity                   ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP

import {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums

newtype Geometry = Geometry (ManagedPtr Geometry)
instance WrappedPtr Geometry where
    wrappedPtrCalloc = callocBytes 56
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 56 >=> wrapPtr Geometry)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `Geometry` struct initialized to zero.
newZeroGeometry :: MonadIO m => m Geometry
newZeroGeometry = liftIO $ wrappedPtrCalloc >>= wrapPtr Geometry

instance tag ~ 'AttrSet => Constructible Geometry tag where
    new _ attrs = do
        o <- newZeroGeometry
        GI.Attributes.set o attrs
        return o


noGeometry :: Maybe Geometry
noGeometry = Nothing

getGeometryMinWidth :: MonadIO m => Geometry -> m Int32
getGeometryMinWidth s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO Int32
    return val

setGeometryMinWidth :: MonadIO m => Geometry -> Int32 -> m ()
setGeometryMinWidth s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: Int32)

data GeometryMinWidthFieldInfo
instance AttrInfo GeometryMinWidthFieldInfo where
    type AttrAllowedOps GeometryMinWidthFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GeometryMinWidthFieldInfo = (~) Int32
    type AttrBaseTypeConstraint GeometryMinWidthFieldInfo = (~) Geometry
    type AttrGetType GeometryMinWidthFieldInfo = Int32
    type AttrLabel GeometryMinWidthFieldInfo = "min_width"
    type AttrOrigin GeometryMinWidthFieldInfo = Geometry
    attrGet _ = getGeometryMinWidth
    attrSet _ = setGeometryMinWidth
    attrConstruct = undefined
    attrClear _ = undefined

geometry_minWidth :: AttrLabelProxy "minWidth"
geometry_minWidth = AttrLabelProxy


getGeometryMinHeight :: MonadIO m => Geometry -> m Int32
getGeometryMinHeight s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 4) :: IO Int32
    return val

setGeometryMinHeight :: MonadIO m => Geometry -> Int32 -> m ()
setGeometryMinHeight s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 4) (val :: Int32)

data GeometryMinHeightFieldInfo
instance AttrInfo GeometryMinHeightFieldInfo where
    type AttrAllowedOps GeometryMinHeightFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GeometryMinHeightFieldInfo = (~) Int32
    type AttrBaseTypeConstraint GeometryMinHeightFieldInfo = (~) Geometry
    type AttrGetType GeometryMinHeightFieldInfo = Int32
    type AttrLabel GeometryMinHeightFieldInfo = "min_height"
    type AttrOrigin GeometryMinHeightFieldInfo = Geometry
    attrGet _ = getGeometryMinHeight
    attrSet _ = setGeometryMinHeight
    attrConstruct = undefined
    attrClear _ = undefined

geometry_minHeight :: AttrLabelProxy "minHeight"
geometry_minHeight = AttrLabelProxy


getGeometryMaxWidth :: MonadIO m => Geometry -> m Int32
getGeometryMaxWidth s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO Int32
    return val

setGeometryMaxWidth :: MonadIO m => Geometry -> Int32 -> m ()
setGeometryMaxWidth s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: Int32)

data GeometryMaxWidthFieldInfo
instance AttrInfo GeometryMaxWidthFieldInfo where
    type AttrAllowedOps GeometryMaxWidthFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GeometryMaxWidthFieldInfo = (~) Int32
    type AttrBaseTypeConstraint GeometryMaxWidthFieldInfo = (~) Geometry
    type AttrGetType GeometryMaxWidthFieldInfo = Int32
    type AttrLabel GeometryMaxWidthFieldInfo = "max_width"
    type AttrOrigin GeometryMaxWidthFieldInfo = Geometry
    attrGet _ = getGeometryMaxWidth
    attrSet _ = setGeometryMaxWidth
    attrConstruct = undefined
    attrClear _ = undefined

geometry_maxWidth :: AttrLabelProxy "maxWidth"
geometry_maxWidth = AttrLabelProxy


getGeometryMaxHeight :: MonadIO m => Geometry -> m Int32
getGeometryMaxHeight s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 12) :: IO Int32
    return val

setGeometryMaxHeight :: MonadIO m => Geometry -> Int32 -> m ()
setGeometryMaxHeight s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 12) (val :: Int32)

data GeometryMaxHeightFieldInfo
instance AttrInfo GeometryMaxHeightFieldInfo where
    type AttrAllowedOps GeometryMaxHeightFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GeometryMaxHeightFieldInfo = (~) Int32
    type AttrBaseTypeConstraint GeometryMaxHeightFieldInfo = (~) Geometry
    type AttrGetType GeometryMaxHeightFieldInfo = Int32
    type AttrLabel GeometryMaxHeightFieldInfo = "max_height"
    type AttrOrigin GeometryMaxHeightFieldInfo = Geometry
    attrGet _ = getGeometryMaxHeight
    attrSet _ = setGeometryMaxHeight
    attrConstruct = undefined
    attrClear _ = undefined

geometry_maxHeight :: AttrLabelProxy "maxHeight"
geometry_maxHeight = AttrLabelProxy


getGeometryBaseWidth :: MonadIO m => Geometry -> m Int32
getGeometryBaseWidth s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO Int32
    return val

setGeometryBaseWidth :: MonadIO m => Geometry -> Int32 -> m ()
setGeometryBaseWidth s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (val :: Int32)

data GeometryBaseWidthFieldInfo
instance AttrInfo GeometryBaseWidthFieldInfo where
    type AttrAllowedOps GeometryBaseWidthFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GeometryBaseWidthFieldInfo = (~) Int32
    type AttrBaseTypeConstraint GeometryBaseWidthFieldInfo = (~) Geometry
    type AttrGetType GeometryBaseWidthFieldInfo = Int32
    type AttrLabel GeometryBaseWidthFieldInfo = "base_width"
    type AttrOrigin GeometryBaseWidthFieldInfo = Geometry
    attrGet _ = getGeometryBaseWidth
    attrSet _ = setGeometryBaseWidth
    attrConstruct = undefined
    attrClear _ = undefined

geometry_baseWidth :: AttrLabelProxy "baseWidth"
geometry_baseWidth = AttrLabelProxy


getGeometryBaseHeight :: MonadIO m => Geometry -> m Int32
getGeometryBaseHeight s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 20) :: IO Int32
    return val

setGeometryBaseHeight :: MonadIO m => Geometry -> Int32 -> m ()
setGeometryBaseHeight s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 20) (val :: Int32)

data GeometryBaseHeightFieldInfo
instance AttrInfo GeometryBaseHeightFieldInfo where
    type AttrAllowedOps GeometryBaseHeightFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GeometryBaseHeightFieldInfo = (~) Int32
    type AttrBaseTypeConstraint GeometryBaseHeightFieldInfo = (~) Geometry
    type AttrGetType GeometryBaseHeightFieldInfo = Int32
    type AttrLabel GeometryBaseHeightFieldInfo = "base_height"
    type AttrOrigin GeometryBaseHeightFieldInfo = Geometry
    attrGet _ = getGeometryBaseHeight
    attrSet _ = setGeometryBaseHeight
    attrConstruct = undefined
    attrClear _ = undefined

geometry_baseHeight :: AttrLabelProxy "baseHeight"
geometry_baseHeight = AttrLabelProxy


getGeometryWidthInc :: MonadIO m => Geometry -> m Int32
getGeometryWidthInc s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO Int32
    return val

setGeometryWidthInc :: MonadIO m => Geometry -> Int32 -> m ()
setGeometryWidthInc s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (val :: Int32)

data GeometryWidthIncFieldInfo
instance AttrInfo GeometryWidthIncFieldInfo where
    type AttrAllowedOps GeometryWidthIncFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GeometryWidthIncFieldInfo = (~) Int32
    type AttrBaseTypeConstraint GeometryWidthIncFieldInfo = (~) Geometry
    type AttrGetType GeometryWidthIncFieldInfo = Int32
    type AttrLabel GeometryWidthIncFieldInfo = "width_inc"
    type AttrOrigin GeometryWidthIncFieldInfo = Geometry
    attrGet _ = getGeometryWidthInc
    attrSet _ = setGeometryWidthInc
    attrConstruct = undefined
    attrClear _ = undefined

geometry_widthInc :: AttrLabelProxy "widthInc"
geometry_widthInc = AttrLabelProxy


getGeometryHeightInc :: MonadIO m => Geometry -> m Int32
getGeometryHeightInc s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 28) :: IO Int32
    return val

setGeometryHeightInc :: MonadIO m => Geometry -> Int32 -> m ()
setGeometryHeightInc s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 28) (val :: Int32)

data GeometryHeightIncFieldInfo
instance AttrInfo GeometryHeightIncFieldInfo where
    type AttrAllowedOps GeometryHeightIncFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GeometryHeightIncFieldInfo = (~) Int32
    type AttrBaseTypeConstraint GeometryHeightIncFieldInfo = (~) Geometry
    type AttrGetType GeometryHeightIncFieldInfo = Int32
    type AttrLabel GeometryHeightIncFieldInfo = "height_inc"
    type AttrOrigin GeometryHeightIncFieldInfo = Geometry
    attrGet _ = getGeometryHeightInc
    attrSet _ = setGeometryHeightInc
    attrConstruct = undefined
    attrClear _ = undefined

geometry_heightInc :: AttrLabelProxy "heightInc"
geometry_heightInc = AttrLabelProxy


getGeometryMinAspect :: MonadIO m => Geometry -> m Double
getGeometryMinAspect s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 32) :: IO CDouble
    let val' = realToFrac val
    return val'

setGeometryMinAspect :: MonadIO m => Geometry -> Double -> m ()
setGeometryMinAspect s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 32) (val' :: CDouble)

data GeometryMinAspectFieldInfo
instance AttrInfo GeometryMinAspectFieldInfo where
    type AttrAllowedOps GeometryMinAspectFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GeometryMinAspectFieldInfo = (~) Double
    type AttrBaseTypeConstraint GeometryMinAspectFieldInfo = (~) Geometry
    type AttrGetType GeometryMinAspectFieldInfo = Double
    type AttrLabel GeometryMinAspectFieldInfo = "min_aspect"
    type AttrOrigin GeometryMinAspectFieldInfo = Geometry
    attrGet _ = getGeometryMinAspect
    attrSet _ = setGeometryMinAspect
    attrConstruct = undefined
    attrClear _ = undefined

geometry_minAspect :: AttrLabelProxy "minAspect"
geometry_minAspect = AttrLabelProxy


getGeometryMaxAspect :: MonadIO m => Geometry -> m Double
getGeometryMaxAspect s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 40) :: IO CDouble
    let val' = realToFrac val
    return val'

setGeometryMaxAspect :: MonadIO m => Geometry -> Double -> m ()
setGeometryMaxAspect s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 40) (val' :: CDouble)

data GeometryMaxAspectFieldInfo
instance AttrInfo GeometryMaxAspectFieldInfo where
    type AttrAllowedOps GeometryMaxAspectFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GeometryMaxAspectFieldInfo = (~) Double
    type AttrBaseTypeConstraint GeometryMaxAspectFieldInfo = (~) Geometry
    type AttrGetType GeometryMaxAspectFieldInfo = Double
    type AttrLabel GeometryMaxAspectFieldInfo = "max_aspect"
    type AttrOrigin GeometryMaxAspectFieldInfo = Geometry
    attrGet _ = getGeometryMaxAspect
    attrSet _ = setGeometryMaxAspect
    attrConstruct = undefined
    attrClear _ = undefined

geometry_maxAspect :: AttrLabelProxy "maxAspect"
geometry_maxAspect = AttrLabelProxy


getGeometryWinGravity :: MonadIO m => Geometry -> m Gdk.Enums.Gravity
getGeometryWinGravity s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 48) :: IO CUInt
    let val' = (toEnum . fromIntegral) val
    return val'

setGeometryWinGravity :: MonadIO m => Geometry -> Gdk.Enums.Gravity -> m ()
setGeometryWinGravity s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 48) (val' :: CUInt)

data GeometryWinGravityFieldInfo
instance AttrInfo GeometryWinGravityFieldInfo where
    type AttrAllowedOps GeometryWinGravityFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint GeometryWinGravityFieldInfo = (~) Gdk.Enums.Gravity
    type AttrBaseTypeConstraint GeometryWinGravityFieldInfo = (~) Geometry
    type AttrGetType GeometryWinGravityFieldInfo = Gdk.Enums.Gravity
    type AttrLabel GeometryWinGravityFieldInfo = "win_gravity"
    type AttrOrigin GeometryWinGravityFieldInfo = Geometry
    attrGet _ = getGeometryWinGravity
    attrSet _ = setGeometryWinGravity
    attrConstruct = undefined
    attrClear _ = undefined

geometry_winGravity :: AttrLabelProxy "winGravity"
geometry_winGravity = AttrLabelProxy



instance O.HasAttributeList Geometry
type instance O.AttributeList Geometry = GeometryAttributeList
type GeometryAttributeList = ('[ '("minWidth", GeometryMinWidthFieldInfo), '("minHeight", GeometryMinHeightFieldInfo), '("maxWidth", GeometryMaxWidthFieldInfo), '("maxHeight", GeometryMaxHeightFieldInfo), '("baseWidth", GeometryBaseWidthFieldInfo), '("baseHeight", GeometryBaseHeightFieldInfo), '("widthInc", GeometryWidthIncFieldInfo), '("heightInc", GeometryHeightIncFieldInfo), '("minAspect", GeometryMinAspectFieldInfo), '("maxAspect", GeometryMaxAspectFieldInfo), '("winGravity", GeometryWinGravityFieldInfo)] :: [(Symbol, *)])

type family ResolveGeometryMethod (t :: Symbol) (o :: *) :: * where
    ResolveGeometryMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveGeometryMethod t Geometry, O.MethodInfo info Geometry p) => O.IsLabelProxy t (Geometry -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveGeometryMethod t Geometry, O.MethodInfo info Geometry p) => O.IsLabel t (Geometry -> p) where
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif