----------------------------------------------------------------------------
-- |
-- 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
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)

-- $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 = (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)

-- | 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]]
_ = (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))

-- | 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 = 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]

-- | 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 forall a. Num a => a -> a -> a
+ Position
x) (Position
b 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 = 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 <- 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