----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.Image
-- Description :  Utilities for manipulating @[[Bool]]@ as images.
-- Copyright   :  (c) 2010 Alejandro Serrano
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  trupill@gmail.com
-- Stability   :  unstable
-- Portability :  unportable
--
-- Utilities for manipulating [[Bool]] as images
--
-----------------------------------------------------------------------------

module XMonad.Util.Image
    ( -- * Usage:
      -- $usage
      Placement(..),
      iconPosition,
      drawIcon,
    ) where

import XMonad
import XMonad.Prelude
import XMonad.Util.Font (stringToPixel)

-- | Placement of the icon in the title bar
data Placement = OffsetLeft Int Int   -- ^ An exact amount of pixels from the upper left corner
                 | OffsetRight Int Int  -- ^ An exact amount of pixels from the right left corner
                 | CenterLeft Int        -- ^ Centered in the y-axis, an amount of pixels from the left
                 | CenterRight Int       -- ^ Centered in the y-axis, an amount of pixels from the right
                   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
$cshowsPrec :: Int -> Placement -> ShowS
showsPrec :: Int -> Placement -> ShowS
$cshow :: Placement -> String
show :: Placement -> String
$cshowList :: [Placement] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS Placement
readsPrec :: Int -> ReadS Placement
$creadList :: ReadS [Placement]
readList :: ReadS [Placement]
$creadPrec :: ReadPrec Placement
readPrec :: ReadPrec Placement
$creadListPrec :: ReadPrec [Placement]
readListPrec :: ReadPrec [Placement]
Read)

-- $usage
-- This module uses matrices of boolean values as images. When drawing them,
-- a True value tells that we want the fore color, and a False value that we
-- want the background color to be painted.
-- In the module we suppose that those matrices are represented as [[Bool]],
-- so the lengths of the inner lists must be the same.
--
-- See "XMonad.Layout.Decoration" for usage examples

-- | Gets the ('width', 'height') of an image
imageDims :: [[Bool]] -> (Int, Int)
imageDims :: [[Bool]] -> (Int, Int)
imageDims [[Bool]]
img = ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Bool] -> Maybe [Bool] -> [Bool]
forall a. a -> Maybe a -> a
fromMaybe [] ([[Bool]] -> Maybe [Bool]
forall a. [a] -> Maybe a
listToMaybe [[Bool]]
img)), [[Bool]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Bool]]
img)

-- | Return the 'x' and 'y' positions inside a 'Rectangle' to start drawing
--   the image given its 'Placement'
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))

-- | Converts an image represented as [[Bool]] to a series of points
--   to be painted (the ones with True values)
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]

-- | Displaces a point ('a', 'b') along a vector ('x', 'y')
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)

-- | Displaces a list of points along a vector 'x', '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)

-- | Draw an image into a X surface
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