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 (Int -> Placement -> ShowS
[Placement] -> ShowS
Placement -> String
(Int -> Placement -> ShowS)
-> (Placement -> String)
-> ([Placement] -> ShowS)
-> Show Placement
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]
(Int -> ReadS Placement)
-> ReadS [Placement]
-> ReadPrec Placement
-> ReadPrec [Placement]
-> Read 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 = ([Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Bool]] -> [Bool]
forall a. [a] -> a
head [[Bool]]
img), [[Bool]] -> Int
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]]
_ = (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
x, Int -> Position
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 (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
x Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
icon_w, Int -> Position
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 (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
x, Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Dimension
h Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Dimension
2) Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Int
icon_h Int -> Int -> Int
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 (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
x Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
icon_w, Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Dimension
h Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Dimension
2) Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Int
icon_h Int -> Int -> Int
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 = ([Bool] -> [(Position, Bool)]) -> [[Bool]] -> [[(Position, Bool)]]
forall a b. (a -> b) -> [a] -> [b]
map ([Position] -> [Bool] -> [(Position, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Position -> Position) -> Position -> [Position]
forall a. (a -> a) -> a -> [a]
iterate (Position
1Position -> Position -> Position
forall a. Num a => a -> a -> a
+) Position
0)) [[Bool]]
icon
filtered_inside :: [[Position]]
filtered_inside = ([(Position, Bool)] -> [Position])
-> [[(Position, Bool)]] -> [[Position]]
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 = [Position] -> [[Position]] -> [(Position, [Position])]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Position -> Position) -> Position -> [Position]
forall a. (a -> a) -> a -> [a]
iterate (Position
1Position -> Position -> Position
forall 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 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
x) (Position
b Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
y)
movePoints :: Position -> Position -> [Point] -> [Point]
movePoints :: Position -> Position -> [Point] -> [Point]
movePoints Position
x Position
y = (Point -> Point) -> [Point] -> [Point]
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 <- Display -> String -> m Drawable
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display -> String -> m Drawable
stringToPixel Display
dpy String
fc
Drawable
bcolor <- Display -> String -> m Drawable
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display -> String -> m Drawable
stringToPixel Display
dpy String
bc
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Display -> GC -> Drawable -> IO ()
setForeground Display
dpy GC
gc Drawable
bcolor
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> m ()) -> IO () -> m ()
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 (Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
i_w) (Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
i_h)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Display -> GC -> Drawable -> IO ()
setForeground Display
dpy GC
gc Drawable
fcolor
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> m ()) -> IO () -> m ()
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