{-# LINE 2 "./Graphics/UI/Gtk/Layout/Fixed.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Fixed
--
-- Author : Duncan Coutts
--
-- Created: 2 August 2004
--
-- Copyright (C) 2004-2005 Duncan Coutts
--
-- 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)
--
-- A container which allows you to position widgets at fixed coordinates
--
module Graphics.UI.Gtk.Layout.Fixed (
-- * Detail
--
-- | The 'Fixed' widget is a container which can place child widgets at fixed
-- positions and with fixed sizes, given in pixels. 'Fixed' performs no
-- automatic layout management.
--
-- For most applications, you should not use this container! It keeps you
-- from having to learn about the other Gtk+ containers, but it results in
-- broken applications. With 'Fixed', the following things will result in
-- truncated text, overlapping widgets, and other display bugs:
--
-- * Themes, which may change widget sizes.
--
-- * Fonts other than the one you used to write the app will of course
-- change the size of widgets containing text; keep in mind that users may use
-- a larger font because of difficulty reading the default, or they may be
-- using Windows or the framebuffer port of Gtk+, where different fonts are
-- available.
--
-- * Translation of text into other languages changes its size. Also,
-- display of non-English text will use a different font in many cases.
--
-- In addition, the fixed widget can't properly be mirrored in right-to-left
-- languages such as Hebrew and Arabic. i.e. normally Gtk+ will flip the
-- interface to put labels to the right of the thing they label, but it can't
-- do that with 'Fixed'. So your application will not be usable in
-- right-to-left languages.
--
-- Finally, fixed positioning makes it kind of annoying to add\/remove GUI
-- elements, since you have to reposition all the other elements. This is a
-- long-term maintenance problem for your application.
--
-- If you know none of these things are an issue for your application, and
-- prefer the simplicity of 'Fixed', by all means use the widget. But you
-- should be aware of the tradeoffs.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----'Container'
-- | +----Fixed
-- @

-- * Types
  Fixed,
  FixedClass,
  castToFixed, gTypeFixed,
  toFixed,

-- * Constructors
  fixedNew,

-- * Methods
  fixedPut,
  fixedMove,







-- * Child Attributes
  fixedChildX,
  fixedChildY,
  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.Attributes
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types
{-# LINE 105 "./Graphics/UI/Gtk/Layout/Fixed.chs" #-}
import Graphics.UI.Gtk.Abstract.ContainerChildProperties


{-# LINE 108 "./Graphics/UI/Gtk/Layout/Fixed.chs" #-}

--------------------
-- Constructors

-- | Creates a new 'Fixed'.
--
fixedNew :: IO Fixed
fixedNew :: IO Fixed
fixedNew =
  (ForeignPtr Fixed -> Fixed, FinalizerPtr Fixed)
-> IO (Ptr Fixed) -> IO Fixed
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Fixed -> Fixed, FinalizerPtr Fixed)
forall {a}. (ForeignPtr Fixed -> Fixed, FinalizerPtr a)
mkFixed (IO (Ptr Fixed) -> IO Fixed) -> IO (Ptr Fixed) -> IO Fixed
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Fixed) -> IO (Ptr Widget) -> IO (Ptr Fixed)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Fixed
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Fixed) (IO (Ptr Widget) -> IO (Ptr Fixed))
-> IO (Ptr Widget) -> IO (Ptr Fixed)
forall a b. (a -> b) -> a -> b
$
  IO (Ptr Widget)
gtk_fixed_new
{-# LINE 119 "./Graphics/UI/Gtk/Layout/Fixed.chs" #-}

--------------------
-- Methods

-- | Adds a widget to a 'Fixed' container at the given position.
--
fixedPut :: (FixedClass self, WidgetClass widget) => self
 -> widget -- ^ @widget@ - the widget to add.
 -> (Int, Int) -- ^ @(x,y)@ - the horizontal and vertical position to place
               -- the widget at.
 -> IO ()
fixedPut :: forall self widget.
(FixedClass self, WidgetClass widget) =>
self -> widget -> (Int, Int) -> IO ()
fixedPut self
self widget
widget (Int
x, Int
y) =
  (\(Fixed ForeignPtr Fixed
arg1) (Widget ForeignPtr Widget
arg2) CInt
arg3 CInt
arg4 -> ForeignPtr Fixed -> (Ptr Fixed -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Fixed
arg1 ((Ptr Fixed -> IO ()) -> IO ()) -> (Ptr Fixed -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Fixed
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Fixed -> Ptr Widget -> CInt -> CInt -> IO ()
gtk_fixed_put Ptr Fixed
argPtr1 Ptr Widget
argPtr2 CInt
arg3 CInt
arg4)
{-# LINE 132 "./Graphics/UI/Gtk/Layout/Fixed.chs" #-}
    (toFixed self)
    (widget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget widget
widget)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)

-- | Moves a child of a 'Fixed' container to the given position.
--
fixedMove :: (FixedClass self, WidgetClass widget) => self
 -> widget -- ^ @widget@ - the child widget.
 -> (Int, Int) -- ^ @(x,y)@ - the horizontal and vertical position to move the
               -- widget to.
 -> IO ()
fixedMove :: forall self widget.
(FixedClass self, WidgetClass widget) =>
self -> widget -> (Int, Int) -> IO ()
fixedMove self
self widget
widget (Int
x, Int
y) =
  (\(Fixed ForeignPtr Fixed
arg1) (Widget ForeignPtr Widget
arg2) CInt
arg3 CInt
arg4 -> ForeignPtr Fixed -> (Ptr Fixed -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Fixed
arg1 ((Ptr Fixed -> IO ()) -> IO ()) -> (Ptr Fixed -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Fixed
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Fixed -> Ptr Widget -> CInt -> CInt -> IO ()
gtk_fixed_move Ptr Fixed
argPtr1 Ptr Widget
argPtr2 CInt
arg3 CInt
arg4)
{-# LINE 146 "./Graphics/UI/Gtk/Layout/Fixed.chs" #-}
    (toFixed self)
    (widget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget widget
widget)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)
{-# LINE 188 "./Graphics/UI/Gtk/Layout/Fixed.chs" #-}
--------------------
-- Child Attributes

-- | X position of child widget.
--
-- Default value: 0
--
fixedChildX :: (FixedClass self, WidgetClass child) => child -> Attr self Int
fixedChildX :: forall self child.
(FixedClass self, WidgetClass child) =>
child -> Attr self Int
fixedChildX = String -> child -> Attr self Int
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> Attr container Int
newAttrFromContainerChildIntProperty String
"x"

-- | Y position of child widget.
--
-- Default value: 0
--
fixedChildY :: (FixedClass self, WidgetClass child) => child -> Attr self Int
fixedChildY :: forall self child.
(FixedClass self, WidgetClass child) =>
child -> Attr self Int
fixedChildY = String -> child -> Attr self Int
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> Attr container Int
newAttrFromContainerChildIntProperty String
"y"

foreign import ccall unsafe "gtk_fixed_new"
  gtk_fixed_new :: (IO (Ptr Widget))

foreign import ccall safe "gtk_fixed_put"
  gtk_fixed_put :: ((Ptr Fixed) -> ((Ptr Widget) -> (CInt -> (CInt -> (IO ())))))

foreign import ccall safe "gtk_fixed_move"
  gtk_fixed_move :: ((Ptr Fixed) -> ((Ptr Widget) -> (CInt -> (CInt -> (IO ())))))