From: Axel S. <as...@us...> - 2005-10-17 22:53:02
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Pango In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17557/gtk/Graphics/UI/Gtk/Pango Modified Files: Context.chs.pp Enums.chs.pp Font.chs Layout.chs.pp Rendering.chs.pp Types.chs.pp Log Message: /tmp/cvswg8NOK Index: Types.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Pango/Types.chs.pp,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- Types.chs.pp 16 Oct 2005 15:05:35 -0000 1.8 +++ Types.chs.pp 17 Oct 2005 22:52:50 -0000 1.9 @@ -45,6 +45,7 @@ makeNewPangoItemRaw, withPangoItemRaw, pangoItemGetFont, + pangoItemGetLanguage, GlyphItem(GlyphItem), GlyphStringRaw(GlyphStringRaw), @@ -66,7 +67,9 @@ makeNewFontDescription, Language(Language), emptyLanguage, - languageFromString + languageFromString, + + FontMetrics(..) ) where import Monad (liftM) @@ -77,7 +80,8 @@ import System.Glib.FFI import System.Glib.UTFString import Graphics.UI.Gtk.General.Structs ( pangoScale, Rectangle(..), - pangoItemRawGetFont ) + pangoItemRawGetFont, + pangoItemRawGetLanguage ) {#import Graphics.UI.Gtk.Types#} {# context lib="pango" prefix="pango" #} @@ -238,6 +242,12 @@ pangoItemGetFont (PangoItem _ (PangoItemRaw pir)) = withForeignPtr pir pangoItemRawGetFont +-- | Extract the 'Language' used for this 'PangoItem'. +-- +pangoItemGetLanguage :: PangoItem -> IO Language +pangoItemGetLanguage (PangoItem _ (PangoItemRaw pir)) = + liftM (Language . castPtr) $ withForeignPtr pir pangoItemRawGetLanguage + {#pointer *PangoGlyphItem as GlyphItemRaw #} -- With each GlyphString we pair a UTFCorrection @@ -372,7 +382,7 @@ #endif --- | A Language designator to choose fonts. +-- | An RFC-3066 language designator to choose scripts. -- {#pointer* Language newtype#} deriving Eq @@ -384,8 +394,60 @@ -- | Specifying no particular language. emptyLanguage = Language nullPtr +-- | Take a RFC-3066 format language tag as a string and convert it to a +-- 'Language' type that can be efficiently passed around and compared with +-- other language tags. +-- +-- * This function first canonicalizes the string by converting it to +-- lowercase, mapping \'_\' to \'-\', and stripping all characters +-- other than letters and \'-\'. +-- languageFromString :: String -> IO Language languageFromString language = liftM Language $ withUTFString language {#call language_from_string#} - +-- | The characteristic measurements of a font. +-- +-- * All values are measured in points, expressed as 'PangoUnit's. +-- +-- * The last four fields are only available in Pango 1.6 or higher. +-- +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 :: PangoUnit, + -- | 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 :: PangoUnit, + -- | 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 :: PangoUnit, + -- | The approximate digit width. 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 :: PangoUnit +#if PANGO_CHECK_VERSION(1,6,0) + , + -- | The suggested thickness to draw an underline. + underlineThickness :: PangoUnit, + -- | The suggested position to draw the underline. The value returned is + -- the distance above the baseline of the top of the underline. Since + -- most fonts have underline positions beneath the baseline, this value + -- is typically negative. + underlinePosition :: PangoUnit, + -- | The suggested thickness to draw for the strikethrough. + strikethroughThickenss :: PangoUnit, + -- | The suggested position to draw the strikethrough. The value + -- returned is the distance above the baseline of the top of the + -- strikethrough. + strikethroughPosition :: PangoUnit +#endif + } deriving Show Index: Font.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Pango/Font.chs,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- Font.chs 16 Oct 2005 15:05:35 -0000 1.1 +++ Font.chs 17 Oct 2005 22:52:50 -0000 1.2 @@ -25,10 +25,9 @@ -- Portability : portable (depends on GHC) -- -- Fonts. The selection of an appropriate font to render text becomes a --- substantial task in the presence of Unicode and rendering of scripts --- that do not follow the simple one-to-one correspondance between character --- and glyph (graphical representation of a character). Pango provides several --- concepts to handle fonts: +-- substantial task in the presence of Unicode where a single font does not +-- over the whole range of possible characters. Pango provides several +-- concepts to find appropriate fonts and to query information about them: -- -- * 'FontDescription': Font descriptions provide a way to query and state -- requirements on @@ -36,8 +35,6 @@ -- characteristics of a font. Each of these fields can be set of left -- unspecified. -- --- * 'FontMetric': Information about a font. --- -- * 'FontMap' : A font map represents the set of fonts available for a -- particular rendering system. In particular this map defines the -- relation between font size and pixel size in terms of the output medium. @@ -49,11 +46,14 @@ -- * 'FontFace': A face is a specific font where all characteristics are -- fixed except for the size. -- +-- * 'FontMetrics': Information about the font that will be used to render +-- a specific 'Graphics.UI.Gtk.Pango.Rendering.PangoItem'. +-- module Graphics.UI.Gtk.Pango.Font ( + PangoUnit, -- Functions to manage font descriptions. module Graphics.UI.Gtk.Pango.Description, -- Font metrics. - FontMetrics(..), FontMap, pangoFontMapListFamilies, FontFamily, @@ -61,7 +61,8 @@ pangoFontFamilyListFaces, FontFace, pangoFontFaceListSizes, - pangoFontFaceDescribe + pangoFontFaceDescribe, + FontMetrics(..) ) where import Monad (liftM) @@ -75,33 +76,6 @@ {# context lib="pango" prefix="pango" #} --- | 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 width. 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 -} -- | Ask for the different font families that a particular back-end supports. -- Index: Context.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Pango/Context.chs.pp,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- Context.chs.pp 16 Oct 2005 15:05:35 -0000 1.1 +++ Context.chs.pp 17 Oct 2005 22:52:50 -0000 1.2 @@ -55,6 +55,7 @@ contextSetFontDescription, contextGetFontDescription, Language, + emptyLanguage, languageFromString, contextSetLanguage, contextGetLanguage, @@ -95,42 +96,40 @@ {#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 + ascent <- {#call unsafe font_metrics_get_ascent#} mPtr + descent <- {#call unsafe font_metrics_get_descent#} mPtr + approximate_char_width <- + {#call unsafe font_metrics_get_approximate_char_width#} mPtr + approximate_digit_width <- + {#call unsafe font_metrics_get_approximate_digit_width#} mPtr +#if PANGO_CHECK_VERSION(1,6,0) + underline_position <- + {#call unsafe font_metrics_get_underline_position#} mPtr + underline_thickness <- + {#call unsafe font_metrics_get_underline_thickness#} mPtr + strikethrough_position <- + {#call unsafe font_metrics_get_strikethrough_position#} mPtr + strikethrough_thickness <- + {#call unsafe font_metrics_get_strikethrough_thickness#} mPtr +#endif return (FontMetrics - (ascend % fromIntegral pangoScale) - (descend % fromIntegral pangoScale) - (cWidth % fromIntegral pangoScale) - (dWidth % fromIntegral pangoScale)) + (intToPu ascent) + (intToPu descent) + (intToPu approximate_char_width) + (intToPu approximate_digit_width) +#if PANGO_CHECK_VERSION(1,6,0) + (intToPu underline_position) + (intToPu underline_thickness) + (intToPu strikethrough_position) + (intToPu strikethrough_thickness) +#endif + ) -- | Set the default 'FontDescription' of this context. -- Index: Enums.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Pango/Enums.chs.pp,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- Enums.chs.pp 25 Aug 2005 22:57:51 -0000 1.8 +++ Enums.chs.pp 17 Oct 2005 22:52:50 -0000 1.9 @@ -65,7 +65,7 @@ -- | The variant of a font. -- --- * The 'VariantCmallCaps' is a version of a font where lower case +-- * The 'VariantSmallCaps' is a version of a font where lower case -- letters are shown as physically smaller upper case letters. -- {#enum Variant {underscoreToCase} deriving (Eq)#} Index: Rendering.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Pango/Rendering.chs.pp,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- Rendering.chs.pp 16 Oct 2005 15:05:35 -0000 1.7 +++ Rendering.chs.pp 17 Oct 2005 22:52:50 -0000 1.8 @@ -41,14 +41,15 @@ -- such as 'Graphics.UI.Gtk.Cairo.cairoShowGlyphString'. -- module Graphics.UI.Gtk.Pango.Rendering ( - -- * 'PangoAttribute's: Applying emphasis to parts of an output string. + -- * 'PangoAttribute': Apply emphasis to parts of an output string. PangoAttribute(..), - -- * 'PangoItem's: Partition text into units with similar attributes. + -- * 'PangoItem': Partition text into units with similar attributes. PangoItem, pangoItemize, + pangoItemGetFontMetrics, - -- * 'GlyphItem's: Turn text segments into glyph sequences. + -- * 'GlyphItem': Turn text segments into glyph sequences. GlyphItem, pangoShape, glyphItemExtents, @@ -92,6 +93,47 @@ piRaws <- mapM makeNewPangoItemRaw piPtrs return (map (PangoItem ps) piRaws) + +-- | Retrieve the metrics of the font that was chosen to break the given +-- 'PangoItem'. +-- +pangoItemGetFontMetrics :: PangoItem -> IO FontMetrics +pangoItemGetFontMetrics pi = do + font <- pangoItemGetFont pi + lang <- pangoItemGetLanguage pi + mPtr <- {#call unsafe font_get_metrics#} font lang + ascent <- {#call unsafe font_metrics_get_ascent#} mPtr + descent <- {#call unsafe font_metrics_get_descent#} mPtr + approximate_char_width <- + {#call unsafe font_metrics_get_approximate_char_width#} mPtr + approximate_digit_width <- + {#call unsafe font_metrics_get_approximate_digit_width#} mPtr +#if PANGO_CHECK_VERSION(1,6,0) + underline_position <- + {#call unsafe font_metrics_get_underline_position#} mPtr + underline_thickness <- + {#call unsafe font_metrics_get_underline_thickness#} mPtr + strikethrough_position <- + {#call unsafe font_metrics_get_strikethrough_position#} mPtr + strikethrough_thickness <- + {#call unsafe font_metrics_get_strikethrough_thickness#} mPtr +#endif + return (FontMetrics + (intToPu ascent) + (intToPu descent) + (intToPu approximate_char_width) + (intToPu approximate_digit_width) +#if PANGO_CHECK_VERSION(1,6,0) + (intToPu underline_position) + (intToPu underline_thickness) + (intToPu strikethrough_position) + (intToPu strikethrough_thickness) +#endif + ) + + + + -- | Turn a 'PangoItem' into a 'GlyphItem'. -- -- * Turns a 'PangoItem', that is, sequence of characters with the same Index: Layout.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Pango/Layout.chs.pp,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- Layout.chs.pp 25 Aug 2005 22:57:51 -0000 1.2 +++ Layout.chs.pp 17 Oct 2005 22:52:50 -0000 1.3 @@ -49,7 +49,6 @@ -- 'Graphics.UI.Gtk.Gdk.DrawWindow'. -- module Graphics.UI.Gtk.Pango.Layout ( - PangoUnit, PangoRectangle(..), PangoLayout, layoutEmpty, @@ -82,6 +81,11 @@ LayoutAlignment(..), layoutSetAlignment, layoutGetAlignment, + TabAlign, + TabPosition, + layoutSetTabs, + layoutResetTabs, + layoutGetTabs, layoutSetSingleParagraphMode, layoutGetSingleParagraphMode, layoutXYToIndex, @@ -429,7 +433,50 @@ layoutGetAlignment (PangoLayout _ pl) = liftM (toEnum.fromIntegral) $ {#call unsafe layout_get_alignment#} pl --- functions are missing here +-- | Specify where the Tab stop appears relative to the text. +-- +-- * Only Tab stops that align text to the left are supported right now. +-- +{#enum PangoTabAlign as TabAlign {underscoreToCase}#} + +-- | A Tab position. +-- +type TabPosition = (PangoUnit, TabAlign) + +-- | Set a list of Tab positoins. +-- +layoutSetTabs :: PangoLayout -> [TabPosition] -> IO () +layoutSetTabs (PangoLayout _ pl) tabs = do + let len = fromIntegral (length tabs) + tabPtr <- {#call unsafe tab_array_new#} len (fromBool False) + mapM_ (\(idx, (pos, align)) -> + {#call unsafe tab_array_set_tab#} tabPtr idx + (fromIntegral (fromEnum align)) (puToInt pos)) (zip [0..] tabs) + {#call unsafe layout_set_tabs#} pl tabPtr + {#call unsafe tab_array_free#} tabPtr + +-- | Reset the original set of Tab positions. +-- +-- * Restore the default which is a Tab stop every eight characters. +-- +layoutResetTabs :: PangoLayout -> IO () +layoutResetTabs (PangoLayout _ pl) = {#call unsafe layout_set_tabs#} pl nullPtr + +-- | Retrieve the list of current Tab positions. +-- +-- * If no Tab position where set, @Nothing@ is returned. In this case, Tab +-- positions are implicit at every eight characters. +-- +layoutGetTabs :: PangoLayout -> IO (Maybe [TabPosition]) +layoutGetTabs (PangoLayout _ pl) = do + tabPtr <- {#call unsafe layout_get_tabs#} pl + if tabPtr == nullPtr then return Nothing else liftM Just $ do + len <- {#call unsafe tab_array_get_size#} tabPtr + mapM (\idx -> alloca $ \posPtr -> alloca $ \alignPtr -> do + {#call unsafe tab_array_get_tab#} tabPtr idx alignPtr posPtr + align <- peek alignPtr + pos <- peek posPtr + return (intToPu pos, toEnum (fromIntegral align))) [0..len-1] -- | Honor newlines or not. -- |