{-# LANGUAGE CPP #-}
module Xmobar.Draw.Cairo (drawSegments) where
import qualified Data.Colour.SRGB as SRGB
import qualified Data.Colour.Names as CNames
import Control.Monad (foldM, when)
import qualified Graphics.Rendering.Cairo as Cairo
import qualified Graphics.Rendering.Pango as Pango
import Graphics.Rendering.Cairo.Types(Surface)
import qualified Xmobar.Config.Types as C
import qualified Xmobar.Config.Parse as ConfigParse
import qualified Xmobar.Text.Pango as TextPango
import qualified Xmobar.Draw.Boxes as Boxes
import qualified Xmobar.Draw.Types as T
type Renderinfo = (C.Segment, Surface -> Double -> Double -> IO (), Double)
type BoundedBox = (Double, Double, [C.Box])
type Acc = (Double, T.Actions, [BoundedBox])
readColourName :: String -> (SRGB.Colour Double, Double)
readColourName :: String -> (Colour Double, Double)
readColourName String
str =
case String -> Maybe (Colour Double)
forall (m :: * -> *) a.
(MonadFail m, Monad m, Ord a, Floating a) =>
String -> m (Colour a)
CNames.readColourName String
str of
Just Colour Double
c -> (Colour Double
c, Double
1.0)
Maybe (Colour Double)
Nothing -> case ReadS (Colour Double)
forall b. (Ord b, Floating b) => ReadS (Colour b)
SRGB.sRGB24reads String
str of
[(Colour Double
c, String
"")] -> (Colour Double
c, Double
1.0)
[(Colour Double
c,String
d)] -> (Colour Double
c, String -> Double
forall a. Read a => String -> a
read (String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d))
[(Colour Double, String)]
_ -> (Colour Double
forall a. (Ord a, Floating a) => Colour a
CNames.white, Double
1.0)
setSourceColor :: (SRGB.Colour Double, Double) -> Cairo.Render ()
setSourceColor :: (Colour Double, Double) -> Render ()
setSourceColor (Colour Double
colour, Double
alph) =
if Double
alph Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 then Double -> Double -> Double -> Double -> Render ()
Cairo.setSourceRGBA Double
r Double
g Double
b Double
alph else Double -> Double -> Double -> Render ()
Cairo.setSourceRGB Double
r Double
g Double
b
where rgb :: RGB Double
rgb = Colour Double -> RGB Double
forall b. (Ord b, Floating b) => Colour b -> RGB b
SRGB.toSRGB Colour Double
colour
r :: Double
r = RGB Double -> Double
forall a. RGB a -> a
SRGB.channelRed RGB Double
rgb
g :: Double
g = RGB Double -> Double
forall a. RGB a -> a
SRGB.channelGreen RGB Double
rgb
b :: Double
b = RGB Double -> Double
forall a. RGB a -> a
SRGB.channelBlue RGB Double
rgb
renderLines :: String -> Double -> [Boxes.Line] -> Cairo.Render ()
renderLines :: String -> Double -> [Line] -> Render ()
renderLines String
color Double
wd [Line]
lns = do
(Colour Double, Double) -> Render ()
setSourceColor (String -> (Colour Double, Double)
readColourName String
color)
Double -> Render ()
Cairo.setLineWidth Double
wd
(Line -> Render ()) -> [Line] -> Render ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Double
x0, Double
y0, Double
x1, Double
y1) ->
Double -> Double -> Render ()
Cairo.moveTo Double
x0 Double
y0 Render () -> Render () -> Render ()
forall a b. Render a -> Render b -> Render b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Double -> Render ()
Cairo.lineTo Double
x1 Double
y1 Render () -> Render () -> Render ()
forall a b. Render a -> Render b -> Render b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Render ()
Cairo.stroke) [Line]
lns
segmentMarkup :: C.Config -> C.Segment -> String
segmentMarkup :: Config -> Segment -> String
segmentMarkup Config
conf (C.Text String
txt, TextRenderInfo
info, Int
idx, Maybe [Action]
_actions) =
let fnt :: String
fnt = String -> String
TextPango.fixXft (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Config -> Int -> String
ConfigParse.indexedFont Config
conf Int
idx
(String
fg, String
bg) = Config -> String -> (String, String)
ConfigParse.colorComponents Config
conf (TextRenderInfo -> String
C.tColorsString TextRenderInfo
info)
attrs :: [SpanAttribute]
attrs = [String -> SpanAttribute
Pango.FontDescr String
fnt, String -> SpanAttribute
Pango.FontForeground String
fg]
attrs' :: [SpanAttribute]
attrs' = if String
bg String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Config -> String
C.bgColor Config
conf
then [SpanAttribute]
attrs
else String -> SpanAttribute
Pango.FontBackground String
bgSpanAttribute -> [SpanAttribute] -> [SpanAttribute]
forall a. a -> [a] -> [a]
:[SpanAttribute]
attrs
in [SpanAttribute] -> String -> String
Pango.markSpan [SpanAttribute]
attrs' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall string. GlibString string => string -> string
Pango.escapeMarkup String
txt
segmentMarkup Config
_ Segment
_ = String
""
withRenderinfo :: Pango.PangoContext -> T.DrawContext -> C.Segment -> IO Renderinfo
withRenderinfo :: PangoContext -> DrawContext -> Segment -> IO Renderinfo
withRenderinfo PangoContext
ctx DrawContext
dctx seg :: Segment
seg@(C.Text String
_, TextRenderInfo
inf, Int
idx, Maybe [Action]
a) = do
let conf :: Config
conf = DrawContext -> Config
T.dcConfig DrawContext
dctx
lyt <- PangoContext -> IO PangoLayout
Pango.layoutEmpty PangoContext
ctx
mk <- Pango.layoutSetMarkup lyt (segmentMarkup conf seg) :: IO String
(_, Pango.PangoRectangle o u w h) <- Pango.layoutGetExtents lyt
let voff' = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Config -> Int -> Int
ConfigParse.indexedOffset Config
conf Int
idx
voff = Double
voff' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (DrawContext -> Double
T.dcHeight DrawContext
dctx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
u) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2.0
wd = Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
o
slyt Surface
s Double
off Double
mx = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
off Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
mx) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
PangoLayout -> EllipsizeMode -> IO ()
Pango.layoutSetEllipsize PangoLayout
lyt EllipsizeMode
Pango.EllipsizeEnd
PangoLayout -> Maybe Double -> IO ()
Pango.layoutSetWidth PangoLayout
lyt (Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Double
mx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
off)
Surface -> Render () -> IO ()
forall (m :: * -> *) a. MonadIO m => Surface -> Render a -> m a
Cairo.renderWith Surface
s (Render () -> IO ()) -> Render () -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Render ()
Cairo.moveTo Double
off Double
voff Render () -> Render () -> Render ()
forall a b. Render a -> Render b -> Render b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PangoLayout -> Render ()
Pango.showLayout PangoLayout
lyt
return ((C.Text mk, inf, idx, a), slyt, wd)
withRenderinfo PangoContext
_ DrawContext
_ seg :: Segment
seg@(C.Hspace Int32
w, TextRenderInfo
_, Int
_, Maybe [Action]
_) =
Renderinfo -> IO Renderinfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Segment
seg, \Surface
_ Double
_ Double
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (), Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
w)
withRenderinfo PangoContext
_ DrawContext
dctx seg :: Segment
seg@(C.Icon String
p, TextRenderInfo
info, Int
_, Maybe [Action]
_) = do
let (Double
wd, Double
_) = DrawContext -> IconLookup
T.dcIconLookup DrawContext
dctx String
p
ioff :: Int
ioff = Config -> Int
C.iconOffset (DrawContext -> Config
T.dcConfig DrawContext
dctx)
vpos :: Double
vpos = DrawContext -> Double
T.dcHeight DrawContext
dctx Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ioff
conf :: Config
conf = DrawContext -> Config
T.dcConfig DrawContext
dctx
(String
fg, String
bg) = Config -> String -> (String, String)
ConfigParse.colorComponents Config
conf (TextRenderInfo -> String
C.tColorsString TextRenderInfo
info)
render :: p -> Double -> Double -> IO ()
render p
_ Double
off Double
mx = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
off Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
wd Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
mx) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
DrawContext -> IconDrawer
T.dcIconDrawer DrawContext
dctx Double
off Double
vpos String
p String
fg String
bg
Renderinfo -> IO Renderinfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Segment
seg, Surface -> Double -> Double -> IO ()
forall {p}. p -> Double -> Double -> IO ()
render, Double
wd)
drawBox :: T.DrawContext -> Surface -> Double -> Double -> C.Box -> IO ()
drawBox :: DrawContext -> Surface -> Double -> Double -> Box -> IO ()
drawBox DrawContext
dctx Surface
surf Double
x0 Double
x1 box :: Box
box@(C.Box BoxBorder
_ BoxOffset
_ CInt
w String
color BoxMargins
_) =
Surface -> Render () -> IO ()
forall (m :: * -> *) a. MonadIO m => Surface -> Render a -> m a
Cairo.renderWith Surface
surf (Render () -> IO ()) -> Render () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> Double -> [Line] -> Render ()
renderLines String
color (CInt -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
w) (Box -> Double -> Double -> Double -> [Line]
Boxes.boxLines Box
box (DrawContext -> Double
T.dcHeight DrawContext
dctx) Double
x0 Double
x1)
drawSegmentBackground ::
T.DrawContext -> Surface -> C.TextRenderInfo -> Double -> Double -> IO ()
drawSegmentBackground :: DrawContext
-> Surface -> TextRenderInfo -> Double -> Double -> IO ()
drawSegmentBackground DrawContext
dctx Surface
surf TextRenderInfo
info Double
x0 Double
x1 =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
bg String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= Config -> String
C.bgColor Config
conf Bool -> Bool -> Bool
&& (Double
top Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
|| Double
bot Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Surface -> Render () -> IO ()
forall (m :: * -> *) a. MonadIO m => Surface -> Render a -> m a
Cairo.renderWith Surface
surf (Render () -> IO ()) -> Render () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(Colour Double, Double) -> Render ()
setSourceColor (String -> (Colour Double, Double)
readColourName String
bg)
Double -> Double -> Double -> Double -> Render ()
Cairo.rectangle Double
x0 Double
top (Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x0) (DrawContext -> Double
T.dcHeight DrawContext
dctx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
bot Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
top)
Render ()
Cairo.fillPreserve
where conf :: Config
conf = DrawContext -> Config
T.dcConfig DrawContext
dctx
(String
_, String
bg) = Config -> String -> (String, String)
ConfigParse.colorComponents Config
conf (TextRenderInfo -> String
C.tColorsString TextRenderInfo
info)
top :: Double
top = Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Double) -> Int32 -> Double
forall a b. (a -> b) -> a -> b
$ TextRenderInfo -> Int32
C.tBgTopOffset TextRenderInfo
info
bot :: Double
bot = Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Double) -> Int32 -> Double
forall a b. (a -> b) -> a -> b
$ TextRenderInfo -> Int32
C.tBgBottomOffset TextRenderInfo
info
drawSegment :: T.DrawContext -> Surface -> Double -> Acc -> Renderinfo -> IO Acc
drawSegment :: DrawContext -> Surface -> Double -> Acc -> Renderinfo -> IO Acc
drawSegment DrawContext
dctx Surface
surface Double
maxoff (Double
off, Actions
acts, [BoundedBox]
boxs) (Segment
segment, Surface -> Double -> Double -> IO ()
render, Double
lwidth) = do
let end :: Double
end = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
maxoff (Double
off Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
lwidth)
(Widget
_, TextRenderInfo
info, Int
_, Maybe [Action]
a) = Segment
segment
acts' :: Actions
acts' = case Maybe [Action]
a of Just [Action]
as -> ([Action]
as, Double
off, Double
end)([Action], Double, Double) -> Actions -> Actions
forall a. a -> [a] -> [a]
:Actions
acts; Maybe [Action]
_ -> Actions
acts
bs :: [Box]
bs = TextRenderInfo -> [Box]
C.tBoxes TextRenderInfo
info
boxs' :: [BoundedBox]
boxs' = if [Box] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Box]
bs then [BoundedBox]
boxs else (Double
off, Double
end, [Box]
bs)BoundedBox -> [BoundedBox] -> [BoundedBox]
forall a. a -> [a] -> [a]
:[BoundedBox]
boxs
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
end Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
off) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
DrawContext
-> Surface -> TextRenderInfo -> Double -> Double -> IO ()
drawSegmentBackground DrawContext
dctx Surface
surface TextRenderInfo
info Double
off Double
end
Surface -> Double -> Double -> IO ()
render Surface
surface Double
off Double
maxoff
Acc -> IO Acc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
off Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
lwidth, Actions
acts', [BoundedBox]
boxs')
renderOuterBorder :: C.Config -> Double -> Double -> Cairo.Render ()
renderOuterBorder :: Config -> Double -> Double -> Render ()
renderOuterBorder Config
conf Double
mw Double
mh = do
let (Double
x0, Double
y0, Double
w, Double
h) = Border -> Double -> Double -> Line
Boxes.borderRect (Config -> Border
C.border Config
conf) Double
mw Double
mh
(Colour Double, Double) -> Render ()
setSourceColor (String -> (Colour Double, Double)
readColourName (Config -> String
C.borderColor Config
conf))
Double -> Render ()
Cairo.setLineWidth (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Config -> Int
C.borderWidth Config
conf))
Double -> Double -> Double -> Double -> Render ()
Cairo.rectangle Double
x0 Double
y0 Double
w Double
h
Render ()
Cairo.stroke
drawBorder :: C.Config -> Double -> Double -> Surface -> IO ()
drawBorder :: Config -> Double -> Double -> Surface -> IO ()
drawBorder Config
conf Double
w Double
h Surface
surf =
case Config -> Border
C.border Config
conf of
Border
C.NoBorder -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Border
_ -> Surface -> Render () -> IO ()
forall (m :: * -> *) a. MonadIO m => Surface -> Render a -> m a
Cairo.renderWith Surface
surf (Config -> Double -> Double -> Render ()
renderOuterBorder Config
conf Double
w Double
h)
drawBBox :: T.DrawContext -> Surface -> BoundedBox -> IO ()
drawBBox :: DrawContext -> Surface -> BoundedBox -> IO ()
drawBBox DrawContext
dctx Surface
surf (Double
from, Double
to, [Box]
bs) = (Box -> IO ()) -> [Box] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (DrawContext -> Surface -> Double -> Double -> Box -> IO ()
drawBox DrawContext
dctx Surface
surf Double
from Double
to) [Box]
bs
drawBoxes :: T.DrawContext -> Surface -> [BoundedBox] -> IO ()
drawBoxes :: DrawContext -> Surface -> [BoundedBox] -> IO ()
drawBoxes DrawContext
dctx Surface
surf ((Double
from, Double
to, [Box]
b):(Double
from', Double
to', [Box]
b'):[BoundedBox]
bxs) =
if Double
to Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
from' Bool -> Bool -> Bool
|| [Box]
b [Box] -> [Box] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Box]
b'
then do DrawContext -> Surface -> BoundedBox -> IO ()
drawBBox DrawContext
dctx Surface
surf (Double
from, Double
to, [Box]
b)
DrawContext -> Surface -> [BoundedBox] -> IO ()
drawBoxes DrawContext
dctx Surface
surf ([BoundedBox] -> IO ()) -> [BoundedBox] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Double
from', Double
to', [Box]
b')BoundedBox -> [BoundedBox] -> [BoundedBox]
forall a. a -> [a] -> [a]
:[BoundedBox]
bxs
else DrawContext -> Surface -> [BoundedBox] -> IO ()
drawBoxes DrawContext
dctx Surface
surf ([BoundedBox] -> IO ()) -> [BoundedBox] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Double
from, Double
to', [Box]
b')BoundedBox -> [BoundedBox] -> [BoundedBox]
forall a. a -> [a] -> [a]
:[BoundedBox]
bxs
drawBoxes DrawContext
dctx Surface
surf [BoundedBox
bi] = DrawContext -> Surface -> BoundedBox -> IO ()
drawBBox DrawContext
dctx Surface
surf BoundedBox
bi
drawBoxes DrawContext
_ Surface
_ [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#ifndef XRENDER
drawCairoBackground :: T.DrawContext -> Surface -> IO ()
drawCairoBackground dctx surf = do
let (c, _) = readColourName (C.bgColor (T.dcConfig dctx))
Cairo.renderWith surf $ setSourceColor (c, 1.0) >> Cairo.paint
#endif
drawSegments :: T.DrawContext -> Surface -> IO T.Actions
drawSegments :: DrawContext -> Surface -> IO Actions
drawSegments DrawContext
dctx Surface
surf = do
let segs :: [[Segment]]
segs = Int -> [[Segment]] -> [[Segment]]
forall a. Int -> [a] -> [a]
take Int
3 ([[Segment]] -> [[Segment]]) -> [[Segment]] -> [[Segment]]
forall a b. (a -> b) -> a -> b
$ DrawContext -> [[Segment]]
T.dcSegments DrawContext
dctx [[Segment]] -> [[Segment]] -> [[Segment]]
forall a. [a] -> [a] -> [a]
++ [Segment] -> [[Segment]]
forall a. a -> [a]
repeat []
dh :: Double
dh = DrawContext -> Double
T.dcHeight DrawContext
dctx
dw :: Double
dw = DrawContext -> Double
T.dcWidth DrawContext
dctx
conf :: Config
conf = DrawContext -> Config
T.dcConfig DrawContext
dctx
sWidth :: [(a, b, Double)] -> Double
sWidth = (Double -> (a, b, Double) -> Double)
-> Double -> [(a, b, Double)] -> Double
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Double
a (a
_,b
_,Double
w) -> Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w) Double
0
ctx <- Maybe FontMap -> IO PangoContext
Pango.cairoCreateContext Maybe FontMap
forall a. Maybe a
Nothing
Pango.cairoContextSetResolution ctx $ C.dpi conf
llyts <- mapM (withRenderinfo ctx dctx) (head segs)
rlyts <- mapM (withRenderinfo ctx dctx) (segs !! 2)
clyts <- mapM (withRenderinfo ctx dctx) (segs !! 1)
#ifndef XRENDER
drawCairoBackground dctx surf
#endif
(lend, as, bx) <- foldM (drawSegment dctx surf dw) (0, [], []) llyts
let rw = [Renderinfo] -> Double
forall {a} {b}. [(a, b, Double)] -> Double
sWidth [Renderinfo]
rlyts
cw = [Renderinfo] -> Double
forall {a} {b}. [(a, b, Double)] -> Double
sWidth [Renderinfo]
clyts
rstart = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
lend (Double
dw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
rw)
cstart = if Double
lend Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1 Bool -> Bool -> Bool
|| Double
rw Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 then Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
lend ((Double
dw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
cw) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2.0) else Double
lend
(_, as', bx') <- if cw > 0
then foldM (drawSegment dctx surf rstart) (cstart, as, bx) clyts
else return (0, as, bx)
(_, as'', bx'') <- foldM (drawSegment dctx surf dw) (rstart, as', bx') rlyts
drawBoxes dctx surf (reverse bx'')
when (C.borderWidth conf > 0) (drawBorder conf dw dh surf)
return as''