module XMonad.Util.Image
(
Placement(..),
iconPosition,
drawIcon,
) where
import XMonad
import XMonad.Util.Font (stringToPixel,fi)
data Placement = OffsetLeft Int Int
| OffsetRight Int Int
| CenterLeft Int
| CenterRight Int
deriving (Show, Read)
imageDims :: [[Bool]] -> (Int, Int)
imageDims img = (length (head img), length img)
iconPosition :: Rectangle -> Placement -> [[Bool]] -> (Position,Position)
iconPosition (Rectangle _ _ _ _) (OffsetLeft x y) _ = (fi x, fi y)
iconPosition (Rectangle _ _ w _) (OffsetRight x y) icon =
let (icon_w, _) = imageDims icon
in (fi w - fi x - fi icon_w, fi y)
iconPosition (Rectangle _ _ _ h) (CenterLeft x) icon =
let (_, icon_h) = imageDims icon
in (fi x, fi (h `div` 2) - fi (icon_h `div` 2))
iconPosition (Rectangle _ _ w h) (CenterRight x) icon =
let (icon_w, icon_h) = imageDims icon
in (fi w - fi x - fi icon_w, fi (h `div` 2) - fi (icon_h `div` 2))
iconToPoints :: [[Bool]] -> [Point]
iconToPoints icon =
let labels_inside = map (zip (iterate (1+) 0)) icon
filtered_inside = map (\l -> [x | (x, t) <- l, t]) labels_inside
labels_outside = zip (iterate (1+) 0) filtered_inside
in [Point x y | (y, l) <- labels_outside, x <- l]
movePoint :: Position -> Position -> Point -> Point
movePoint x y (Point a b) = Point (a + x) (b + y)
movePoints :: Position -> Position -> [Point] -> [Point]
movePoints x y points = map (movePoint x y) points
drawIcon :: (Functor m, MonadIO m) => Display -> Drawable -> GC -> String
->String -> Position -> Position -> [[Bool]] -> m ()
drawIcon dpy drw gc fc bc x y icon = do
let (i_w, i_h) = imageDims icon
fcolor <- stringToPixel dpy fc
bcolor <- stringToPixel dpy bc
io $ setForeground dpy gc bcolor
io $ fillRectangle dpy drw gc x y (fi i_w) (fi i_h)
io $ setForeground dpy gc fcolor
io $ drawPoints dpy drw gc (movePoints x y (iconToPoints icon)) coordModeOrigin