Menu
▾
▴
[Gtk2hs-commit] gtk2hs/gtk/pango Description.chs,NONE,1.1 PangoEnums.chs,NONE,1.1 Markup.hs,1.7,1.8 PangoLayout.chs,1.8,1.9 PangoTypes.chs.pp,1.1,1.2 Rendering.chs,1.3,1.4
|
From: Axel S. <as...@us...> - 2004-12-12 11:18:50
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/pango In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9646 Modified Files: Markup.hs PangoLayout.chs PangoTypes.chs.pp Rendering.chs Added Files: Description.chs PangoEnums.chs Log Message: Added more stuff on querying fonts and rearranged enumerations. --- NEW FILE: Description.chs --- -- GIMP Toolkit (GTK) - text layout functions: Font Descriptions -- -- Author : Axel Simon -- -- Created: 8 Feburary 2003 -- -- Version $Revision: 1.1 $ from $Date: 2004/12/12 11:18:41 $ -- -- 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 manage font description. -- -- * Font descriptions provide a way to query and state requirements of -- fonts. This data structure has several fields describing different -- characteristics of a font. Each of these fields can be set of left -- unspecified. -- module Description( FontDescription, fontDescriptionNew, fontDescriptionCopy, fontDescriptionSetFamily, fontDescriptionGetFamily, fontDescriptionSetStyle, fontDescriptionGetStyle, fontDescriptionSetVariant, fontDescriptionGetVariant, fontDescriptionSetWeight, fontDescriptionGetWeight, fontDescriptionSetStretch, fontDescriptionGetStretch, fontDescriptionSetSize, fontDescriptionGetSize, fontDescriptionUnsetFields, fontDescriptionMerge, fontDescriptionBetterMatch, fontDescriptionFromString, fontDescriptionToString ) where import Monad (liftM) import FFI {#import Hierarchy#} import GObject (makeNewGObject) {#import PangoTypes#} import PangoEnums import Data.Ratio import Enums import Structs (pangoScale) {# context lib="pango" prefix="pango_font_description" #} -- | Create a new font description. -- -- * All field are unset. -- fontDescriptionNew :: IO FontDescription fontDescriptionNew = {#call unsafe new#} >>= makeNewFontDescription -- | Make a deep copy of a font description. -- fontDescriptionCopy :: FontDescription -> IO FontDescription fontDescriptionCopy fd = {#call unsafe copy#} 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 -> {#call unsafe set_family_static#} 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 <- {#call unsafe get_family#} fd if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr -- Flags denoting which fields in a font description are set. {#enum PangoFontMask as FontMask {underscoreToCase} deriving(Bounded) #} instance Flags FontMask -- | Set the style field. -- -- * Most fonts will have either a 'StyleItalic' or 'StyleQblique' -- but rarely both. -- fontDescriptionSetStyle :: FontDescription -> Style -> IO () fontDescriptionSetStyle fd p = {#call unsafe set_style#} fd (fromIntegral (fromEnum p)) -- | Get the style field. fontDescriptionGetStyle :: FontDescription -> IO (Maybe Style) fontDescriptionGetStyle fd = do fields <- {#call unsafe get_set_fields#} fd if (fromEnum PangoFontMaskStyle) .&. (fromIntegral fields) /=0 then liftM (Just . toEnum . fromIntegral) $ {#call unsafe get_style#} fd else return Nothing -- | Set the variant field. -- fontDescriptionSetVariant :: FontDescription -> Variant -> IO () fontDescriptionSetVariant fd p = {#call unsafe set_variant#} fd (fromIntegral (fromEnum p)) -- | Get the variant field. fontDescriptionGetVariant :: FontDescription -> IO (Maybe Variant) fontDescriptionGetVariant fd = do fields <- {#call unsafe get_set_fields#} fd if (fromEnum PangoFontMaskVariant) .&. (fromIntegral fields) /=0 then liftM (Just . toEnum . fromIntegral) $ {#call unsafe get_variant#} fd else return Nothing -- | Set the weight field. -- fontDescriptionSetWeight :: FontDescription -> Weight -> IO () fontDescriptionSetWeight fd p = {#call unsafe set_weight#} fd (fromIntegral (fromEnum p)) -- | Get the weight field. fontDescriptionGetWeight :: FontDescription -> IO (Maybe Weight) fontDescriptionGetWeight fd = do fields <- {#call unsafe get_set_fields#} fd if (fromEnum PangoFontMaskWeight) .&. (fromIntegral fields) /=0 then liftM (Just . toEnum . fromIntegral) $ {#call unsafe get_weight#} fd else return Nothing -- | Set the stretch field. -- fontDescriptionSetStretch :: FontDescription -> Stretch -> IO () fontDescriptionSetStretch fd p = {#call unsafe set_stretch#} fd (fromIntegral (fromEnum p)) -- | Get the stretch field. fontDescriptionGetStretch :: FontDescription -> IO (Maybe Stretch) fontDescriptionGetStretch fd = do fields <- {#call unsafe get_set_fields#} fd if (fromEnum PangoFontMaskStretch) .&. (fromIntegral fields) /=0 then liftM (Just . toEnum . fromIntegral) $ {#call unsafe get_stretch#} fd else return Nothing -- | Set the size field. -- -- * The given size is in points (pts). One point is 1/72 inch. -- fontDescriptionSetSize :: FontDescription -> Rational -> IO () fontDescriptionSetSize fd p = {#call unsafe set_size#} fd (round (p*fromIntegral pangoScale)) -- | Get the size field. fontDescriptionGetSize :: FontDescription -> IO (Maybe Rational) fontDescriptionGetSize fd = do fields <- {#call unsafe get_set_fields#} fd if (fromEnum PangoFontMaskSize) .&. (fromIntegral fields) /=0 then liftM (\x -> Just (fromIntegral x % pangoScale)) $ {#call unsafe get_size#} fd else return Nothing -- | Reset fields in a font description. -- fontDescriptionUnsetFields :: FontDescription -> [FontMask] -> IO () fontDescriptionUnsetFields fd mask = {#call unsafe unset_fields#} 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 = {#call unsafe merge#} 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 $ {#call unsafe better_match#} 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 $ {#call unsafe better_match#} 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 -> {#call unsafe 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 <- {#call unsafe to_string#} fd str <- peekUTFString strPtr {#call unsafe g_free#} (castPtr strPtr) return strPtr Index: Markup.hs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/pango/Markup.hs,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- Markup.hs 27 May 2004 04:21:21 -0000 1.7 +++ Markup.hs 12 Dec 2004 11:18:41 -0000 1.8 @@ -30,15 +30,12 @@ module Markup( Markup, SpanAttribute(..), - FontSizeDef(..), - FontStyleDef(..), - FontWeightDef(..), - FontVariantDef(..), - FontStretchDef(..), - FontUnderlineDef(..), - markSpan + markSpan, + Size(..) ) where +import PangoTypes ( Language ) +import qualified PangoEnums as Pango -- | Define a synonym for text with embedded markup commands. -- @@ -53,47 +50,46 @@ -- | Choose a font by textual description. -- -- * Takes a string to completely describe the font, example: - -- @FontDescr \"Sans Italic 12\"@ + -- @FontDescr@ \"Sans Italic 12\" = FontDescr String -- | Specify the family of font to use. -- - -- * Example: @FontFamily \"Sans\"@ + -- * Example: @FontFamily@ \"Sans\" | FontFamily String -- | Change the size of the current font. -- - -- * The constuctor takes the size in points (pt) or as predefined + -- * The constuctor takes the size in points (pt) or a predefined -- sizes. Setting the absolute size 12.5pt can be achieved by passing - -- @FontSize ('FSPoint' 12.5)@ to 'markSpan'. Next to predefined - -- absolute sizes such as 'FSsmall' the size can be changed by asking - -- for the next larger or smaller front with 'FSlarger' and - -- 'FSsmaller', respectively. - | FontSize FontSizeDef + -- '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. -- - -- * The constructor takes one of three styles: 'FYnormal', - -- 'FYoblique' or 'FYitalic'. - | FontStyle FontStyleDef + | FontStyle Pango.FontStyle -- | Change the thickness of the current font. -- -- * The constructor takes one of the six predefined weights. Most likely to - -- be supported: 'FWbold'. - | FontWeight FontWeightDef + -- be supported: 'WeightBold'. + -- + | FontWeight Pango.Weight -- | Choosing an alternative rendering for lower case letters. -- - -- * The argument 'FVsmallcaps' will display lower case letters + -- * The argument 'VariangtSmallCaps' will display lower case letters -- as smaller upper case letters, if this option is available. - | FontVariant FontVariantDef + | FontVariant Pango.Variant -- | Choose a different width. -- - -- * Takes one of nine font widths, e.g. 'FTcondensed' or - -- 'FTexpanded'. - | FontStretch FontStretchDef + -- * Takes one of nine font widths, e.g. 'WidthExpanded'. + -- + | FontStretch Pango.Stretch -- | Foreground color. -- @@ -106,9 +102,7 @@ -- | Specify underlining of text. -- - -- * 'FUnone', 'FUsingle', 'FUdouble' or - -- 'FUlow' are possible choices. - | FontUnderline FontUnderlineDef + | FontUnderline Pango.Underline -- | Specify a vertical displacement. -- @@ -117,7 +111,11 @@ | FontRise Double -- | Give a hint about the language to be displayed. - | FontLang String -- FIXME: enumeration? what's the use anyway? + -- + -- * 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 @@ -134,110 +132,6 @@ (show (round (r*10000))) showsPrec _ (FontLang l) = showString " lang=".shows l --- | Define attributes for 'FontSize'. --- -data FontSizeDef - = FSPoint Double - | FSunreadable - | FStiny - | FSsmall - | FSmedium - | FSlarge - | FShuge - | FSgiant - | FSsmaller - | FSlarger - -instance Show FontSizeDef where - showsPrec _ (FSPoint v) = shows $ show (round (v*1000)) - showsPrec _ (FSunreadable) = shows "xx-small" - showsPrec _ (FStiny) = shows "x-small" - showsPrec _ (FSsmall) = shows "small" - showsPrec _ (FSmedium) = shows "medium" - showsPrec _ (FSlarge) = shows "large" - showsPrec _ (FShuge) = shows "x-large" - showsPrec _ (FSgiant) = shows "xx-large" - showsPrec _ (FSsmaller) = shows "smaller" - showsPrec _ (FSlarger) = shows "larger" - --- | Define attributes for 'FontStyle'. --- -data FontStyleDef - = FYnormal - | FYoblique - | FYitalic - -instance Show FontStyleDef where - showsPrec _ FYnormal = shows "normal" - showsPrec _ FYoblique = shows "oblique" - showsPrec _ FYitalic = shows "italic" - --- | Define attributes for 'FontWeight'. --- -data FontWeightDef - = FWultralight - | FWlight - | FWnormal - | FWbold - | FWultrabold - | FWheavy - -instance Show FontWeightDef where - showsPrec _ FWultralight = shows "ultralight" - showsPrec _ FWlight = shows "light" - showsPrec _ FWnormal = shows "normal" - showsPrec _ FWbold = shows "bold" - showsPrec _ FWultrabold = shows "ultrabold" - showsPrec _ FWheavy = shows "heavy" - --- | Define attributes for 'FontVariant'. --- -data FontVariantDef - = FVnormal - | FVsmallcaps - -instance Show FontVariantDef where - showsPrec _ FVnormal = shows "normal" - showsPrec _ FVsmallcaps = shows "smallcaps" - --- | Define attributes for 'FontStretch'. --- -data FontStretchDef - = FTultracondensed - | FTextracondensed - | FTcondensed - | FTsemicondensed - | FTnormal - | FTsemiexpanded - | FTexpanded - | FTextraexpanded - | FTultraexpanded - -instance Show FontStretchDef where - showsPrec _ FTultracondensed = shows "ultracondensed" - showsPrec _ FTextracondensed = shows "extracondensed" - showsPrec _ FTcondensed = shows "condensed" - showsPrec _ FTsemicondensed = shows "semicondensed" - showsPrec _ FTnormal = shows "normal" - showsPrec _ FTsemiexpanded = shows "semiexpanded" - showsPrec _ FTexpanded = shows "expanded" - showsPrec _ FTextraexpanded = shows "extraexpanded" - showsPrec _ FTultraexpanded = shows "ultraexpanded" - --- | Define attributes for 'FontUnderline'. --- -data FontUnderlineDef - = FUsingle - | FUdouble - | FUlow - | FUnone - -instance Show FontUnderlineDef where - showsPrec _ FUsingle = shows "single" - showsPrec _ FUdouble = shows "double" - showsPrec _ FUlow = shows "low" - showsPrec _ FUnone = shows "none" - -- | Create the most generic span attribute. -- markSpan :: [SpanAttribute] -> String -> String @@ -246,5 +140,32 @@ 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" + + Index: PangoTypes.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/pango/PangoTypes.chs.pp,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- PangoTypes.chs.pp 21 Nov 2004 15:06:16 -0000 1.1 +++ PangoTypes.chs.pp 12 Dec 2004 11:18:41 -0000 1.2 @@ -26,7 +26,12 @@ LayoutIter(LayoutIter), layout_iter_free, LayoutLine(LayoutLine), - mkLayoutLine + makeNewLayoutLine, + FontDescription(FontDescription), + makeNewFontDescription, + Language(Language), + emptyLanguage, + languageFromString ) where import Monad (liftM) @@ -40,15 +45,6 @@ -- {#pointer *PangoLayoutIter as LayoutIter foreign newtype #} --- | A single line in a 'PangoLayout'. --- -{#pointer *PangoLayoutLine as LayoutLine foreign newtype #} - -mkLayoutLine :: Ptr LayoutLine -> IO LayoutLine -mkLayoutLine llPtr = do - pango_layout_line_ref llPtr - liftM LayoutLine $ newForeignPtr llPtr (pango_layout_line_unref llPtr) - #if __GLASGOW_HASKELL__>=600 @@ -70,6 +66,15 @@ #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" @@ -102,3 +107,49 @@ #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 = + withUTFString language {#call language_from_string#} --- NEW FILE: PangoEnums.chs --- -- GIMP Toolkit (GTK) Enumerations for Pango. -- -- Author : Axel Simon -- -- Created: 12 September 2004 -- -- Version $Revision: 1.1 $ from $Date: 2004/12/12 11:18:41 $ -- -- 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 PangoEnums( 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" Index: PangoLayout.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/pango/PangoLayout.chs,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- PangoLayout.chs 27 May 2004 04:21:21 -0000 1.8 +++ PangoLayout.chs 12 Dec 2004 11:18:41 -0000 1.9 @@ -377,7 +377,7 @@ layoutGetLines pl = do listPtr <- {#call unsafe layout_get_lines#} pl list <- readGSList listPtr - mapM mkLayoutLine list + mapM makeNewLayoutLine list -- | Create an iterator to examine a layout. -- @@ -440,7 +440,7 @@ layoutIterGetLine li = do llPtr <- liftM castPtr $ {#call unsafe pango_layout_iter_get_line#} li if (llPtr==nullPtr) then return Nothing else - liftM Just $ mkLayoutLine llPtr + liftM Just $ makeNewLayoutLine llPtr -- | Retrieve a rectangle surrounding -- a character. Index: Rendering.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/pango/Rendering.chs,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- Rendering.chs 23 May 2004 16:12:20 -0000 1.3 +++ Rendering.chs 12 Dec 2004 11:18:41 -0000 1.4 @@ -27,20 +27,163 @@ -- accomplish various steps of this process. -- module Rendering( - PangoContext + PangoContext, + contextListFamilies, +-- contextLoadFont, +-- contextLoadFontSet, + contextGetMetrics, + FontMetrics(..), + contextSetFontDescription, + contextGetFontDescription, + contextSetLanguage, + contextGetLanguage, + contextSetTextDir, + contextGetTextDir, + TextDirection(..) ) where import Monad (liftM) import FFI - +import Structs (pangoScale) {#import Hierarchy#} import GObject (makeNewGObject) +import Enums +{#import PangoTypes#} +import Data.Ratio {# context lib="pango" prefix="pango" #} --- The constructor context_new is not really public and only enabled if --- the header files are compiled with PANGO_ENABLE_BACKEND. The same holds --- for pango_context_set_font_map, so we better restrict ourselved to the --- gdk functions. +-- | 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 pc (Language l) = {#call unsafe context_set_language#} pc l + +-- | 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 |
