diff --git a/Graphics/Rendering/Pango.chs b/Graphics/Rendering/Pango.chs --- a/Graphics/Rendering/Pango.chs +++ b/Graphics/Rendering/Pango.chs @@ -67,7 +67,6 @@ import Graphics.Rendering.Pango.Font import Graphics.Rendering.Pango.Enums hiding ( - Markup, Language, emptyLanguage, languageFromString, diff --git a/Graphics/Rendering/Pango/Attributes.chs b/Graphics/Rendering/Pango/Attributes.chs --- a/Graphics/Rendering/Pango/Attributes.chs +++ b/Graphics/Rendering/Pango/Attributes.chs @@ -125,7 +125,7 @@ {#call unsafe attr_shape_new#} (castPtr rect1Ptr) (castPtr rect2Ptr) #endif crAttr c AttrScale { paStart=s, paEnd=e, paScale = scale } = - setAttrPos c s e $ + setAttrPos c s e $ {#call unsafe attr_scale_new#} (realToFrac scale) #if PANGO_VERSION_CHECK(1,4,0) crAttr c AttrFallback { paStart=s, paEnd=e, paFallback = fb } = @@ -163,9 +163,11 @@ -- -- * If a parsing error occurs a 'System.Glib.GError.GError' is thrown. -- -parseMarkup :: Markup -- ^ the string containing markup +parseMarkup :: + (GlibString markup, GlibString string) + => markup -- ^ the string containing markup -> Char -- ^ @accelMarker@ - the character that prefixes an accelerator - -> IO ([[PangoAttribute]], Char, String) -- ^ list of attributes, the accelerator character found and the input string + -> IO ([[PangoAttribute]], Char, string) -- ^ list of attributes, the accelerator character found and the input string -- without markup parseMarkup markup accelMarker = propagateGError $ \errPtr -> withUTFStringLen markup $ \(markupPtr,markupLen) -> diff --git a/Graphics/Rendering/Pango/BasicTypes.chs b/Graphics/Rendering/Pango/BasicTypes.chs --- a/Graphics/Rendering/Pango/BasicTypes.chs +++ b/Graphics/Rendering/Pango/BasicTypes.chs @@ -30,7 +30,7 @@ -- module Graphics.Rendering.Pango.BasicTypes ( GInt, - + Language(Language), emptyLanguage, languageFromString, @@ -75,6 +75,7 @@ import Control.Monad (liftM) import Data.IORef ( IORef ) +import qualified Data.Text as T (unpack) import System.Glib.FFI import System.Glib.UTFString {#import Graphics.Rendering.Pango.Types#} (Font, PangoLayoutRaw) @@ -92,7 +93,7 @@ instance Show Language where show (Language ptr) | ptr==nullPtr = "" - | otherwise = unsafePerformIO $ peekUTFString (castPtr ptr) + | otherwise = T.unpack . unsafePerformIO $ peekUTFString (castPtr ptr) -- | Specifying no particular language. emptyLanguage :: Language @@ -106,13 +107,13 @@ -- lowercase, mapping \'_\' to \'-\', and stripping all characters -- other than letters and \'-\'. -- -languageFromString :: String -> IO Language +languageFromString :: GlibString string => string -> IO Language languageFromString language = liftM Language $ withUTFString language {#call language_from_string#} -- | The style of a font. -- --- * 'StyleOblique' is a slanted font like 'StyleItalic', +-- * 'StyleOblique' is a slanted font like 'StyleItalic', -- but in a roman style. -- {#enum Style as FontStyle {underscoreToCase} deriving (Eq)#} @@ -207,7 +208,7 @@ show PangoGravityNorth = "north" show PangoGravityWest = "west" show PangoGravityAuto = "auto" - + -- | The 'PangoGravityHint' defines how horizontal scripts should behave in a -- vertical context. -- @@ -234,14 +235,14 @@ -- A string that is stored with each GlyphString, PangoItem data PangoString = PangoString UTFCorrection CInt (ForeignPtr CChar) -makeNewPangoString :: String -> IO PangoString +makeNewPangoString :: GlibString string => string -> IO PangoString makeNewPangoString str = do let correct = genUTFOfs str (strPtr, len) <- newUTFStringLen str let cLen = fromIntegral len liftM (PangoString correct cLen) $ newForeignPtr strPtr finalizerFree -withPangoString :: PangoString -> +withPangoString :: PangoString -> (UTFCorrection -> CInt -> Ptr CChar -> IO a) -> IO a withPangoString (PangoString c l ptr) act = withForeignPtr ptr $ \strPtr -> act c l strPtr @@ -297,9 +298,9 @@ -- * A glyph item contains the graphical representation of a 'PangoItem'. -- Clusters (like @e@ and an accent modifier) as well as legatures -- (such as @ffi@ turning into a single letter that omits the dot over the --- @i@) are usually represented as a single glyph. +-- @i@) are usually represented as a single glyph. -- -data GlyphItem = GlyphItem PangoItem GlyphStringRaw +data GlyphItem = GlyphItem PangoItem GlyphStringRaw -- | A rendered paragraph. data PangoLayout = PangoLayout (IORef PangoString) PangoLayoutRaw @@ -352,6 +353,6 @@ strPtr <- {#call unsafe font_description_to_string#} fd str <- peekUTFString strPtr {#call unsafe g_free#} (castPtr strPtr) - return str + return $ T.unpack str diff --git a/Graphics/Rendering/Pango/Cairo.chs b/Graphics/Rendering/Pango/Cairo.chs --- a/Graphics/Rendering/Pango/Cairo.chs +++ b/Graphics/Rendering/Pango/Cairo.chs @@ -23,7 +23,7 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- +-- -- Pango specific functions to for redering with Cairo. -- -- Cairo is a graphics library that supports vector graphics and image @@ -56,6 +56,7 @@ import Control.Exception (bracket) import System.Glib.FFI +import System.Glib.UTFString import System.Glib.GObject (wrapNewGObject, makeNewGObject, objectRef, objectUnref) {#import Graphics.Rendering.Pango.Types#} @@ -100,7 +101,7 @@ -- @10pt * (1\/72 pt\/inch) * (96 pixel\/inch) = 13.3 pixel@. -- cairoFontMapGetDefault :: IO FontMap -cairoFontMapGetDefault = +cairoFontMapGetDefault = makeNewGObject mkFontMap $ {#call unsafe pango_cairo_font_map_get_default#} -- | Set the scaling factor between font size and Cairo units. @@ -197,7 +198,7 @@ -- If the transformation or target surface of the 'Render' context -- change, 'updateLayout' has to be called on this layout. -- -createLayout :: String -> Render PangoLayout +createLayout :: GlibString string => string -> Render PangoLayout createLayout text = Render $ do cr <- ask liftIO $ do diff --git a/Graphics/Rendering/Pango/Description.chs b/Graphics/Rendering/Pango/Description.chs --- a/Graphics/Rendering/Pango/Description.chs +++ b/Graphics/Rendering/Pango/Description.chs @@ -73,12 +73,12 @@ -- * All field are unset. -- fontDescriptionNew :: IO FontDescription -fontDescriptionNew = {#call unsafe new#} >>= makeNewFontDescription +fontDescriptionNew = {#call unsafe new#} >>= makeNewFontDescription -- | Make a deep copy of a font description. -- fontDescriptionCopy :: FontDescription -> IO FontDescription -fontDescriptionCopy fd = {#call unsafe copy#} fd >>= makeNewFontDescription +fontDescriptionCopy fd = {#call unsafe copy#} fd >>= makeNewFontDescription -- | Set the font famliy. -- @@ -87,7 +87,7 @@ -- -- * In some contexts a comma separated list of font families can be used. -- -fontDescriptionSetFamily :: FontDescription -> String -> IO () +fontDescriptionSetFamily :: GlibString string => FontDescription -> string -> IO () fontDescriptionSetFamily fd family = withUTFString family $ \strPtr -> {#call unsafe set_family#} fd strPtr @@ -95,7 +95,7 @@ -- -- * 'Nothing' is returned if the font family is not set. -- -fontDescriptionGetFamily :: FontDescription -> IO (Maybe String) +fontDescriptionGetFamily :: GlibString string => FontDescription -> IO (Maybe string) fontDescriptionGetFamily fd = do strPtr <- {#call unsafe get_family#} fd if strPtr==nullPtr then return Nothing else @@ -165,7 +165,7 @@ fontDescriptionGetStretch fd = do fields <- {#call unsafe get_set_fields#} fd if (fromEnum PangoFontMaskStretch) .&. (fromIntegral fields) /=0 - then liftM (Just . toEnum . fromIntegral) $ + then liftM (Just . toEnum . fromIntegral) $ {#call unsafe get_stretch#} fd else return Nothing @@ -174,7 +174,7 @@ -- * The given size is in points (pts). One point is 1\/72 inch. -- fontDescriptionSetSize :: FontDescription -> Double -> IO () -fontDescriptionSetSize fd p = +fontDescriptionSetSize fd p = {#call unsafe set_size#} fd (puToInt p) -- | Get the size field. @@ -182,7 +182,7 @@ fontDescriptionGetSize fd = do fields <- {#call unsafe get_set_fields#} fd if (fromEnum PangoFontMaskSize) .&. (fromIntegral fields) /=0 - then liftM (\x -> Just (intToPu x)) $ + then liftM (\x -> Just (intToPu x)) $ {#call unsafe get_size#} fd else return Nothing @@ -218,14 +218,14 @@ -- * Approximate matching is done on weight and style. If the other -- attributes do not match, the function returns @False@. -- -fontDescriptionBetterMatch :: FontDescription -> FontDescription -> +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 +-- * 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 @@ -234,7 +234,7 @@ -- these fields is absent, the resulting 'FontDescription' will have -- the corresponing fields unset. -- -fontDescriptionFromString :: String -> IO FontDescription +fontDescriptionFromString :: GlibString string => string -> IO FontDescription fontDescriptionFromString descr = withUTFString descr $ \strPtr -> {#call unsafe from_string#} strPtr >>= makeNewFontDescription @@ -243,7 +243,7 @@ -- * Creates a string representation of a font description. See -- 'fontDescriptionFromString' for the format of the string. -- -fontDescriptionToString :: FontDescription -> IO String +fontDescriptionToString :: GlibString string => FontDescription -> IO string fontDescriptionToString fd = do strPtr <- {#call unsafe to_string#} fd str <- peekUTFString strPtr diff --git a/Graphics/Rendering/Pango/Enums.chs b/Graphics/Rendering/Pango/Enums.chs --- a/Graphics/Rendering/Pango/Enums.chs +++ b/Graphics/Rendering/Pango/Enums.chs @@ -49,7 +49,6 @@ #endif -- these will not be exported from this module in the future - Markup, Language, emptyLanguage, languageFromString, diff --git a/Graphics/Rendering/Pango/Font.chs b/Graphics/Rendering/Pango/Font.chs --- a/Graphics/Rendering/Pango/Font.chs +++ b/Graphics/Rendering/Pango/Font.chs @@ -74,6 +74,7 @@ ) where import Control.Monad (liftM) +import qualified Data.Text as T (unpack) import System.Glib.FFI import System.Glib.UTFString @@ -103,7 +104,7 @@ mapM (makeNewGObject mkFontFamily . return . castPtr) ffsPtr instance Show FontFamily where - show ff = unsafePerformIO $ do + show ff = T.unpack . unsafePerformIO $ do strPtr <- {#call unsafe font_family_get_name#} ff peekUTFString strPtr @@ -142,7 +143,7 @@ mapM (makeNewGObject mkFontFace . return . castPtr) ffsPtr instance Show FontFace where - show ff = unsafePerformIO $ do + show ff = T.unpack . unsafePerformIO $ do strPtr <- {#call unsafe font_face_get_face_name#} ff peekUTFString strPtr diff --git a/Graphics/Rendering/Pango/Layout.chs b/Graphics/Rendering/Pango/Layout.chs --- a/Graphics/Rendering/Pango/Layout.chs +++ b/Graphics/Rendering/Pango/Layout.chs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, OverloadedStrings #-} -- -*-haskell-*- -- GIMP Toolkit (GTK) Pango text layout functions -- @@ -122,6 +122,7 @@ import Control.Monad (liftM) import Data.Char (ord, chr) +import Data.Text (Text) import System.Glib.FFI import System.Glib.UTFString @@ -146,13 +147,13 @@ layoutEmpty pc = do pl <- wrapNewGObject mkPangoLayoutRaw ({#call unsafe layout_new#} (toPangoContext pc)) - ps <- makeNewPangoString "" + ps <- makeNewPangoString ("" :: Text) psRef <- newIORef ps return (PangoLayout psRef pl) -- | Create a new layout. -- -layoutText :: PangoContext -> String -> IO PangoLayout +layoutText :: GlibString string => PangoContext -> string -> IO PangoLayout layoutText pc txt = do pl <- wrapNewGObject mkPangoLayoutRaw ({#call unsafe layout_new#} (toPangoContext pc)) @@ -189,7 +190,7 @@ -- | Set the string in the layout. -- -layoutSetText :: PangoLayout -> String -> IO () +layoutSetText :: GlibString string => PangoLayout -> string -> IO () layoutSetText (PangoLayout psRef pl) txt = do withUTFStringLen txt $ \(strPtr,len) -> {#call unsafe layout_set_text#} pl strPtr (fromIntegral len) @@ -198,7 +199,7 @@ -- | Retrieve the string in the layout. -- -layoutGetText :: PangoLayout -> IO String +layoutGetText :: GlibString string => PangoLayout -> IO string layoutGetText (PangoLayout _ pl) = {#call unsafe layout_get_text#} pl >>= peekUTFString @@ -209,7 +210,8 @@ -- -- The function returns the text that is actually shown. -- -layoutSetMarkup :: PangoLayout -> Markup -> IO String +layoutSetMarkup :: (GlibString markup, GlibString string) + => PangoLayout -> markup -> IO string layoutSetMarkup pl@(PangoLayout psRef plr) txt = do withUTFStringLen txt $ \(strPtr,len) -> {#call unsafe layout_set_markup#} plr strPtr (fromIntegral len) @@ -224,7 +226,7 @@ -- function is strict in that it forces all characters in the input string -- as soon as a single output character is requested. -- -escapeMarkup :: String -> String +escapeMarkup :: GlibString string => string -> string escapeMarkup str = unsafePerformIO $ withUTFStringLen str $ \(strPtr,l) -> do resPtr <- {#call unsafe g_markup_escape_text#} strPtr (fromIntegral l) res <- peekUTFString resPtr @@ -242,9 +244,10 @@ -- returned so it can be used to add the actual keyboard shortcut. -- The second element is the string after parsing. -- -layoutSetMarkupWithAccel :: PangoLayout -> Markup -> IO (Char, String) +layoutSetMarkupWithAccel :: (GlibString markup, GlibString string) + => PangoLayout -> markup -> IO (Char, string) layoutSetMarkupWithAccel pl@(PangoLayout psRef plr) txt = do - modif <- alloca $ \chrPtr -> + modif <- alloca $ \chrPtr -> withUTFStringLen txt $ \(strPtr,len) -> do {#call unsafe layout_set_markup_with_accel#} plr strPtr (fromIntegral len) (fromIntegral (ord '_')) chrPtr @@ -353,7 +356,7 @@ -- a word if it is the only one on this line and it exceeds the -- specified width. -- -{#enum PangoWrapMode as LayoutWrapMode +{#enum PangoWrapMode as LayoutWrapMode {underscoreToCase, PANGO_WRAP_WORD as WrapWholeWords, PANGO_WRAP_CHAR as WrapAnywhere, @@ -407,7 +410,7 @@ -- is indented. -- layoutGetIndent :: PangoLayout -> IO Double -layoutGetIndent (PangoLayout _ pl) = +layoutGetIndent (PangoLayout _ pl) = liftM intToPu $ {#call unsafe layout_get_indent#} pl @@ -420,7 +423,7 @@ -- | Gets the spacing between the lines. -- layoutGetSpacing :: PangoLayout -> IO Double -layoutGetSpacing (PangoLayout _ pl) = +layoutGetSpacing (PangoLayout _ pl) = liftM intToPu $ {#call unsafe layout_get_spacing#} pl -- | Set if text should be streched to fit width. @@ -433,7 +436,7 @@ -- * Note that as of Pango 1.4, this functionality is not yet implemented. -- layoutSetJustify :: PangoLayout -> Bool -> IO () -layoutSetJustify (PangoLayout _ pl) j = +layoutSetJustify (PangoLayout _ pl) j = {#call unsafe layout_set_justify#} pl (fromBool j) -- | Retrieve the justification flag. @@ -441,7 +444,7 @@ -- * See 'layoutSetJustify'. -- layoutGetJustify :: PangoLayout -> IO Bool -layoutGetJustify (PangoLayout _ pl) = +layoutGetJustify (PangoLayout _ pl) = liftM toBool $ {#call unsafe layout_get_justify#} pl #if PANGO_VERSION_CHECK(1,4,0) @@ -464,7 +467,7 @@ -- 'AlignLeft' and 'AlignRight' are swapped. -- layoutSetAutoDir :: PangoLayout -> Bool -> IO () -layoutSetAutoDir (PangoLayout _ pl) j = +layoutSetAutoDir (PangoLayout _ pl) j = {#call unsafe layout_set_auto_dir#} pl (fromBool j) -- | Retrieve the auto direction flag. @@ -472,7 +475,7 @@ -- * See 'layoutSetAutoDir'. -- layoutGetAutoDir :: PangoLayout -> IO Bool -layoutGetAutoDir (PangoLayout _ pl) = +layoutGetAutoDir (PangoLayout _ pl) = liftM toBool $ {#call unsafe layout_get_auto_dir#} pl #endif @@ -551,7 +554,7 @@ -- single text line. -- layoutSetSingleParagraphMode :: PangoLayout -> Bool -> IO () -layoutSetSingleParagraphMode (PangoLayout _ pl) honor = +layoutSetSingleParagraphMode (PangoLayout _ pl) honor = {#call unsafe layout_set_single_paragraph_mode#} pl (fromBool honor) -- | Retrieve if newlines are honored. @@ -559,7 +562,7 @@ -- * See 'layoutSetSingleParagraphMode'. -- layoutGetSingleParagraphMode :: PangoLayout -> IO Bool -layoutGetSingleParagraphMode (PangoLayout _ pl) = +layoutGetSingleParagraphMode (PangoLayout _ pl) = liftM toBool $ {#call unsafe layout_get_single_paragraph_mode#} pl -- a function is missing here @@ -583,7 +586,7 @@ layoutXYToIndex :: PangoLayout -> Double -- ^ the @x@ position -> Double -- ^ the @y@ position -> IO (Bool, Int, Int) -layoutXYToIndex (PangoLayout psRef pl) x y = +layoutXYToIndex (PangoLayout psRef pl) x y = alloca $ \idxPtr -> alloca $ \trailPtr -> do res <- {#call unsafe layout_xy_to_index#} pl (puToInt x) (puToInt y) idxPtr trailPtr @@ -705,7 +708,7 @@ -> IO (PangoRectangle, PangoRectangle) -- ^ @(ink, logical)@ layoutGetExtents (PangoLayout _ pl) = twoRect $ {#call unsafe layout_get_extents#} pl - + -- | Compute the physical size of the layout. -- -- * Computes the ink and the logical size of the 'Layout' in device units, @@ -745,7 +748,7 @@ {#call unsafe layout_get_line#} #endif pl (fromIntegral idx) - if llPtr==nullPtr then + if llPtr==nullPtr then throwIO (IndexOutOfBounds ("Graphics.Rendering.Pango.Layout.layoutGetLine: "++ "no line at index "++show idx)) else do @@ -840,7 +843,7 @@ -- left of the entire layout). -- layoutIterGetBaseline :: LayoutIter -> IO Double -layoutIterGetBaseline (LayoutIter _ li) = +layoutIterGetBaseline (LayoutIter _ li) = liftM intToPu $ {#call unsafe pango_layout_iter_get_baseline#} li #if PANGO_VERSION_CHECK(1,2,0) @@ -883,10 +886,10 @@ -- * Get the extents of the current character -- (origin is the top left of the entire layout). Only logical extents -- can sensibly be obtained for characters; ink extents make sense only --- down to the level of clusters. +-- down to the level of clusters. -- layoutIterGetCharExtents :: LayoutIter -> IO PangoRectangle -layoutIterGetCharExtents (LayoutIter _ li) = alloca $ \logPtr -> +layoutIterGetCharExtents (LayoutIter _ li) = alloca $ \logPtr -> {#call unsafe layout_iter_get_char_extents#} li (castPtr logPtr) >> peek logPtr @@ -946,7 +949,7 @@ -- | Compute the physical size of the line. -- --- * Computes the ink and the logical size of the 'LayoutLine'. +-- * Computes the ink and the logical size of the 'LayoutLine'. -- See 'layoutGetExtents'. -- layoutLineGetExtents :: LayoutLine -> IO (PangoRectangle, PangoRectangle) @@ -955,7 +958,7 @@ -- | Compute the physical size of the line. -- --- * Computes the ink and the logical size of the 'LayoutLine'. +-- * Computes the ink and the logical size of the 'LayoutLine'. -- See 'layoutGetExtents'. The returned values are in device units, that -- is, pixels for the screen and points for printers. -- @@ -971,7 +974,7 @@ -- layoutLineIndexToX :: LayoutLine -> Int -- ^ the index into the string - -> Bool -- ^ return the beginning (@False@) or the end + -> Bool -- ^ return the beginning (@False@) or the end -- of the character -> IO Double layoutLineIndexToX (LayoutLine psRef ll) pos beg = @@ -1000,7 +1003,7 @@ -- @trailing@ indicates where in a cluster the @x@ position lay. It is -- 0 for the trailing edge of the cluster. -- -layoutLineXToIndex :: LayoutLine +layoutLineXToIndex :: LayoutLine -> Double -- ^ The @x@ position. -> IO (Bool, Int, Int) layoutLineXToIndex (LayoutLine psRef ll) pos = @@ -1028,10 +1031,10 @@ -- (counting from 0). If this value is -- less than the start index for the line, -- then the first range will extend all the - -- way to the leading edge of the layout. + -- way to the leading edge of the layout. -- Otherwise it will start at the leading -- edge of the first character. - -> Int -- ^ The index after the last character. + -> Int -- ^ The index after the last character. -- If this value is greater than the end -- index for the line, then the last range -- will extend all the way to the trailing diff --git a/Graphics/Rendering/Pango/Markup.chs b/Graphics/Rendering/Pango/Markup.chs --- a/Graphics/Rendering/Pango/Markup.chs +++ b/Graphics/Rendering/Pango/Markup.chs @@ -51,10 +51,9 @@ -- -- [@tt@] Monospace font -- --- [@u@] Underline +-- [@u@] Underline -- module Graphics.Rendering.Pango.Markup ( - Pango.Markup, SpanAttribute(..), markSpan, parseMarkup @@ -82,7 +81,7 @@ -- * 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 'Pango.SizeSmall' the size can be changed by + -- absolute sizes such as 'Pango.SizeSmall' the size can be changed by -- asking for the next larger or smaller front with -- 'Pango.SizeLarger' and 'Pango.SizeSmaller', respectively. | FontSize Pango.Size @@ -113,7 +112,7 @@ -- | Foreground color. -- -- * This constructor and 'FontBackground' take both a description - -- of the color to be used for rendering. The name is either a + -- of the color to be used for rendering. The name is either a -- hex code of the form \"#RRGGBB\" or an X11 color name like -- \"dark olive green\". -- @@ -142,11 +141,11 @@ #if PANGO_VERSION_CHECK(1,16,0) -- | Gravity of text, use for ratation. | FontGravity Pango.PangoGravity - + -- | Intensity of gravity. | FontGravityHint Pango.PangoGravityHint #endif - + instance Show SpanAttribute where showsPrec _ (FontDescr str) = showString " font_desc=".shows str showsPrec _ (FontFamily str) = showString " font_family=".shows str @@ -158,14 +157,14 @@ 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 + showsPrec _ (FontRise r) = showString " rise=".shows (show (round (r*10000))) showsPrec _ (FontLang l) = showString " lang=".shows l #if PANGO_VERSION_CHECK(1,16,0) showsPrec _ (FontGravity g) = showString " gravity=".shows g showsPrec _ (FontGravityHint h) = showString " gravity_hint".shows h #endif - + -- | Create the most generic span attribute. -- markSpan :: [SpanAttribute] -> String -> String diff --git a/Graphics/Rendering/Pango/Rendering.chs b/Graphics/Rendering/Pango/Rendering.chs --- a/Graphics/Rendering/Pango/Rendering.chs +++ b/Graphics/Rendering/Pango/Rendering.chs @@ -46,7 +46,7 @@ pangoItemGetFontMetrics, pangoItemGetFont, pangoItemGetLanguage, - + -- * 'GlyphItem': Turn text segments into glyph sequences. GlyphItem, pangoShape, @@ -61,6 +61,7 @@ ) where import System.Glib.FFI +import System.Glib.UTFString import Graphics.Rendering.Pango.Structs ( pangoItemRawAnalysis, intToPu, pangoItemRawGetOffset, pangoItemRawGetLength, pangoItemGetFont, pangoItemGetLanguage) @@ -79,7 +80,7 @@ -- and shaping engine. The generated list of items will be in logical order -- (the start offsets of the items are ascending). -- -pangoItemize :: PangoContext -> String -> [PangoAttribute] -> IO [PangoItem] +pangoItemize :: GlibString string => PangoContext -> string -> [PangoAttribute] -> IO [PangoItem] pangoItemize pc str attrs = do ps <- makeNewPangoString str withAttrList ps attrs $ \alPtr -> do diff --git a/Graphics/Rendering/Pango/Structs.hsc b/Graphics/Rendering/Pango/Structs.hsc --- a/Graphics/Rendering/Pango/Structs.hsc +++ b/Graphics/Rendering/Pango/Structs.hsc @@ -31,7 +31,6 @@ -- Portability : portable (depends on GHC) -- module Graphics.Rendering.Pango.Structs ( - Markup, PangoUnit, Color(..), Rectangle(..), @@ -61,19 +60,12 @@ import System.Glib.FFI import System.Glib.UTFString ( peekUTFString, UTFCorrection, - ofsToUTF, ofsFromUTF ) + ofsToUTF, ofsFromUTF, DefaultGlibString ) import System.Glib.GObject (makeNewGObject) import Graphics.Rendering.Pango.Types import Graphics.Rendering.Pango.BasicTypes --- | 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 - --- A pango unit is an internal euclidian metric, that is, a measure for +-- A pango unit is an internal euclidian metric, that is, a measure for -- lengths and position. -- -- * Deprecated. Replaced by Double. @@ -272,7 +264,7 @@ -- | A hint as to what language this piece of text is written in. = AttrLanguage { paStart :: Int, paEnd :: Int, paLang :: Language } -- | The font family, e.g. @sans serif@. - | AttrFamily { paStart :: Int, paEnd :: Int, paFamily :: String } + | AttrFamily { paStart :: Int, paEnd :: Int, paFamily :: DefaultGlibString } -- | The slant of the current font. | AttrStyle { paStart :: Int, paEnd :: Int, paStyle :: FontStyle } -- | Weight of font, e.g. 'WeightBold'. @@ -342,7 +334,7 @@ -- -- * Available in Pango 1.6.0 and higher. -- - | AttrLetterSpacing { paStart :: Int, paEnd :: Int, + | AttrLetterSpacing { paStart :: Int, paEnd :: Int, paLetterSpacing :: Double } #endif #if PANGO_VERSION_CHECK(1,16,0) @@ -355,14 +347,14 @@ -- -- * Available in Pango 1.16.0 and higher. -- - | AttrGravity { paStart :: Int, paEnd :: Int, + | AttrGravity { paStart :: Int, paEnd :: Int, paGravity :: PangoGravity } -- | Set the way horizontal scripts behave in a vertical context. -- -- * Available in Pango 1.16.0 and higher. -- - | AttrGravityHint { paStart :: Int, paEnd :: Int, + | AttrGravityHint { paStart :: Int, paEnd :: Int, paGravityHint :: PangoGravityHint } #endif deriving Show diff --git a/Graphics/Rendering/Pango/Types.chs b/Graphics/Rendering/Pango/Types.chs --- a/Graphics/Rendering/Pango/Types.chs +++ b/Graphics/Rendering/Pango/Types.chs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} -- -*-haskell-*- -- -------------------- automatically generated file - do not edit ---------- diff --git a/Gtk2HsSetup.hs b/Gtk2HsSetup.hs --- a/Gtk2HsSetup.hs +++ b/Gtk2HsSetup.hs @@ -6,9 +6,9 @@ -- | Build a Gtk2hs package. -- -module Gtk2HsSetup ( - gtk2hsUserHooks, - getPkgConfigPackages, +module Gtk2HsSetup ( + gtk2hsUserHooks, + getPkgConfigPackages, checkGtk2hsBuildtools, typeGenProgram, signalGenProgram, @@ -56,7 +56,8 @@ import Distribution.Verbosity import Control.Monad (when, unless, filterM, liftM, forM, forM_) import Data.Maybe ( isJust, isNothing, fromMaybe, maybeToList, catMaybes ) -import Data.List (isPrefixOf, isSuffixOf, stripPrefix, nub, tails ) +import Data.List (isPrefixOf, isSuffixOf, nub, minimumBy, stripPrefix, tails ) +import Data.Ord as Ord (comparing) import Data.Char (isAlpha, isNumber) import qualified Data.Map as M import qualified Data.Set as S @@ -113,9 +114,16 @@ fixLibs :: [FilePath] -> [String] -> [String] fixLibs dlls = concatMap $ \ lib -> case filter (isLib lib) dlls of - dll:_ -> [dropExtension dll] - _ -> if lib == "z" then [] else [lib] + dlls@(_:_) -> [dropExtension (pickDll dlls)] + _ -> if lib == "z" then [] else [lib] where + -- If there are several .dll files matching the one we're after then we + -- just have to guess. For example for recent Windows cairo builds we get + -- libcairo-2.dll libcairo-gobject-2.dll libcairo-script-interpreter-2.dll + -- Our heuristic is to pick the one with the shortest name. + -- Yes this is a hack but the proper solution is hard: we would need to + -- parse the .a file and see which .dll file(s) it needed to link to. + pickDll = minimumBy (Ord.comparing length) isLib lib dll = case stripPrefix ("lib"++lib) dll of Just ('.':_) -> True @@ -154,9 +162,9 @@ register :: PackageDescription -> LocalBuildInfo -> RegisterFlags -- ^Install in the user's database?; verbose -> IO () -register pkg@(library -> Just lib ) - lbi@(libraryConfig -> Just clbi) regFlags +register pkg@PackageDescription { library = Just lib } lbi regFlags = do + let clbi = LBI.getComponentLocalBuildInfo lbi LBI.CLibName installedPkgInfoRaw <- generateRegistrationInfo verbosity pkg lib lbi clbi inplace distPref @@ -168,7 +176,7 @@ -- Three different modes: case () of - _ | modeGenerateRegFile -> die "Generate Reg File not supported" + _ | modeGenerateRegFile -> writeRegistrationFile installedPkgInfo | modeGenerateRegScript -> die "Generate Reg Script not supported" | otherwise -> registerPackage verbosity installedPkgInfo pkg lbi inplace @@ -180,6 +188,8 @@ where modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags)) + regFile = fromMaybe (display (packageId pkg) <.> "conf") + (fromFlag (regGenPkgConf regFlags)) modeGenerateRegScript = fromFlag (regGenScript regFlags) inplace = fromFlag (regInPlace regFlags) packageDbs = nub $ withPackageDB lbi @@ -188,6 +198,10 @@ distPref = fromFlag (regDistPref regFlags) verbosity = fromFlag (regVerbosity regFlags) + writeRegistrationFile installedPkgInfo = do + notice verbosity ("Creating package registration file: " ++ regFile) + writeUTF8File regFile (showInstalledPackageInfo installedPkgInfo) + register _ _ regFlags = notice verbosity "No package to register" where verbosity = fromFlag (regVerbosity regFlags) @@ -275,11 +289,11 @@ -- a modules that does not have a .chi file mFiles <- mapM (findFileWithExtension' ["chi"] [buildDir lbi] . toFilePath) (PD.libModules lib) - + let files = [ f | Just f <- mFiles ] installOrdinaryFiles verbosity libPref files - + installCHI _ _ _ _ = return () ------------------------------------------------------------------------------ @@ -305,13 +319,12 @@ genSynthezisedFiles :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () genSynthezisedFiles verb pd lbi = do - cPkgs <- getPkgConfigPackages verb lbi pd let xList = maybe [] (customFieldsBI . libBuildInfo) (library pd) ++customFieldsPD pd typeOpts :: String -> [ProgArg] - typeOpts tag = concat [ map (\val -> '-':'-':drop (length tag) field++'=':val) (words content) + typeOpts tag = concat [ map (\val -> '-':'-':drop (length tag) field ++ '=':val) (words content) | (field,content) <- xList, tag `isPrefixOf` field, field /= (tag++"file")] @@ -319,8 +332,9 @@ | PackageIdentifier name (Version (major:minor:_) _) <- cPkgs , let name' = filter isAlpha (display name) , tag <- name' - : [ name' ++ "-" ++ show major ++ "." ++ show digit - | digit <- [0,2..minor] ] + :[ name' ++ "-" ++ show maj ++ "." ++ show d2 + | (maj, d2) <- [(maj, d2) | maj <- [0..(major-1)], d2 <- [0,2..20]] + ++ [(major, d2) | d2 <- [0,2..minor]] ] ] signalsOpts :: [ProgArg] @@ -346,6 +360,29 @@ info verb ("Ensuring that callback hooks in "++f++" are up-to-date.") genFile signalGenProgram signalsOpts f + writeFile "gtk2hs_macros.h" $ generateMacros cPkgs + +-- Based on Cabal/Distribution/Simple/Build/Macros.hs +generateMacros :: [PackageId] -> String +generateMacros cPkgs = concat $ + "/* DO NOT EDIT: This file is automatically generated by Gtk2HsSetup.hs */\n\n" : + [ concat + ["/* package ",display pkgid," */\n" + ,"#define VERSION_",pkgname," ",show (display version),"\n" + ,"#define MIN_VERSION_",pkgname,"(major1,major2,minor) (\\\n" + ," (major1) < ",major1," || \\\n" + ," (major1) == ",major1," && (major2) < ",major2," || \\\n" + ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")" + ,"\n\n" + ] + | pkgid@(PackageIdentifier name version) <- cPkgs + , let (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0) + pkgname = map fixchar (display name) + ] + where fixchar '-' = '_' + fixchar '.' = '_' + fixchar c = c + --FIXME: Cabal should tell us the selected pkg-config package versions in the -- LocalBuildInfo or equivalent. -- In the mean time, ask pkg-config again. @@ -416,14 +453,14 @@ -- Extract the dependencies of this file. This is intentionally rather naive as it -- ignores CPP conditionals. We just require everything which means that the --- existance of a .chs module may not depend on some CPP condition. +-- existance of a .chs module may not depend on some CPP condition. extractDeps :: ModDep -> IO ModDep extractDeps md@ModDep { mdLocation = Nothing } = return md extractDeps md@ModDep { mdLocation = Just f } = withUTF8FileContents f $ \con -> do let findImports acc (('{':'#':xs):xxs) = case (dropWhile (' ' ==) xs) of ('i':'m':'p':'o':'r':'t':' ':ys) -> case simpleParse (takeWhile ('#' /=) ys) of - Just m -> findImports (m:acc) xxs + Just m -> findImports (m:acc) xxs Nothing -> die ("cannot parse chs import in "++f++":\n"++ "offending line is {#"++xs) -- no more imports after the first non-import hook @@ -457,8 +494,8 @@ return (programName prog, location) ) programs let printError name = do - putStrLn $ "Cannot find " ++ name ++ "\n" + putStrLn $ "Cannot find " ++ name ++ "\n" ++ "Please install `gtk2hs-buildtools` first and check that the install directory is in your PATH (e.g. HOME/.cabal/bin)." exitFailure forM_ programInfos $ \ (name, location) -> - when (isNothing location) (printError name) + when (isNothing location) (printError name) diff --git a/SetupWrapper.hs b/SetupWrapper.hs --- a/SetupWrapper.hs +++ b/SetupWrapper.hs @@ -9,7 +9,7 @@ import Distribution.Simple.Program import Distribution.Simple.Compiler import Distribution.Simple.BuildPaths (exeExtension) -import Distribution.Simple.Configure (configCompiler) +import Distribution.Simple.Configure (configCompilerEx) import Distribution.Simple.GHC (getInstalledPackages) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Version @@ -115,7 +115,7 @@ when outOfDate $ do debug verbosity "Setup script is out of date, compiling..." - (comp, conf) <- configCompiler (Just GHC) Nothing Nothing + (comp, _, conf) <- configCompilerEx (Just GHC) Nothing Nothing defaultProgramConfiguration verbosity cabalLibVersion <- cabalLibVersionToUse comp conf let cabalPkgid = PackageIdentifier (PackageName "Cabal") cabalLibVersion diff --git a/pango.cabal b/pango.cabal --- a/pango.cabal +++ b/pango.cabal @@ -1,5 +1,5 @@ Name: pango -Version: 0.12.5.3 +Version: 0.13.0.0 License: LGPL-2.1 License-file: COPYING Copyright: (c) 2001-2010 The Gtk2Hs Team @@ -9,7 +9,7 @@ Cabal-Version: >= 1.8 Stability: stable homepage: http://projects.haskell.org/gtk2hs/ -bug-reports: http://hackage.haskell.org/trac/gtk2hs/ +bug-reports: https://github.com/gtk2hs/gtk2hs/issues Synopsis: Binding to the Pango text rendering engine. Description: This package provides a wrapper around the Pango C library that allows high-quality rendering of Unicode text. It can be used @@ -42,8 +42,9 @@ Library build-depends: base >= 4 && < 5, process, directory, array, containers, pretty, mtl, - glib >= 0.12.5.3 && < 0.13, - cairo >= 0.12.5.3 && < 0.13 + glib >= 0.13.0.0 && < 0.14, + cairo >= 0.13.0.0 && < 0.14, + text >= 0.11.0.6 && < 1.2 if flag(new-exception) build-depends: base >= 4 @@ -51,7 +52,7 @@ else build-depends: base < 4 - build-tools: gtk2hsC2hs >= 0.13.8, gtk2hsTypeGen + build-tools: gtk2hsC2hs >= 0.13.11, gtk2hsTypeGen exposed-modules: Graphics.Rendering.Pango Graphics.Rendering.Pango.Font @@ -73,6 +74,7 @@ x-c2hs-Header: hspango.h includes: hspango.h include-dirs: . + cpp-options: -U__BLOCKS__ -- Pango 1.26 has a mysterious bug that makes it go into an infinite -- loop. Don't allow the user to build against this version. (Omit the -- >= 1.0 constraint in this case since Cabal 1.6 can't parse it.)