From 0c2f42e50dbc86cacffc9c087e0a97c85c39b6c9 Mon Sep 17 00:00:00 2001 From: Travis Staton Date: Wed, 10 Sep 2014 13:16:35 -0400 Subject: Add ability to set border width --- src/Window.hs | 41 +++++++++++++++++++++++++++++------------ 1 file changed, 29 insertions(+), 12 deletions(-) (limited to 'src/Window.hs') diff --git a/src/Window.hs b/src/Window.hs index f7e1801..95ad3a3 100644 --- a/src/Window.hs +++ b/src/Window.hs @@ -164,20 +164,22 @@ getStaticStrutValues (Static cx cy cw ch) rwh xe = xs + cw getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] -drawBorder :: Border -> Display -> Drawable -> GC -> Pixel +drawBorder :: Border -> Int -> Display -> Drawable -> GC -> Pixel -> Dimension -> Dimension -> IO () -drawBorder b d p gc c wi ht = case b of +drawBorder b lw d p gc c wi ht = case b of NoBorder -> return () - TopB -> drawBorder (TopBM 0) d p gc c w h - BottomB -> drawBorder (BottomBM 0) d p gc c w h - FullB -> drawBorder (FullBM 0) d p gc c w h - TopBM m -> sf >> drawLine d p gc 0 (fi m) (fi w) 0 - BottomBM m -> let rw = fi h - fi m in - sf >> drawLine d p gc 0 rw (fi w) rw - FullBM m -> let pad = 2 * fi m; mp = fi m in - sf >> drawRectangle d p gc mp mp (w - pad) (h - pad) - where sf = setForeground d gc c - (w, h) = (wi - 1, ht - 1) + TopB -> drawBorder (TopBM 0) lw d p gc c wi ht + BottomB -> drawBorder (BottomBM 0) lw d p gc c wi ht + FullB -> drawBorder (FullBM 0) lw d p gc c wi ht + TopBM m -> sf >> sla >> drawLine d p gc 0 (fi m + boff) (fi wi) (fi m + boff) + BottomBM m -> let rw = fi ht - fi m + boff in + sf >> sla >> drawLine d p gc 0 rw (fi wi) rw + FullBM m -> let pad = 2 * fi m + 2 * fi boff'; mp = fi m + fi boff' in + sf >> sla >> drawRectangle d p gc mp mp (wi - pad) (ht - pad) + where sf = setForeground d gc c + sla = setLineAttributes d gc (fi lw) lineSolid capNotLast joinMiter + boff = borderOffset b lw + boff' = calcBorderOffset lw :: Int hideWindow :: Display -> Window -> IO () hideWindow d w = do @@ -193,3 +195,18 @@ showWindow r c d w = do isMapped :: Display -> Window -> IO Bool isMapped d w = ism <$> getWindowAttributes d w where ism (WindowAttributes { wa_map_state = wms }) = wms /= waIsUnmapped + +borderOffset :: (Integral a) => Border -> Int -> a +borderOffset b lw = + case b of + BottomB -> negate boffs + BottomBM _ -> negate boffs + TopB -> boffs + TopBM _ -> boffs + _ -> 0 + where boffs = calcBorderOffset lw + +calcBorderOffset :: (Integral a) => Int -> a +calcBorderOffset = ceiling . (/2) . toDouble + where toDouble = fi :: (Integral a) => a -> Double + -- cgit v1.2.3