{-# LINE 2 "./Graphics/UI/Gtk/Layout/AspectFrame.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget AspectFrame
--
-- Author : Axel Simon
--
-- Created: 15 May 2001
--
-- Copyright (C) 1999-2005 Axel Simon
--
-- 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 frame that constrains its child to a particular aspect ratio
--
module Graphics.UI.Gtk.Layout.AspectFrame (
-- * Detail
--
-- | The 'AspectFrame' is useful when you want pack a widget so that it can
-- resize but always retains the same aspect ratio. For instance, one might be
-- drawing a small preview of a larger image. 'AspectFrame' derives from
-- 'Frame', so it can draw a label and a frame around the child. The frame will
-- be \"shrink-wrapped\" to the size of the child.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----'Container'
-- | +----'Bin'
-- | +----'Frame'
-- | +----AspectFrame
-- @

-- * Types
  AspectFrame,
  AspectFrameClass,
  castToAspectFrame, gTypeAspectFrame,
  toAspectFrame,

-- * Constructors
  aspectFrameNew,

-- * Methods
  aspectFrameSet,

-- * Attributes
  aspectFrameXAlign,
  aspectFrameYAlign,
  aspectFrameRatio,
  aspectFrameObeyChild,
  ) where

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

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


{-# LINE 78 "./Graphics/UI/Gtk/Layout/AspectFrame.chs" #-}

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

-- | Create a new 'AspectFrame'.
--
-- The frame may be augmented with a label which can be set by @frameSetLabel@.
--
aspectFrameNew ::
    Float -- ^ @xalign@ - Horizontal alignment of the child within
                   -- the allocation of the 'AspectFrame'. This ranges from 0.0
                   -- (left aligned) to 1.0 (right aligned)
 -> Float -- ^ @yalign@ - Vertical alignment of the child within the
                   -- allocation of the 'AspectFrame'. This ranges from 0.0
                   -- (left aligned) to 1.0 (right aligned)
 -> Maybe Float -- ^ @ratio@ - The desired aspect ratio. If @Nothing@ the
                   -- aspect ratio is taken from the requistion of the child.
 -> IO AspectFrame
aspectFrameNew :: Float -> Float -> Maybe Float -> IO AspectFrame
aspectFrameNew Float
xalign Float
yalign Maybe Float
ratio =
  (ForeignPtr AspectFrame -> AspectFrame, FinalizerPtr AspectFrame)
-> IO (Ptr AspectFrame) -> IO AspectFrame
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr AspectFrame -> AspectFrame, FinalizerPtr AspectFrame)
forall {a}. (ForeignPtr AspectFrame -> AspectFrame, FinalizerPtr a)
mkAspectFrame (IO (Ptr AspectFrame) -> IO AspectFrame)
-> IO (Ptr AspectFrame) -> IO AspectFrame
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr AspectFrame)
-> IO (Ptr Widget) -> IO (Ptr AspectFrame)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr AspectFrame
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr AspectFrame) (IO (Ptr Widget) -> IO (Ptr AspectFrame))
-> IO (Ptr Widget) -> IO (Ptr AspectFrame)
forall a b. (a -> b) -> a -> b
$
  Ptr CChar -> CFloat -> CFloat -> CFloat -> CInt -> IO (Ptr Widget)
gtk_aspect_frame_new
{-# LINE 100 "./Graphics/UI/Gtk/Layout/AspectFrame.chs" #-}
    nullPtr
    (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
xalign)
    (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
yalign)
    (CFloat -> (Float -> CFloat) -> Maybe Float -> CFloat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CFloat
0.0 Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Maybe Float
ratio)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool (Bool -> CInt) -> Bool -> CInt
forall a b. (a -> b) -> a -> b
$ Maybe Float -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Float
ratio)

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

-- | Set parameters for an existing 'AspectFrame'.
--
aspectFrameSet :: AspectFrameClass self => self
 -> Float -- ^ @xalign@ - Horizontal alignment of the child within the
          -- allocation of the 'AspectFrame'. This ranges from 0.0 (left
          -- aligned) to 1.0 (right aligned)
 -> Float -- ^ @yalign@ - Vertical alignment of the child within the
          -- allocation of the 'AspectFrame'. This ranges from 0.0 (left
          -- aligned) to 1.0 (right aligned)
 -> Maybe Float -- ^ @ratio@ - The desired aspect ratio. If @Nothing@ the
                -- aspect ratio is taken from the requistion of the child.
 -> IO ()
aspectFrameSet :: forall self.
AspectFrameClass self =>
self -> Float -> Float -> Maybe Float -> IO ()
aspectFrameSet self
self Float
xalign Float
yalign Maybe Float
ratio =
  (\(AspectFrame ForeignPtr AspectFrame
arg1) CFloat
arg2 CFloat
arg3 CFloat
arg4 CInt
arg5 -> ForeignPtr AspectFrame -> (Ptr AspectFrame -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr AspectFrame
arg1 ((Ptr AspectFrame -> IO ()) -> IO ())
-> (Ptr AspectFrame -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AspectFrame
argPtr1 ->Ptr AspectFrame -> CFloat -> CFloat -> CFloat -> CInt -> IO ()
gtk_aspect_frame_set Ptr AspectFrame
argPtr1 CFloat
arg2 CFloat
arg3 CFloat
arg4 CInt
arg5)
{-# LINE 123 "./Graphics/UI/Gtk/Layout/AspectFrame.chs" #-}
    (toAspectFrame self)
    (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
xalign)
    (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
yalign)
    (CFloat -> (Float -> CFloat) -> Maybe Float -> CFloat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CFloat
0.0 Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Maybe Float
ratio)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool (Bool -> CInt) -> Bool -> CInt
forall a b. (a -> b) -> a -> b
$ Maybe Float -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Float
ratio)

--------------------
-- Attributes

-- | X alignment of the child.
--
-- Allowed values: [0,1]
--
-- Default value: 0.5
--
aspectFrameXAlign :: AspectFrameClass self => Attr self Float
aspectFrameXAlign :: forall self. AspectFrameClass self => Attr self Float
aspectFrameXAlign = String -> Attr self Float
forall gobj. GObjectClass gobj => String -> Attr gobj Float
newAttrFromFloatProperty String
"xalign"

-- | Y alignment of the child.
--
-- Allowed values: [0,1]
--
-- Default value: 0.5
--
aspectFrameYAlign :: AspectFrameClass self => Attr self Float
aspectFrameYAlign :: forall self. AspectFrameClass self => Attr self Float
aspectFrameYAlign = String -> Attr self Float
forall gobj. GObjectClass gobj => String -> Attr gobj Float
newAttrFromFloatProperty String
"yalign"

-- | Aspect ratio if obey_child is @False@.
--
-- Allowed values: [1e-04,10000]
--
-- Default value: 0.5
--
aspectFrameRatio :: AspectFrameClass self => Attr self Float
aspectFrameRatio :: forall self. AspectFrameClass self => Attr self Float
aspectFrameRatio = String -> Attr self Float
forall gobj. GObjectClass gobj => String -> Attr gobj Float
newAttrFromFloatProperty String
"ratio"

-- | Force aspect ratio to match that of the frame's child.
--
-- Default value: @True@
--
aspectFrameObeyChild :: AspectFrameClass self => Attr self Bool
aspectFrameObeyChild :: forall self. AspectFrameClass self => Attr self Bool
aspectFrameObeyChild = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"obey-child"

foreign import ccall unsafe "gtk_aspect_frame_new"
  gtk_aspect_frame_new :: ((Ptr CChar) -> (CFloat -> (CFloat -> (CFloat -> (CInt -> (IO (Ptr Widget)))))))

foreign import ccall safe "gtk_aspect_frame_set"
  gtk_aspect_frame_set :: ((Ptr AspectFrame) -> (CFloat -> (CFloat -> (CFloat -> (CInt -> (IO ()))))))