-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.Rectangle
-- Description :  A module for handling pixel rectangles.
-- Copyright   :  (c) 2018 Yclept Nemo
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :
-- Stability   :  unstable
-- Portability :  unportable
--
-- A module for handling pixel rectangles: 'Rectangle'.
--
-----------------------------------------------------------------------------


module XMonad.Util.Rectangle
    ( -- * Usage
      -- $usage
      PointRectangle (..)
    , pixelsToIndices, pixelsToCoordinates
    , indicesToRectangle, coordinatesToRectangle
    , empty
    , intersects
    , supersetOf
    , difference
    , withBorder
    , center
    , toRatio
    ) where

import           XMonad
import           XMonad.Prelude (fi)
import qualified XMonad.StackSet as W

import           Data.Ratio


-- $usage
-- > import XMonad.Util.Rectangle as R
-- > R.empty (Rectangle 0 0 1024 768)


-- | Rectangle as two points. What those points mean depends on the conversion
-- function.
data PointRectangle a = PointRectangle
    { forall a. PointRectangle a -> a
point_x1::a   -- ^ Point nearest to the origin.
    , forall a. PointRectangle a -> a
point_y1::a
    , forall a. PointRectangle a -> a
point_x2::a   -- ^ Point furthest from the origin.
    , forall a. PointRectangle a -> a
point_y2::a
    } deriving (PointRectangle a -> PointRectangle a -> Bool
forall a. Eq a => PointRectangle a -> PointRectangle a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PointRectangle a -> PointRectangle a -> Bool
$c/= :: forall a. Eq a => PointRectangle a -> PointRectangle a -> Bool
== :: PointRectangle a -> PointRectangle a -> Bool
$c== :: forall a. Eq a => PointRectangle a -> PointRectangle a -> Bool
Eq,ReadPrec [PointRectangle a]
ReadPrec (PointRectangle a)
ReadS [PointRectangle a]
forall a. Read a => ReadPrec [PointRectangle a]
forall a. Read a => ReadPrec (PointRectangle a)
forall a. Read a => Int -> ReadS (PointRectangle a)
forall a. Read a => ReadS [PointRectangle a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PointRectangle a]
$creadListPrec :: forall a. Read a => ReadPrec [PointRectangle a]
readPrec :: ReadPrec (PointRectangle a)
$creadPrec :: forall a. Read a => ReadPrec (PointRectangle a)
readList :: ReadS [PointRectangle a]
$creadList :: forall a. Read a => ReadS [PointRectangle a]
readsPrec :: Int -> ReadS (PointRectangle a)
$creadsPrec :: forall a. Read a => Int -> ReadS (PointRectangle a)
Read,Int -> PointRectangle a -> ShowS
forall a. Show a => Int -> PointRectangle a -> ShowS
forall a. Show a => [PointRectangle a] -> ShowS
forall a. Show a => PointRectangle a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PointRectangle a] -> ShowS
$cshowList :: forall a. Show a => [PointRectangle a] -> ShowS
show :: PointRectangle a -> String
$cshow :: forall a. Show a => PointRectangle a -> String
showsPrec :: Int -> PointRectangle a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PointRectangle a -> ShowS
Show)

-- | There are three possible ways to convert rectangles to pixels:
--
-- * Consider integers as "gaps" between pixels; pixels range from @(N,N+1)@,
-- exclusively: @(0,1)@, @(1,2)@, and so on. This leads to interval ambiguity:
-- whether an integer endpoint contains a pixel depends on which direction the
-- interval approaches the pixel. Consider the adjacent pixels @(0,1)@ and
-- @(1,2)@ where @1@ can refer to either pixel @(0,1)@ or pixel @(1,2)@.
--
-- * Consider integers to demarcate the start of each pixel; pixels range from
-- @[N,N+1)@: @[0,1)@, @[1,2)@, and so on - or equivalently: @(N,N+1]@. This is
-- the most flexible coordinate system, and the convention used by the
-- 'Rectangle' type.
--
-- * Consider integers to demarcate the center of each pixel; pixels range from
-- @[N,N+1]@, as though each real-valued coordinate had been rounded (either
-- down or up) to the nearest integers. So each pixel, from zero, is listed as:
-- @[0,0]@, @[1,1]@, @[2,2]@, and so on. Rather than a coordinate system, this
-- considers pixels as row/column indices.  While easiest to reason with,
-- indices are unable to represent zero-dimension rectangles.
--
-- Consider pixels as indices. Do not use this on empty rectangles.
pixelsToIndices :: Rectangle -> PointRectangle Integer
pixelsToIndices :: Rectangle -> PointRectangle Integer
pixelsToIndices (Rectangle Position
px Position
py Dimension
dx Dimension
dy) =
    forall a. a -> a -> a -> a -> PointRectangle a
PointRectangle (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
px)
                   (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
py)
                   (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
px forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
dx forall a. Num a => a -> a -> a
- Integer
1)
                   (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
py forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
dy forall a. Num a => a -> a -> a
- Integer
1)

-- | Consider pixels as @[N,N+1)@ coordinates. Available for empty rectangles.
pixelsToCoordinates :: Rectangle -> PointRectangle Integer
pixelsToCoordinates :: Rectangle -> PointRectangle Integer
pixelsToCoordinates (Rectangle Position
px Position
py Dimension
dx Dimension
dy) =
    forall a. a -> a -> a -> a -> PointRectangle a
PointRectangle (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
px)
                   (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
py)
                   (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
px forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
dx)
                   (forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
py forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
dy)

-- | Invert 'pixelsToIndices'.
indicesToRectangle :: PointRectangle Integer -> Rectangle
indicesToRectangle :: PointRectangle Integer -> Rectangle
indicesToRectangle (PointRectangle Integer
x1 Integer
y1 Integer
x2 Integer
y2) =
    Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x1)
              (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y1)
              (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
x2 forall a. Num a => a -> a -> a
- Integer
x1 forall a. Num a => a -> a -> a
+ Integer
1)
              (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
y2 forall a. Num a => a -> a -> a
- Integer
y1 forall a. Num a => a -> a -> a
+ Integer
1)

-- | Invert 'pixelsToCoordinates'.
coordinatesToRectangle :: PointRectangle Integer -> Rectangle
coordinatesToRectangle :: PointRectangle Integer -> Rectangle
coordinatesToRectangle (PointRectangle Integer
x1 Integer
y1 Integer
x2 Integer
y2) =
    Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x1)
              (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y1)
              (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
x2 forall a. Num a => a -> a -> a
- Integer
x1)
              (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
y2 forall a. Num a => a -> a -> a
- Integer
y1)

-- | True if either the 'rect_width' or 'rect_height' fields are zero, i.e. the
-- rectangle has no area.
empty :: Rectangle -> Bool
empty :: Rectangle -> Bool
empty (Rectangle Position
_ Position
_ Dimension
_ Dimension
0) = Bool
True
empty (Rectangle Position
_ Position
_ Dimension
0 Dimension
_) = Bool
True
empty Rectangle{}         = Bool
False

-- | True if the intersection of the set of points comprising each rectangle is
-- not the empty set. Therefore any rectangle containing the initial points of
-- an empty rectangle will never intersect that rectangle - including the same
-- empty rectangle.
intersects :: Rectangle -> Rectangle -> Bool
intersects :: Rectangle -> Rectangle -> Bool
intersects Rectangle
r1 Rectangle
r2 | Rectangle -> Bool
empty Rectangle
r1 Bool -> Bool -> Bool
|| Rectangle -> Bool
empty Rectangle
r2 = Bool
False
                 | Bool
otherwise            =    Integer
r1_x1 forall a. Ord a => a -> a -> Bool
< Integer
r2_x2
                                          Bool -> Bool -> Bool
&& Integer
r1_x2 forall a. Ord a => a -> a -> Bool
> Integer
r2_x1
                                          Bool -> Bool -> Bool
&& Integer
r1_y1 forall a. Ord a => a -> a -> Bool
< Integer
r2_y2
                                          Bool -> Bool -> Bool
&& Integer
r1_y2 forall a. Ord a => a -> a -> Bool
> Integer
r2_y1
    where PointRectangle Integer
r1_x1 Integer
r1_y1 Integer
r1_x2 Integer
r1_y2 = Rectangle -> PointRectangle Integer
pixelsToCoordinates Rectangle
r1
          PointRectangle Integer
r2_x1 Integer
r2_y1 Integer
r2_x2 Integer
r2_y2 = Rectangle -> PointRectangle Integer
pixelsToCoordinates Rectangle
r2

-- | True if the first rectangle contains at least all the points of the second
-- rectangle. Any rectangle containing the initial points of an empty rectangle
-- will be a superset of that rectangle - including the same empty rectangle.
supersetOf :: Rectangle -> Rectangle -> Bool
supersetOf :: Rectangle -> Rectangle -> Bool
supersetOf Rectangle
r1 Rectangle
r2 =    Integer
r1_x1 forall a. Ord a => a -> a -> Bool
<= Integer
r2_x1
                   Bool -> Bool -> Bool
&& Integer
r1_y1 forall a. Ord a => a -> a -> Bool
<= Integer
r2_y1
                   Bool -> Bool -> Bool
&& Integer
r1_x2 forall a. Ord a => a -> a -> Bool
>= Integer
r2_x2
                   Bool -> Bool -> Bool
&& Integer
r1_y2 forall a. Ord a => a -> a -> Bool
>= Integer
r2_y2
    where PointRectangle Integer
r1_x1 Integer
r1_y1 Integer
r1_x2 Integer
r1_y2 = Rectangle -> PointRectangle Integer
pixelsToCoordinates Rectangle
r1
          PointRectangle Integer
r2_x1 Integer
r2_y1 Integer
r2_x2 Integer
r2_y2 = Rectangle -> PointRectangle Integer
pixelsToCoordinates Rectangle
r2

-- | Return the smallest set of rectangles resulting from removing all the
-- points of the second rectangle from those of the first, i.e. @r1 - r2@, such
-- that @0 <= l <= 4@ where @l@ is the length of the resulting list.
difference :: Rectangle -> Rectangle -> [Rectangle]
difference :: Rectangle -> Rectangle -> [Rectangle]
difference Rectangle
r1 Rectangle
r2 | Rectangle
r1 Rectangle -> Rectangle -> Bool
`intersects` Rectangle
r2 = forall a b. (a -> b) -> [a] -> [b]
map PointRectangle Integer -> Rectangle
coordinatesToRectangle forall a b. (a -> b) -> a -> b
$
                                        forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PointRectangle Integer]
rt,[PointRectangle Integer]
rr,[PointRectangle Integer]
rb,[PointRectangle Integer]
rl]
                 | Bool
otherwise          = [Rectangle
r1]
    where PointRectangle Integer
r1_x1 Integer
r1_y1 Integer
r1_x2 Integer
r1_y2 = Rectangle -> PointRectangle Integer
pixelsToCoordinates Rectangle
r1
          PointRectangle Integer
r2_x1 Integer
r2_y1 Integer
r2_x2 Integer
r2_y2 = Rectangle -> PointRectangle Integer
pixelsToCoordinates Rectangle
r2
          -- top - assuming (0,0) is top-left
          rt :: [PointRectangle Integer]
rt = [forall a. a -> a -> a -> a -> PointRectangle a
PointRectangle (forall a. Ord a => a -> a -> a
max Integer
r2_x1 Integer
r1_x1) Integer
r1_y1 Integer
r1_x2 Integer
r2_y1 | Integer
r2_y1 forall a. Ord a => a -> a -> Bool
> Integer
r1_y1 Bool -> Bool -> Bool
&& Integer
r2_y1 forall a. Ord a => a -> a -> Bool
< Integer
r1_y2]
          -- right
          rr :: [PointRectangle Integer]
rr = [forall a. a -> a -> a -> a -> PointRectangle a
PointRectangle Integer
r2_x2 (forall a. Ord a => a -> a -> a
max Integer
r2_y1 Integer
r1_y1) Integer
r1_x2 Integer
r1_y2 | Integer
r2_x2 forall a. Ord a => a -> a -> Bool
> Integer
r1_x1 Bool -> Bool -> Bool
&& Integer
r2_x2 forall a. Ord a => a -> a -> Bool
< Integer
r1_x2]
          -- bottom
          rb :: [PointRectangle Integer]
rb = [forall a. a -> a -> a -> a -> PointRectangle a
PointRectangle Integer
r1_x1 Integer
r2_y2 (forall a. Ord a => a -> a -> a
min Integer
r2_x2 Integer
r1_x2) Integer
r1_y2 | Integer
r2_y2 forall a. Ord a => a -> a -> Bool
> Integer
r1_y1 Bool -> Bool -> Bool
&& Integer
r2_y2 forall a. Ord a => a -> a -> Bool
< Integer
r1_y2]
          -- left
          rl :: [PointRectangle Integer]
rl = [forall a. a -> a -> a -> a -> PointRectangle a
PointRectangle Integer
r1_x1 Integer
r1_y1 Integer
r2_x1 (forall a. Ord a => a -> a -> a
min Integer
r2_y2 Integer
r1_y2) | Integer
r2_x1 forall a. Ord a => a -> a -> Bool
> Integer
r1_x1 Bool -> Bool -> Bool
&& Integer
r2_x1 forall a. Ord a => a -> a -> Bool
< Integer
r1_x2]

-- | Fit a 'Rectangle' within the given borders of itself. Given insufficient
-- space, borders are minimized while preserving the ratio of opposite borders.
-- Origin is top-left, and yes, negative borders are allowed.
withBorder :: Integer -- ^ Top border.
           -> Integer -- ^ Bottom border.
           -> Integer -- ^ Right border.
           -> Integer -- ^ Left border.
           -> Integer -- ^ Smallest allowable rectangle dimensions, i.e.
                      --   width/height, with values @<0@ defaulting to @0@.
           -> Rectangle -> Rectangle
withBorder :: Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Rectangle
-> Rectangle
withBorder Integer
t Integer
b Integer
r Integer
l Integer
i (Rectangle Position
x Position
y Dimension
w Dimension
h) =
    let -- conversions
        w' :: Integer
w' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w
        h' :: Integer
h' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h
        -- minimum window dimensions
        i' :: Integer
i' = forall a. Ord a => a -> a -> a
max Integer
i Integer
0
        iw :: Integer
iw = forall a. Ord a => a -> a -> a
min Integer
i' Integer
w'
        ih :: Integer
ih = forall a. Ord a => a -> a -> a
min Integer
i' Integer
h'
        -- maximum border dimensions
        bh :: Integer
bh = Integer
w' forall a. Num a => a -> a -> a
- Integer
iw
        bv :: Integer
bv = Integer
h' forall a. Num a => a -> a -> a
- Integer
ih
        -- scaled border ratios
        rh :: Rational
rh = if Integer
l forall a. Num a => a -> a -> a
+ Integer
r forall a. Ord a => a -> a -> Bool
<= Integer
0
             then Rational
1
             else forall a. Ord a => a -> a -> a
min Rational
1 forall a b. (a -> b) -> a -> b
$ Integer
bh forall a. Integral a => a -> a -> Ratio a
% (Integer
l forall a. Num a => a -> a -> a
+ Integer
r)
        rv :: Rational
rv = if Integer
t forall a. Num a => a -> a -> a
+ Integer
b forall a. Ord a => a -> a -> Bool
<= Integer
0
             then Rational
1
             else forall a. Ord a => a -> a -> a
min Rational
1 forall a b. (a -> b) -> a -> b
$ Integer
bv forall a. Integral a => a -> a -> Ratio a
% (Integer
t forall a. Num a => a -> a -> a
+ Integer
b)
        -- scaled border pixels
        t' :: Position
t' = forall a b. (RealFrac a, Integral b) => a -> b
truncate forall a b. (a -> b) -> a -> b
$ Rational
rv forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
t
        b' :: Dimension
b' = forall a b. (RealFrac a, Integral b) => a -> b
truncate forall a b. (a -> b) -> a -> b
$ Rational
rv forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b
        r' :: Dimension
r' = forall a b. (RealFrac a, Integral b) => a -> b
truncate forall a b. (a -> b) -> a -> b
$ Rational
rh forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r
        l' :: Position
l' = forall a b. (RealFrac a, Integral b) => a -> b
truncate forall a b. (a -> b) -> a -> b
$ Rational
rh forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
l
    in  Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
x forall a. Num a => a -> a -> a
+ Position
l')
                  (Position
y forall a. Num a => a -> a -> a
+ Position
t')
                  (Dimension
w forall a. Num a => a -> a -> a
- Dimension
r' forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
l')
                  (Dimension
h forall a. Num a => a -> a -> a
- Dimension
b' forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
t')

-- | Calculate the center - @(x,y)@ - as if the 'Rectangle' were bounded.
center :: Rectangle -> (Ratio Integer,Ratio Integer)
center :: Rectangle -> (Rational, Rational)
center (Rectangle Position
x Position
y Dimension
w Dimension
h) = (Rational
cx,Rational
cy)
    where cx :: Rational
cx = forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w forall a. Integral a => a -> a -> Ratio a
% Integer
2
          cy :: Rational
cy = forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h forall a. Integral a => a -> a -> Ratio a
% Integer
2

-- | Invert 'scaleRationalRect'. Since that operation is lossy a roundtrip
-- conversion may not result in the original value. The first 'Rectangle' is
-- scaled to the second:
--
-- >>> (Rectangle 2 2 6 6) `toRatio` (Rectangle 0 0 10 10)
-- RationalRect (1 % 5) (1 % 5) (3 % 5) (3 % 5)
toRatio :: Rectangle -> Rectangle -> W.RationalRect
toRatio :: Rectangle -> Rectangle -> RationalRect
toRatio (Rectangle Position
x1 Position
y1 Dimension
w1 Dimension
h1) (Rectangle Position
x2 Position
y2 Dimension
w2 Dimension
h2) =
    Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect ((forall a b. (Integral a, Num b) => a -> b
fi Position
x1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Position
x2) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fi Dimension
w2)
                   ((forall a b. (Integral a, Num b) => a -> b
fi Position
y1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Position
y2) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fi Dimension
h2)
                   (forall a b. (Integral a, Num b) => a -> b
fi Dimension
w1 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fi Dimension
w2) (forall a b. (Integral a, Num b) => a -> b
fi Dimension
h1 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fi Dimension
h2)