diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/MinXft.hsc | 45 | ||||
| -rw-r--r-- | src/XUtil.hsc | 6 |
2 files changed, 29 insertions, 22 deletions
diff --git a/src/MinXft.hsc b/src/MinXft.hsc index 3d3aadf..b2299af 100644 --- a/src/MinXft.hsc +++ b/src/MinXft.hsc @@ -2,7 +2,7 @@ ------------------------------------------------------------------------------ -- | -- Module: MinXft --- Copyright: (c) 2012 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2012, 2014 Jose Antonio Ortega Ruiz -- (c) Clemens Fruhwirth <clemens@endorphin.org> 2007 -- License: BSD3-style (see LICENSE) -- @@ -106,7 +106,7 @@ xftTxtExtents d f string = peek cglyph xftTxtExtents' :: Display -> [AXftFont] -> String -> IO XGlyphInfo -xftTxtExtents' d fs string = do +xftTxtExtents' d fs string = do chunks <- getChunks d fs string let (_, _, gi, _, _) = last chunks return gi @@ -162,47 +162,54 @@ drawXftString d c f x y string = withArrayLen (map fi (UTF8.encode string)) (\len ptr -> cXftDrawStringUtf8 d c f (fi x) (fi y) ptr (fi len)) -drawXftString' :: (Integral a1, Integral a) => - AXftDraw -> AXftColor -> [AXftFont] -> a -> a1 -> String -> IO () +drawXftString' :: AXftDraw -> + AXftColor -> + [AXftFont] -> + Integer -> + Integer -> + String -> IO () drawXftString' d c fs x y string = do display <- c_xftDrawDisplay d chunks <- getChunks display fs string - mapM_ (\(f, s, gi, xo, yo) -> drawXftString d c f (x+xo) (y+yo) s) chunks + mapM_ (\(f, s, _, xo, yo) -> drawXftString d c f (x+xo) (y+yo) s) chunks -- Split string and determine fonts/offsets for individual parts +getChunks :: Display -> [AXftFont] -> [Char] -> + IO [(AXftFont, String, XGlyphInfo, Integer, Integer)] getChunks disp fts str = do chunks <- getFonts disp fts str - getOffsets disp (XGlyphInfo 0 0 0 0 0 0) chunks + getOffsets (XGlyphInfo 0 0 0 0 0 0) chunks where -- Split string and determine fonts for individual parts getFonts _ [] _ = return [] getFonts _ _ [] = return [] - getFonts _ [ft] str = return [(ft, str)] - getFonts disp fonts@(ft:fts) str = do + getFonts _ [ft] s = return [(ft, s)] + getFonts d fonts@(ft:_) s = do -- Determine which glyph can be rendered by current font - glyphs <- mapM (xftCharExists disp ft) str + glyphs <- mapM (xftCharExists d ft) s -- Split string into parts that can/cannot be rendered - let splits = split (runs glyphs) str + let splits = split (runs glyphs) s -- Determine which font to render each chunk with - concat `fmap` mapM (getFont disp fonts) splits + concat `fmap` mapM (getFont d fonts) splits -- Determine fonts for substrings - getFont _ [ft] (_, str) = return [(ft, str)] -- Last font, use it - getFont _ (ft:fts) (True, str) = return [(ft, str)] -- Current font can render this substring - getFont disp (ft:fts) (False, str) = getFonts disp fts str -- Fallback to next font + getFont _ [] _ = return [] + getFont _ [ft] (_, s) = return [(ft, s)] -- Last font, use it + getFont _ (ft:_) (True, s) = return [(ft, s)] -- Current font can render this substring + getFont d (_:fs) (False, s) = getFonts d fs s -- Fallback to next font -- Helpers runs [] = [] runs (x:xs) = let (h, t) = span (==x) xs in (x, length h + 1) : runs t split [] _ = [] - split ((x, c):xs) str = let (h, t) = splitAt c str in (x, h) : split xs t + split ((x, c):xs) s = let (h, t) = splitAt c s in (x, h) : split xs t -- Determine coordinates for chunks using extents - getOffsets disp _ [] = return [] - getOffsets disp (XGlyphInfo w h x y xo yo) ((f, s):chunks) = do - (XGlyphInfo w' h' x' y' xo' yo') <- xftTxtExtents disp f s + getOffsets _ [] = return [] + getOffsets (XGlyphInfo _ _ x y xo yo) ((f, s):chunks) = do + (XGlyphInfo w' h' _ _ xo' yo') <- xftTxtExtents disp f s let gi = XGlyphInfo (xo+w') (yo+h') x y (xo+xo') (yo+yo') - rest <- getOffsets disp gi chunks + rest <- getOffsets gi chunks return $ (f, s, gi, fromIntegral xo, fromIntegral yo) : rest foreign import ccall "XftDrawRect" diff --git a/src/XUtil.hsc b/src/XUtil.hsc index b1611d6..1217452 100644 --- a/src/XUtil.hsc +++ b/src/XUtil.hsc @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : XUtil --- Copyright : (C) 2011, 2012, 2013 Jose Antonio Ortega Ruiz +-- Copyright : (C) 2011, 2012, 2013, 2014 Jose Antonio Ortega Ruiz -- (C) 2007 Andrea Rossato -- License : BSD3 -- @@ -124,7 +124,7 @@ initXftFont d s = do let fontNames = wordsBy (== ',') (drop 4 s) fonts <- mapM openFont fontNames return fonts - where + where openFont fontName = do f <- openAXftFont d (defaultScreenOfDisplay d) fontName addFinalizer f (closeAXftFont d f) @@ -185,7 +185,7 @@ printString dpy drw fs@(Xft fonts) _ fc bc x y s = do (y - (a + d) + 1) (xglyphinfo_xOff gi) (a + d)) >> - (drawXftString' draw fc' fonts x (y - 2) s) + (drawXftString' draw fc' fonts (toInteger x) (toInteger (y - 2)) s) #endif |