[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Pango Enums.chs,NONE,1.1 Markup.hs,NONE,1.1 Rendering.chs,NONE,1.1 Types.chs.pp,NONE,1.1

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Pango
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2454/gtk/Graphics/UI/Gtk/Pango

Added Files:
	Enums.chs Markup.hs Rendering.chs Types.chs.pp 
Log Message:
hierarchical namespace conversion


--- NEW FILE: Markup.hs ---
--  GIMP Toolkit (GTK) Markup
--
--  Author : Axel Simon
--          
--  Created: 5 June 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:31:27 $
--
--  Copyright (c) 1999..2002 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file 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 General Public License for more details.
--
-- |
--
-- This module defines some helper functions for generating texts with
-- embedded attributes.
--
-- TODO
--
-- * Add a numeric value to 'FontWeightDef'.
--
module Graphics.UI.Gtk.Pango.Markup (
  Markup,
  SpanAttribute(..),
  markSpan,
  Size(..)
  ) where

import Graphics.UI.Gtk.Pango.Types ( Language )
import qualified Graphics.UI.Gtk.Pango.Enums as Pango

-- | Define a synonym for text with embedded markup commands.
--
-- * Markup strings are just simple strings. But it's easier to tell if a
--   method expects text with or without markup.
--
type Markup = String

-- | These are all the attributes the 'markSpan' function can express.
--
data SpanAttribute
  -- | Choose a font by textual description.
  --
  -- * Takes a string to completely describe the font, example:
  -- @FontDescr@ \"Sans Italic 12\"
  = FontDescr   String

  -- | Specify the family of font to use.
  --
  -- * Example: @FontFamily@ \"Sans\"
  | FontFamily	String

  -- | Change the size of the current font.
  --
  -- * The constuctor takes the size in points (pt) or a predefined
  --   sizes. Setting the absolute size 12.5pt can be achieved by passing
  --   'FontSize' ('SizePoint' 12.5) to 'markSpan'. Next to predefined
  --   absolute sizes such as 'SizeSmall' the size can be changed by 
  --   asking for the next larger or smaller front with
  --   'SizeLarger' and 'SizeSmaller', respectively.
  | FontSize Size

  -- | Change the slant of the current font.
  --
  | FontStyle Pango.FontStyle

  -- | Change the thickness of the current font.
  --
  -- * The constructor takes one of the six predefined weights. Most likely to
  --   be supported: 'WeightBold'.
  --
  | FontWeight Pango.Weight

  -- | Choosing an alternative rendering for lower case letters.
  --
  -- * The argument 'VariangtSmallCaps' will display lower case letters
  --   as smaller upper case letters, if this option is available.
  | FontVariant Pango.Variant

  -- | Choose a different width.
  --
  -- * Takes one of nine font widths, e.g. 'WidthExpanded'.
  --
  | FontStretch Pango.Stretch

  -- | Foreground color.
  --
  -- * This constructor and 'FontBackground' take both a description
  --   of the color to be used for rendering.
  | FontForeground String	-- FIXME: should be ColorName from GDK or so

  -- | Background color.
  | FontBackground String

  -- | Specify underlining of text.
  --
  | FontUnderline Pango.Underline

  -- | Specify a vertical displacement.
  --
  -- * Takes the vertical displacement in em (the width of the \'m\' character
  --   in the current font).
  | FontRise	Double

  -- | Give a hint about the language to be displayed.
  --
  -- * This hint might help the system rendering a particular piece of text
  --   with different fonts that are more suitable for the given language.
  --
  | FontLang	Language

instance Show SpanAttribute where
  showsPrec _ (FontDescr str)    = showString " font_desc=".shows str
  showsPrec _ (FontFamily str)	 = showString " font_family=".shows str
  showsPrec _ (FontSize size)	 = showString " size=".shows size
  showsPrec _ (FontStyle style)  = showString " style=".shows style
  showsPrec _ (FontWeight w)	 = showString " weight=".shows w
  showsPrec _ (FontVariant v)	 = showString " variant=".shows v
  showsPrec _ (FontStretch s)	 = showString " stretch=".shows s
  showsPrec _ (FontForeground c) = showString " foreground=".shows c
  showsPrec _ (FontBackground c) = showString " background=".shows c
  showsPrec _ (FontUnderline u)	 = showString " underline=".shows u
  showsPrec _ (FontRise r)	 = showString " rise=".shows 
				   (show (round (r*10000)))
  showsPrec _ (FontLang l)	 = showString " lang=".shows l

-- | Create the most generic span attribute.
--
markSpan :: [SpanAttribute] -> String -> String
markSpan attrs text = showString "<span".
		      foldr (.) (showChar '>') (map shows attrs).
		      showString text.
		      showString "</span>" $ ""

-- | Define attributes for 'FontSize'.
--
data Size
  = SizePoint Double
  | SizeUnreadable
  | SizeTiny
  | SizeSmall
  | SizeMedium
  | SizeLarge
  | SizeHuge
  | SizeGiant
  | SizeSmaller
  | SizeLarger

instance Show Size where
  showsPrec _ (SizePoint v)        	= shows $ show (round (v*1000))
  showsPrec _ (SizeUnreadable)		= shows "xx-small"
  showsPrec _ (SizeTiny)		= shows "x-small"
  showsPrec _ (SizeSmall)		= shows "small"
  showsPrec _ (SizeMedium)		= shows "medium"
  showsPrec _ (SizeLarge)		= shows "large"
  showsPrec _ (SizeHuge)		= shows "x-large"
  showsPrec _ (SizeGiant)		= shows "xx-large"
  showsPrec _ (SizeSmaller)		= shows "smaller"
  showsPrec _ (SizeLarger)	  	= shows "larger"





--- NEW FILE: Enums.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Enumerations for Pango.
--
--  Author : Axel Simon
--          
--  Created: 12 September 2004
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:31:27 $
--
--  Copyright (c) 1999..2004 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file 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 General Public License for more details.
--
-- |
--
-- Enumerations for describing font characteristics.
--
module Graphics.UI.Gtk.Pango.Enums (
  FontStyle(..),
  Weight(..),
  Variant(..),
  Stretch(..),
  Underline(..)
  ) where

{# context lib="pango" prefix="pango" #}

-- | The style of a font.
--
-- * 'StyleOblique' is a slanted font like 'StyleItalic', 
--   but in a roman style.
--
{#enum Style as FontStyle {underscoreToCase}#}

instance Show FontStyle where
  showsPrec _ StyleNormal	   = shows "normal"
  showsPrec _ StyleOblique	   = shows "oblique"
  showsPrec _ StyleItalic	   = shows "italic"

-- | Define attributes for 'FontWeight'.
--
{#enum Weight {underscoreToCase}#}

instance Show Weight where
  showsPrec _ WeightUltralight	= shows "ultralight"
  showsPrec _ WeightLight	= shows "light"
  showsPrec _ WeightNormal	= shows "normal"
  showsPrec _ WeightBold	= shows "bold"
  showsPrec _ WeightUltrabold 	= shows "ultrabold"
  showsPrec _ WeightHeavy	= shows "heavy"

-- | The variant of a font.
--
-- * The 'VariantCmallCaps' is a version of a font where lower case
--   letters are shown as physically smaller upper case letters.
--
{#enum Variant {underscoreToCase}#}

instance Show Variant where
  showsPrec _ VariantNormal       = shows "normal"
  showsPrec _ VariantSmallCaps    = shows "smallcaps"

-- | Define how wide characters are.
--
{#enum Stretch {underscoreToCase}#}

instance Show Stretch where
  showsPrec _ StretchUltraCondensed	= shows "ultracondensed"
  showsPrec _ StretchExtraCondensed	= shows "extracondensed"
  showsPrec _ StretchCondensed		= shows "condensed"
  showsPrec _ StretchSemiCondensed	= shows "semicondensed"
  showsPrec _ StretchNormal		= shows "normal"
  showsPrec _ StretchSemiExpanded	= shows "semiexpanded"
  showsPrec _ StretchExpanded		= shows "expanded"
  showsPrec _ StretchExtraExpanded	= shows "extraexpanded"
  showsPrec _ StretchUltraExpanded	= shows "ultraexpanded"

-- | Define attributes for 'FontUnderline'.
--
{#enum Underline {underscoreToCase}#}

instance Show Underline where
  showsPrec _ UnderlineNone	= shows "none"
  showsPrec _ UnderlineSingle	= shows "single"
  showsPrec _ UnderlineDouble	= shows "double"
  showsPrec _ UnderlineLow	= shows "low"
  showsPrec _ UnderlineError	= shows "error"


--- NEW FILE: Types.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) - pango non-GObject types PangoTypes
--
--  Author : Axel Simon
--          
--  Created: 9 Feburary 2003
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:31:27 $
--
--  Copyright (c) 1999..2003 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file 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 General Public License for more details.
--
-- |
--
-- Define types used in Pango which are not derived from GObject.
--
module Graphics.UI.Gtk.Pango.Types (
  LayoutIter(LayoutIter),
  layout_iter_free,
  LayoutLine(LayoutLine),
  makeNewLayoutLine,
  FontDescription(FontDescription),
  makeNewFontDescription,
  Language(Language),
  emptyLanguage,
  languageFromString
  ) where

import Monad    (liftM)

import System.Glib.FFI
import System.Glib.UTFString

{# context lib="pango" prefix="pango" #}

-- entry PangoLayout

-- | An iterator to examine a layout.
--
{#pointer *PangoLayoutIter as LayoutIter foreign newtype #}


#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&pango_layout_iter_free"
  layout_iter_free' :: FinalizerPtr LayoutIter

layout_iter_free :: Ptr LayoutIter -> FinalizerPtr LayoutIter
layout_iter_free _ = layout_iter_free'

#elif __GLASGOW_HASKELL__>=504

foreign import ccall unsafe "pango_layout_iter_free"
  layout_iter_free :: Ptr LayoutIter -> IO ()

#else

foreign import ccall "pango_layout_iter_free" unsafe
  layout_iter_free :: Ptr LayoutIter -> IO ()

#endif

-- | A single line in a 'PangoLayout'.
--
{#pointer *PangoLayoutLine as LayoutLine foreign newtype #}

makeNewLayoutLine :: Ptr LayoutLine -> IO LayoutLine
makeNewLayoutLine llPtr = do
  liftM LayoutLine $ newForeignPtr llPtr (pango_layout_line_unref llPtr)


#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&pango_layout_line_unref"
  pango_layout_line_unref' :: FinalizerPtr LayoutLine

pango_layout_line_unref :: Ptr LayoutLine -> FinalizerPtr LayoutLine
pango_layout_line_unref _ = pango_layout_line_unref'

#elif __GLASGOW_HASKELL__>=504

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

#else

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

#endif

#if __GLASGOW_HASKELL__>=504

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

#else

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

#endif


-- | A possibly partial description of font(s).
--
{#pointer *PangoFontDescription as FontDescription foreign newtype #}

makeNewFontDescription :: Ptr FontDescription -> IO FontDescription
makeNewFontDescription llPtr = do
  liftM FontDescription $ newForeignPtr llPtr
	    (pango_font_description_free llPtr)

#if __GLASGOW_HASKELL__>=600

foreign import ccall unsafe "&pango_font_description_free"
  pango_font_description_free' :: FinalizerPtr FontDescription

pango_font_description_free :: Ptr FontDescription -> 
				FinalizerPtr FontDescription
pango_font_description_free _ = pango_font_description_free'

#elif __GLASGOW_HASKELL__>=504

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

#else

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

#endif

-- | A Language designator to choose fonts.
--
{#pointer* Language newtype#} deriving Eq

instance Show Language where
  show (Language ptr)
    | ptr==nullPtr = ""
    | otherwise = unsafePerformIO $ peekUTFString (castPtr ptr)

-- | Specifying no particular language.
emptyLanguage = Language nullPtr

languageFromString :: String -> IO Language
languageFromString language = liftM Language $
  withUTFString language {#call language_from_string#}

--- NEW FILE: Rendering.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) - text layout functions Rendering
--
--  Author : Axel Simon
--          
--  Created: 8 Feburary 2003
--
--  Version $Revision: 1.1 $ from $Date: 2005/01/08 15:31:27 $
--
--  Copyright (c) 1999..2003 Axel Simon
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file 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 General Public License for more details.
--
-- |
--
-- Functions to run the rendering pipeline.
--
-- * The Pango rendering pipeline takes a string of Unicode characters
--   and converts it into glyphs.  The functions described in this module
--   accomplish various steps of this process.
--
module Graphics.UI.Gtk.Pango.Rendering (
  PangoContext,
  contextListFamilies,
--  contextLoadFont,
--  contextLoadFontSet,
  contextGetMetrics,
  FontMetrics(..),
  contextSetFontDescription,
  contextGetFontDescription,
  contextSetLanguage,
  contextGetLanguage,
  contextSetTextDir,
  contextGetTextDir,
  TextDirection(..)
  ) where

import Monad    (liftM)
import Data.Ratio

import System.Glib.FFI
import Graphics.UI.Gtk.General.Structs  (pangoScale)
{#import Graphics.UI.Gtk.Types#}
import System.Glib.GObject  (makeNewGObject)
import Graphics.UI.Gtk.General.Enums
{#import Graphics.UI.Gtk.Pango.Types#}

{# context lib="pango" prefix="pango" #}


-- | Retrieve a list of all available font families.
--
-- * A font family is the name of the font without further attributes
--   like slant, variant or size.
--
contextListFamilies :: PangoContext -> IO [FontFamily]
contextListFamilies c = alloca $ \sizePtr -> alloca $ \ptrPtr -> do
  {#call unsafe context_list_families#} c ptrPtr sizePtr
  ptr <- peek ptrPtr
  size <- peek sizePtr
  -- c2hs get FontFamily*** wrong as FontFamily**, therefore the cast
  familyPtrs <- peekArray (fromIntegral size) (castPtr ptr)
  fams <- mapM (makeNewGObject mkFontFamily . return) familyPtrs
  {#call unsafe g_free#} (castPtr ptr)
  return fams

-- | Load a font.
--
--contextLoadFont :: PangoContext -> FontDescription -> Language ->
--		   IO (Maybe Font)
--contextLoadFont pc fd l = do
--  fsPtr <- {#call context_load_font#} pc fd l
--  if fsPtr==nullPtr then return Nothing else
--    liftM Just $ makeNewGObject mkFont (return fsPtr)

-- | Load a font set.
--
--contextLoadFontSet :: PangoContext -> FontDescription -> Language ->
--		      IO (Maybe FontSet)
--contextLoadFontSet pc fd l = do
--  fsPtr <- {#call context_load_fontset#} pc fd l
--  if fsPtr==nullPtr then return Nothing else
--    liftM Just $ makeNewGObject mkFontSet (return fsPtr)

-- | Query the metrics of the given font implied by the font description.
--
contextGetMetrics :: PangoContext -> FontDescription -> Language ->
		     IO FontMetrics
contextGetMetrics pc fd l = do
  mPtr <- {#call unsafe context_get_metrics#} pc fd l
  ascend <- liftM fromIntegral $ {#call unsafe font_metrics_get_ascent#} mPtr
  descend <- liftM fromIntegral $ {#call unsafe font_metrics_get_descent#} mPtr
  cWidth <- liftM fromIntegral $
	    {#call unsafe font_metrics_get_approximate_char_width#} mPtr
  dWidth <- liftM fromIntegral $
	    {#call unsafe font_metrics_get_approximate_digit_width#} mPtr
  {#call unsafe font_metrics_unref#} mPtr
  return (FontMetrics
	  (ascend % pangoScale)
	  (descend % pangoScale)
	  (cWidth % pangoScale)
	  (dWidth % pangoScale))

-- | The characteristic measurements of a font.
--
-- * All values are measured in pixels.
--
data FontMetrics = FontMetrics {
  -- | The ascent is the distance from the baseline to the logical top
  --   of a line of text. (The logical top may be above or below the
  --   top of the actual drawn ink. It is necessary to lay out the
  --   text to figure where the ink will be.)
  ascent :: Rational,
  -- | The descent is the distance from the baseline to the logical
  --   bottom of a line of text. (The logical bottom may be above or
  --   below the bottom of the actual drawn ink. It is necessary to
  --   lay out the text to figure where the ink will be.)
  descent :: Rational,
  -- | The approximate character width. This is merely a
  --   representative value useful, for example, for determining the
  --   initial size for a window. Actual characters in text will be
  --   wider and narrower than this.
  approximateCharWidth :: Rational,
  -- | The approximate digit widt. This is merely a representative
  --   value useful, for example, for determining the initial size for
  --   a window. Actual digits in text can be wider and narrower than
  --   this, though this value is generally somewhat more accurate
  --   than @approximateCharWidth@.
  approximateDigitWidth :: Rational
}

-- | Set the default 'FontDescription' of this context.
--
contextSetFontDescription :: PangoContext -> FontDescription -> IO ()
contextSetFontDescription pc fd =
  {#call unsafe context_set_font_description#} pc fd

-- | Get the current 'FontDescription' of this context.
--
contextGetFontDescription :: PangoContext -> IO FontDescription
contextGetFontDescription pc = do
  fdPtrConst <- {#call unsafe context_get_font_description#} pc
  fdPtr <- pango_font_description_copy fdPtrConst
  makeNewFontDescription fdPtr

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

-- | Set the default 'Language' of this context.
--
contextSetLanguage :: PangoContext -> Language -> IO ()
contextSetLanguage = {#call unsafe context_set_language#}

-- | Get the current 'Language' of this context.
--
contextGetLanguage :: PangoContext -> IO Language
contextGetLanguage pc = liftM Language $
			{#call unsafe context_get_language#} pc

-- only used internally
{#enum PangoDirection {underscoreToCase} #}

-- | Set the default text direction of this context.
--
contextSetTextDir :: PangoContext -> TextDirection -> IO ()
contextSetTextDir pc dir =
  {#call unsafe context_set_base_dir#} pc (convert dir)
  where
    convert TextDirNone = fromIntegral (fromEnum DirectionNeutral)
    convert TextDirLtr = fromIntegral (fromEnum DirectionLtr)
    convert TextDirRtl = fromIntegral (fromEnum DirectionRtl)

-- | Get the current text direction of this context.
--
contextGetTextDir :: PangoContext -> IO TextDirection
contextGetTextDir pc = liftM (convert . toEnum . fromIntegral) $
		       {#call unsafe context_get_base_dir#} pc
  where
  convert DirectionLtr = TextDirLtr
  convert DirectionRtl = TextDirRtl
  convert _ = TextDirNone