module XMonad.Util.Image
(
Placement(..),
iconPosition,
drawIcon,
) where
import XMonad
import XMonad.Prelude
import XMonad.Util.Font (stringToPixel)
data Placement = OffsetLeft Int Int
| OffsetRight Int Int
| CenterLeft Int
| CenterRight Int
deriving (Int -> Placement -> ShowS
[Placement] -> ShowS
Placement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Placement] -> ShowS
$cshowList :: [Placement] -> ShowS
show :: Placement -> String
$cshow :: Placement -> String
showsPrec :: Int -> Placement -> ShowS
$cshowsPrec :: Int -> Placement -> ShowS
Show, ReadPrec [Placement]
ReadPrec Placement
Int -> ReadS Placement
ReadS [Placement]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Placement]
$creadListPrec :: ReadPrec [Placement]
readPrec :: ReadPrec Placement
$creadPrec :: ReadPrec Placement
readList :: ReadS [Placement]
$creadList :: ReadS [Placement]
readsPrec :: Int -> ReadS Placement
$creadsPrec :: Int -> ReadS Placement
Read)
imageDims :: [[Bool]] -> (Int, Int)
imageDims :: [[Bool]] -> (Int, Int)
imageDims [[Bool]]
img = (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. a -> Maybe a -> a
fromMaybe [] (forall a. [a] -> Maybe a
listToMaybe [[Bool]]
img)), forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Bool]]
img)
iconPosition :: Rectangle -> Placement -> [[Bool]] -> (Position,Position)
iconPosition :: Rectangle -> Placement -> [[Bool]] -> (Position, Position)
iconPosition Rectangle{} (OffsetLeft Int
x Int
y) [[Bool]]
_ = (forall a b. (Integral a, Num b) => a -> b
fi Int
x, forall a b. (Integral a, Num b) => a -> b
fi Int
y)
iconPosition (Rectangle Position
_ Position
_ Dimension
w Dimension
_) (OffsetRight Int
x Int
y) [[Bool]]
icon =
let (Int
icon_w, Int
_) = [[Bool]] -> (Int, Int)
imageDims [[Bool]]
icon
in (forall a b. (Integral a, Num b) => a -> b
fi Dimension
w forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Int
x forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Int
icon_w, forall a b. (Integral a, Num b) => a -> b
fi Int
y)
iconPosition (Rectangle Position
_ Position
_ Dimension
_ Dimension
h) (CenterLeft Int
x) [[Bool]]
icon =
let (Int
_, Int
icon_h) = [[Bool]] -> (Int, Int)
imageDims [[Bool]]
icon
in (forall a b. (Integral a, Num b) => a -> b
fi Int
x, forall a b. (Integral a, Num b) => a -> b
fi (Dimension
h forall a. Integral a => a -> a -> a
`div` Dimension
2) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi (Int
icon_h forall a. Integral a => a -> a -> a
`div` Int
2))
iconPosition (Rectangle Position
_ Position
_ Dimension
w Dimension
h) (CenterRight Int
x) [[Bool]]
icon =
let (Int
icon_w, Int
icon_h) = [[Bool]] -> (Int, Int)
imageDims [[Bool]]
icon
in (forall a b. (Integral a, Num b) => a -> b
fi Dimension
w forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Int
x forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Int
icon_w, forall a b. (Integral a, Num b) => a -> b
fi (Dimension
h forall a. Integral a => a -> a -> a
`div` Dimension
2) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi (Int
icon_h forall a. Integral a => a -> a -> a
`div` Int
2))
iconToPoints :: [[Bool]] -> [Point]
iconToPoints :: [[Bool]] -> [Point]
iconToPoints [[Bool]]
icon =
let labels_inside :: [[(Position, Bool)]]
labels_inside = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. (a -> a) -> a -> [a]
iterate (Position
1forall a. Num a => a -> a -> a
+) Position
0)) [[Bool]]
icon
filtered_inside :: [[Position]]
filtered_inside = forall a b. (a -> b) -> [a] -> [b]
map (\[(Position, Bool)]
l -> [Position
x | (Position
x, Bool
t) <- [(Position, Bool)]
l, Bool
t]) [[(Position, Bool)]]
labels_inside
labels_outside :: [(Position, [Position])]
labels_outside = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. (a -> a) -> a -> [a]
iterate (Position
1forall a. Num a => a -> a -> a
+) Position
0) [[Position]]
filtered_inside
in [Position -> Position -> Point
Point Position
x Position
y | (Position
y, [Position]
l) <- [(Position, [Position])]
labels_outside, Position
x <- [Position]
l]
movePoint :: Position -> Position -> Point -> Point
movePoint :: Position -> Position -> Point -> Point
movePoint Position
x Position
y (Point Position
a Position
b) = Position -> Position -> Point
Point (Position
a forall a. Num a => a -> a -> a
+ Position
x) (Position
b forall a. Num a => a -> a -> a
+ Position
y)
movePoints :: Position -> Position -> [Point] -> [Point]
movePoints :: Position -> Position -> [Point] -> [Point]
movePoints Position
x Position
y = forall a b. (a -> b) -> [a] -> [b]
map (Position -> Position -> Point -> Point
movePoint Position
x Position
y)
drawIcon :: (Functor m, MonadIO m) => Display -> Drawable -> GC -> String
->String -> Position -> Position -> [[Bool]] -> m ()
drawIcon :: forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display
-> Drawable
-> GC
-> String
-> String
-> Position
-> Position
-> [[Bool]]
-> m ()
drawIcon Display
dpy Drawable
drw GC
gc String
fc String
bc Position
x Position
y [[Bool]]
icon = do
let (Int
i_w, Int
i_h) = [[Bool]] -> (Int, Int)
imageDims [[Bool]]
icon
Drawable
fcolor <- forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display -> String -> m Drawable
stringToPixel Display
dpy String
fc
Drawable
bcolor <- forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display -> String -> m Drawable
stringToPixel Display
dpy String
bc
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> GC -> Drawable -> IO ()
setForeground Display
dpy GC
gc Drawable
bcolor
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Drawable
-> GC
-> Position
-> Position
-> Dimension
-> Dimension
-> IO ()
fillRectangle Display
dpy Drawable
drw GC
gc Position
x Position
y (forall a b. (Integral a, Num b) => a -> b
fi Int
i_w) (forall a b. (Integral a, Num b) => a -> b
fi Int
i_h)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> GC -> Drawable -> IO ()
setForeground Display
dpy GC
gc Drawable
fcolor
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Drawable -> GC -> [Point] -> CoordinateMode -> IO ()
drawPoints Display
dpy Drawable
drw GC
gc (Position -> Position -> [Point] -> [Point]
movePoints Position
x Position
y ([[Bool]] -> [Point]
iconToPoints [[Bool]]
icon)) CoordinateMode
coordModeOrigin