-- GENERATED by C->Haskell Compiler, version 0.13.4 (gtk2hs branch) "Bin IO", 13 Nov 2004 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Graphics/Rendering/Pango/Description.chs" #-}
{-# OPTIONS_HADDOCK hide #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) - text layout functions: Font Descriptions
--
--  Author : Axel Simon
--
--  Created: 8 Feburary 2003
--
--  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.
--
-- #hide

-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Functions to manage font descriptions.
--
-- * Font descriptions provide a way to query and state requirements on
--   fonts. This data structure has several fields describing different
--   characteristics of a font. Each of these fields can be set of left
--   unspecified.
--
module Graphics.Rendering.Pango.Description (
  FontDescription,
  fontDescriptionNew,
  fontDescriptionCopy,
  fontDescriptionSetFamily,
  fontDescriptionGetFamily,
  fontDescriptionSetStyle,
  fontDescriptionGetStyle,
  fontDescriptionSetVariant,
  fontDescriptionGetVariant,
  fontDescriptionSetWeight,
  fontDescriptionGetWeight,
  fontDescriptionSetStretch,
  fontDescriptionGetStretch,
  fontDescriptionSetSize,
  fontDescriptionGetSize,
  FontMask(..),
  fontDescriptionUnsetFields,
  fontDescriptionMerge,
  fontDescriptionBetterMatch,
  fontDescriptionFromString,
  fontDescriptionToString
  ) where

import Control.Monad    (liftM)

import System.Glib.FFI
import System.Glib.Flags		(Flags, fromFlags)
import System.Glib.UTFString
import Graphics.Rendering.Pango.Types
{-# LINE 64 "./Graphics/Rendering/Pango/Description.chs" #-}
import Graphics.Rendering.Pango.Enums
{-# LINE 65 "./Graphics/Rendering/Pango/Description.chs" #-}
import Graphics.Rendering.Pango.Structs ( puToInt, intToPu )
import Graphics.Rendering.Pango.BasicTypes


{-# LINE 69 "./Graphics/Rendering/Pango/Description.chs" #-}

-- | Create a new font description.
--
-- * All field are unset.
--
fontDescriptionNew :: IO FontDescription
fontDescriptionNew = pango_font_description_new >>= makeNewFontDescription 

-- | Make a deep copy of a font description.
--
fontDescriptionCopy :: FontDescription -> IO FontDescription
fontDescriptionCopy fd = (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_copy argPtr1) fd >>= makeNewFontDescription 

-- | Set the font famliy.
--
-- * A font family is a name designating the design of the font (e.g. Sans
--   or Times) without the variant.
--
-- * In some contexts a comma separated list of font families can be used.
--
fontDescriptionSetFamily :: FontDescription -> String -> IO ()
fontDescriptionSetFamily fd family = withUTFString family $ \strPtr ->
  (\(FontDescription arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_set_family argPtr1 arg2) fd strPtr

-- | Get the font family.
--
-- * 'Nothing' is returned if the font family is not set.
--
fontDescriptionGetFamily :: FontDescription -> IO (Maybe String)
fontDescriptionGetFamily fd = do
  strPtr <- (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_family argPtr1) fd
  if strPtr==nullPtr then return Nothing else
    liftM Just $ peekUTFString strPtr

-- | Flags denoting which fields in a font description are set.
data FontMask = PangoFontMaskFamily
              | PangoFontMaskStyle
              | PangoFontMaskVariant
              | PangoFontMaskWeight
              | PangoFontMaskStretch
              | PangoFontMaskSize
              | PangoFontMaskGravity
              deriving (Bounded)
instance Enum FontMask where
  fromEnum PangoFontMaskFamily = 1
  fromEnum PangoFontMaskStyle = 2
  fromEnum PangoFontMaskVariant = 4
  fromEnum PangoFontMaskWeight = 8
  fromEnum PangoFontMaskStretch = 16
  fromEnum PangoFontMaskSize = 32
  fromEnum PangoFontMaskGravity = 64

  toEnum 1 = PangoFontMaskFamily
  toEnum 2 = PangoFontMaskStyle
  toEnum 4 = PangoFontMaskVariant
  toEnum 8 = PangoFontMaskWeight
  toEnum 16 = PangoFontMaskStretch
  toEnum 32 = PangoFontMaskSize
  toEnum 64 = PangoFontMaskGravity
  toEnum unmatched = error ("FontMask.toEnum: Cannot match " ++ show unmatched)

  succ PangoFontMaskFamily = PangoFontMaskStyle
  succ PangoFontMaskStyle = PangoFontMaskVariant
  succ PangoFontMaskVariant = PangoFontMaskWeight
  succ PangoFontMaskWeight = PangoFontMaskStretch
  succ PangoFontMaskStretch = PangoFontMaskSize
  succ PangoFontMaskSize = PangoFontMaskGravity
  succ _ = undefined

  pred PangoFontMaskStyle = PangoFontMaskFamily
  pred PangoFontMaskVariant = PangoFontMaskStyle
  pred PangoFontMaskWeight = PangoFontMaskVariant
  pred PangoFontMaskStretch = PangoFontMaskWeight
  pred PangoFontMaskSize = PangoFontMaskStretch
  pred PangoFontMaskGravity = PangoFontMaskSize
  pred _ = undefined

  enumFromTo x y | fromEnum x == fromEnum y = [ y ]
                 | otherwise = x : enumFromTo (succ x) y
  enumFrom x = enumFromTo x PangoFontMaskGravity
  enumFromThen _ _ =     error "Enum FontMask: enumFromThen not implemented"
  enumFromThenTo _ _ _ =     error "Enum FontMask: enumFromThenTo not implemented"

{-# LINE 105 "./Graphics/Rendering/Pango/Description.chs" #-}

instance Flags FontMask

-- | Set the style field.
--
-- * Most fonts will have either a 'StyleItalic' or 'StyleOblique'
--   but rarely both.
--
fontDescriptionSetStyle :: FontDescription -> FontStyle -> IO ()
fontDescriptionSetStyle fd p =
    (\(FontDescription arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_set_style argPtr1 arg2) fd (fromIntegral (fromEnum p))

-- | Get the style field.
fontDescriptionGetStyle :: FontDescription -> IO (Maybe FontStyle)
fontDescriptionGetStyle fd = do
  fields <- (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_set_fields argPtr1) fd
  if (fromEnum PangoFontMaskStyle) .&. (fromIntegral fields) /=0
     then liftM (Just . toEnum . fromIntegral) $
	      (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_style argPtr1) fd
     else return Nothing

-- | Set the variant field.
--
fontDescriptionSetVariant :: FontDescription -> Variant -> IO ()
fontDescriptionSetVariant fd p =
    (\(FontDescription arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_set_variant argPtr1 arg2) fd (fromIntegral (fromEnum p))

-- | Get the variant field.
fontDescriptionGetVariant :: FontDescription -> IO (Maybe Variant)
fontDescriptionGetVariant fd = do
  fields <- (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_set_fields argPtr1) fd
  if (fromEnum PangoFontMaskVariant) .&. (fromIntegral fields) /=0
     then liftM (Just . toEnum . fromIntegral) $
	      (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_variant argPtr1) fd
     else return Nothing

-- | Set the weight field.
--
fontDescriptionSetWeight :: FontDescription -> Weight -> IO ()
fontDescriptionSetWeight fd p =
  (\(FontDescription arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_set_weight argPtr1 arg2) fd (fromIntegral (fromEnum p))

-- | Get the weight field.
fontDescriptionGetWeight :: FontDescription -> IO (Maybe Weight)
fontDescriptionGetWeight fd = do
  fields <- (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_set_fields argPtr1) fd
  if (fromEnum PangoFontMaskWeight) .&. (fromIntegral fields) /=0
     then liftM (Just . toEnum . fromIntegral) $
	      (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_weight argPtr1) fd
     else return Nothing

-- | Set the stretch field.
--
fontDescriptionSetStretch :: FontDescription -> Stretch -> IO ()
fontDescriptionSetStretch fd p =
  (\(FontDescription arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_set_stretch argPtr1 arg2) fd (fromIntegral (fromEnum p))

-- | Get the stretch field.
fontDescriptionGetStretch :: FontDescription -> IO (Maybe Stretch)
fontDescriptionGetStretch fd = do
  fields <- (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_set_fields argPtr1) fd
  if (fromEnum PangoFontMaskStretch) .&. (fromIntegral fields) /=0
     then liftM (Just . toEnum . fromIntegral) $ 
	      (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_stretch argPtr1) fd
     else return Nothing

-- | Set the size field.
--
-- * The given size is in points (pts). One point is 1\/72 inch.
--
fontDescriptionSetSize :: FontDescription -> Double -> IO ()
fontDescriptionSetSize fd p = 
  (\(FontDescription arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_set_size argPtr1 arg2) fd (puToInt p)

-- | Get the size field.
fontDescriptionGetSize :: FontDescription -> IO (Maybe Double)
fontDescriptionGetSize fd = do
  fields <- (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_set_fields argPtr1) fd
  if (fromEnum PangoFontMaskSize) .&. (fromIntegral fields) /=0
     then liftM (\x -> Just (intToPu x)) $ 
	      (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_get_size argPtr1) fd
     else return Nothing

-- | Reset fields in a font description.
--
fontDescriptionUnsetFields :: FontDescription -> [FontMask] -> IO ()
fontDescriptionUnsetFields fd mask =
  (\(FontDescription arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_unset_fields argPtr1 arg2) fd (fromIntegral (fromFlags mask))

-- | Merge two font descriptions.
--
-- * Copy fields from the second description to the first. If the boolean
--   parameter is set, existing fields in the first description will be
--   replaced.
--
fontDescriptionMerge :: FontDescription -> FontDescription -> Bool -> IO ()
fontDescriptionMerge fd1 fd2 replace =
  (\(FontDescription arg1) (FontDescription arg2) arg3 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->pango_font_description_merge argPtr1 argPtr2 arg3) fd1 fd2 (fromBool replace)

-- | Determine if two descriptions are simliar.
--
-- * Returns 'True' if the two descriptions only differ in weight or style.
--
fontDescriptionIsMatch :: FontDescription -> FontDescription -> Bool
fontDescriptionIsMatch fdA fdB = unsafePerformIO $ liftM toBool $
  (\(FontDescription arg1) (FontDescription arg2) (FontDescription arg3) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->withForeignPtr arg3 $ \argPtr3 ->pango_font_description_better_match argPtr1 argPtr2 argPtr3) fdA (FontDescription nullForeignPtr) fdB

-- | Determine which of two descriptions matches a given description better.
--
-- * Returns @True@ if the last description is a better match to the first
--   arguement than the middle one.
--
-- * Approximate matching is done on weight and style. If the other
--   attributes do not match, the function returns @False@.
--
fontDescriptionBetterMatch :: FontDescription -> FontDescription -> 
			      FontDescription -> Bool
fontDescriptionBetterMatch fd fdA fdB = unsafePerformIO $ liftM toBool $
  (\(FontDescription arg1) (FontDescription arg2) (FontDescription arg3) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->withForeignPtr arg3 $ \argPtr3 ->pango_font_description_better_match argPtr1 argPtr2 argPtr3) fd fdA fdB

-- | Create a font description from a string.
--
-- * The given argument must have the form 
--   @[FAMILY-LIST] [STYLE-OPTIONS] [SIZE]@ where @FAMILY_LIST@ is a comma
--   separated list of font families optionally terminated by a comma,
--   @STYLE_OPTIONS@ is a whitespace separated list of words where each
--   word describes one of style, variant, weight or stretch. @SIZE@ is
--   a decimal number giving the size of the font in points. If any of
--   these fields is absent, the resulting 'FontDescription' will have
--   the corresponing fields unset.
--
fontDescriptionFromString :: String -> IO FontDescription
fontDescriptionFromString descr = withUTFString descr $ \strPtr ->
  pango_font_description_from_string strPtr >>= makeNewFontDescription

-- | Convert a font description to a string.
--
-- * Creates a string representation of a font description. See
--   'fontDescriptionFromString' for the format of the string.
--
fontDescriptionToString :: FontDescription -> IO String
fontDescriptionToString fd = do
  strPtr <- (\(FontDescription arg1) -> withForeignPtr arg1 $ \argPtr1 ->pango_font_description_to_string argPtr1) fd
  str <- peekUTFString strPtr
  g_free (castPtr strPtr)
  return str




foreign import ccall unsafe "pango_font_description_new"
  pango_font_description_new :: (IO (Ptr FontDescription))

foreign import ccall unsafe "pango_font_description_copy"
  pango_font_description_copy :: ((Ptr FontDescription) -> (IO (Ptr FontDescription)))

foreign import ccall unsafe "pango_font_description_set_family"
  pango_font_description_set_family :: ((Ptr FontDescription) -> ((Ptr CChar) -> (IO ())))

foreign import ccall unsafe "pango_font_description_get_family"
  pango_font_description_get_family :: ((Ptr FontDescription) -> (IO (Ptr CChar)))

foreign import ccall unsafe "pango_font_description_set_style"
  pango_font_description_set_style :: ((Ptr FontDescription) -> (CInt -> (IO ())))

foreign import ccall unsafe "pango_font_description_get_set_fields"
  pango_font_description_get_set_fields :: ((Ptr FontDescription) -> (IO CInt))

foreign import ccall unsafe "pango_font_description_get_style"
  pango_font_description_get_style :: ((Ptr FontDescription) -> (IO CInt))

foreign import ccall unsafe "pango_font_description_set_variant"
  pango_font_description_set_variant :: ((Ptr FontDescription) -> (CInt -> (IO ())))

foreign import ccall unsafe "pango_font_description_get_variant"
  pango_font_description_get_variant :: ((Ptr FontDescription) -> (IO CInt))

foreign import ccall unsafe "pango_font_description_set_weight"
  pango_font_description_set_weight :: ((Ptr FontDescription) -> (CInt -> (IO ())))

foreign import ccall unsafe "pango_font_description_get_weight"
  pango_font_description_get_weight :: ((Ptr FontDescription) -> (IO CInt))

foreign import ccall unsafe "pango_font_description_set_stretch"
  pango_font_description_set_stretch :: ((Ptr FontDescription) -> (CInt -> (IO ())))

foreign import ccall unsafe "pango_font_description_get_stretch"
  pango_font_description_get_stretch :: ((Ptr FontDescription) -> (IO CInt))

foreign import ccall unsafe "pango_font_description_set_size"
  pango_font_description_set_size :: ((Ptr FontDescription) -> (CInt -> (IO ())))

foreign import ccall unsafe "pango_font_description_get_size"
  pango_font_description_get_size :: ((Ptr FontDescription) -> (IO CInt))

foreign import ccall unsafe "pango_font_description_unset_fields"
  pango_font_description_unset_fields :: ((Ptr FontDescription) -> (CInt -> (IO ())))

foreign import ccall unsafe "pango_font_description_merge"
  pango_font_description_merge :: ((Ptr FontDescription) -> ((Ptr FontDescription) -> (CInt -> (IO ()))))

foreign import ccall unsafe "pango_font_description_better_match"
  pango_font_description_better_match :: ((Ptr FontDescription) -> ((Ptr FontDescription) -> ((Ptr FontDescription) -> (IO CInt))))

foreign import ccall unsafe "pango_font_description_from_string"
  pango_font_description_from_string :: ((Ptr CChar) -> (IO (Ptr FontDescription)))

foreign import ccall unsafe "pango_font_description_to_string"
  pango_font_description_to_string :: ((Ptr FontDescription) -> (IO (Ptr CChar)))

foreign import ccall unsafe "g_free"
  g_free :: ((Ptr ()) -> (IO ()))