{-# LANGUAGE PatternGuards #-}

-- | Represents an integral rectangular area of the 2D plane.
--   Using `Int`s (instead of `Float`s) for the bounds means we can safely
--   compare extents for equality.
module Graphics.Gloss.Data.Extent
        ( Extent
        , Coord
        , makeExtent
        , takeExtent
        , squareExtent
        , sizeOfExtent
        , isUnitExtent
        , coordInExtent
        , pointInExtent
        , centerCoordOfExtent
        , cutQuadOfExtent
        , quadOfCoord
        , pathToCoord
        , intersectSegExtent
        , touchesSegExtent)
where
import Graphics.Gloss.Data.Point
import Graphics.Gloss.Data.Quad
import Graphics.Gloss.Geometry.Line
import Data.Maybe


-- | A rectangular area of the 2D plane.
--   We keep the type abstract to ensure that invalid extents cannot be
--   constructed.
data Extent
        = Extent Int Int Int Int
        deriving (Extent -> Extent -> Bool
(Extent -> Extent -> Bool)
-> (Extent -> Extent -> Bool) -> Eq Extent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Extent -> Extent -> Bool
$c/= :: Extent -> Extent -> Bool
== :: Extent -> Extent -> Bool
$c== :: Extent -> Extent -> Bool
Eq, Int -> Extent -> ShowS
[Extent] -> ShowS
Extent -> String
(Int -> Extent -> ShowS)
-> (Extent -> String) -> ([Extent] -> ShowS) -> Show Extent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extent] -> ShowS
$cshowList :: [Extent] -> ShowS
show :: Extent -> String
$cshow :: Extent -> String
showsPrec :: Int -> Extent -> ShowS
$cshowsPrec :: Int -> Extent -> ShowS
Show)


-- | An integral coordinate.
type Coord
        = (Int, Int)


-- | Construct an extent.
--      The north value must be > south, and east > west, else `error`.
makeExtent
        :: Int  -- ^ y max (north)
        -> Int  -- ^ y min (south)
        -> Int  -- ^ x max (east)
        -> Int  -- ^ x min (west)
        -> Extent

makeExtent :: Int -> Int -> Int -> Int -> Extent
makeExtent Int
n Int
s Int
e Int
w
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
s, Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w
        = Int -> Int -> Int -> Int -> Extent
Extent Int
n Int
s Int
e Int
w

        | Bool
otherwise
        = String -> Extent
forall a. HasCallStack => String -> a
error String
"Graphics.Gloss.Geometry.Extent.makeExtent: invalid extent"


-- | Take the NSEW components of an extent.
takeExtent :: Extent -> (Int, Int, Int, Int)
takeExtent :: Extent -> (Int, Int, Int, Int)
takeExtent (Extent Int
n Int
s Int
e Int
w)
        = (Int
n, Int
s, Int
e, Int
w)


-- | A square extent of a given size.
squareExtent :: Int -> Extent
squareExtent :: Int -> Extent
squareExtent Int
i
        = Int -> Int -> Int -> Int -> Extent
Extent Int
i Int
0 Int
i Int
0


-- | Get the width and height of an extent.
sizeOfExtent :: Extent -> (Int, Int)
sizeOfExtent :: Extent -> (Int, Int)
sizeOfExtent (Extent Int
n Int
s Int
e Int
w)
        = (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s)


-- | Check if an extent is a square with a width and height of 1.
isUnitExtent :: Extent -> Bool
isUnitExtent :: Extent -> Bool
isUnitExtent Extent
extent
        = Extent -> (Int, Int)
sizeOfExtent Extent
extent (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
1, Int
1)


-- | Check whether a coordinate lies inside an extent.
coordInExtent :: Extent -> Coord -> Bool
coordInExtent :: Extent -> (Int, Int) -> Bool
coordInExtent (Extent Int
n Int
s Int
e Int
w) (Int
x, Int
y)
        =  Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
e
        Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
s Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n


-- | Check whether a point lies inside an extent.
pointInExtent :: Extent -> Point -> Bool
pointInExtent :: Extent -> Point -> Bool
pointInExtent (Extent Int
n Int
s Int
e Int
w) (Float
x, Float
y)
 = let  n' :: Float
n'      = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        s' :: Float
s'      = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s
        e' :: Float
e'      = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
e
        w' :: Float
w'      = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w

   in   Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
w' Bool -> Bool -> Bool
&& Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
e'
     Bool -> Bool -> Bool
&& Float
y Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
s' Bool -> Bool -> Bool
&& Float
y Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
n'


-- | Get the coordinate that lies at the center of an extent.
centerCoordOfExtent :: Extent -> (Int, Int)
centerCoordOfExtent :: Extent -> (Int, Int)
centerCoordOfExtent (Extent Int
n Int
s Int
e Int
w)
 =      ( Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        , Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)


-- | Cut one quadrant out of an extent.
cutQuadOfExtent :: Quad -> Extent -> Extent
cutQuadOfExtent :: Quad -> Extent -> Extent
cutQuadOfExtent Quad
quad (Extent Int
n Int
s Int
e Int
w)
 = let  hheight :: Int
hheight = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        hwidth :: Int
hwidth  = (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
   in   case Quad
quad of
                Quad
NW -> Int -> Int -> Int -> Int -> Extent
Extent Int
n (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hheight)  (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hwidth) Int
w
                Quad
NE -> Int -> Int -> Int -> Int -> Extent
Extent Int
n (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hheight)  Int
e (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hwidth)
                Quad
SW -> Int -> Int -> Int -> Int -> Extent
Extent (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hheight) Int
s  (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hwidth) Int
w
                Quad
SE -> Int -> Int -> Int -> Int -> Extent
Extent (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hheight) Int
s  Int
e (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hwidth)


-- | Get the quadrant that this coordinate lies in, if any.
quadOfCoord :: Extent -> Coord -> Maybe Quad
quadOfCoord :: Extent -> (Int, Int) -> Maybe Quad
quadOfCoord Extent
extent (Int, Int)
coord
        = [Quad] -> Maybe Quad
forall a. [a] -> Maybe a
listToMaybe
        ([Quad] -> Maybe Quad) -> [Quad] -> Maybe Quad
forall a b. (a -> b) -> a -> b
$ (Quad -> Bool) -> [Quad] -> [Quad]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Quad
q -> Extent -> (Int, Int) -> Bool
coordInExtent (Quad -> Extent -> Extent
cutQuadOfExtent Quad
q Extent
extent) (Int, Int)
coord)
        ([Quad] -> [Quad]) -> [Quad] -> [Quad]
forall a b. (a -> b) -> a -> b
$ [Quad]
allQuads


-- | Constuct a path to a particular coordinate in an extent.
pathToCoord :: Extent -> Coord -> Maybe [Quad]
pathToCoord :: Extent -> (Int, Int) -> Maybe [Quad]
pathToCoord Extent
extent (Int, Int)
coord
        | Extent -> Bool
isUnitExtent Extent
extent
        = [Quad] -> Maybe [Quad]
forall a. a -> Maybe a
Just []

        | Bool
otherwise
        = do    Quad
quad    <- Extent -> (Int, Int) -> Maybe Quad
quadOfCoord Extent
extent (Int, Int)
coord
                [Quad]
rest    <- Extent -> (Int, Int) -> Maybe [Quad]
pathToCoord (Quad -> Extent -> Extent
cutQuadOfExtent Quad
quad Extent
extent) (Int, Int)
coord
                [Quad] -> Maybe [Quad]
forall (m :: * -> *) a. Monad m => a -> m a
return  ([Quad] -> Maybe [Quad]) -> [Quad] -> Maybe [Quad]
forall a b. (a -> b) -> a -> b
$ Quad
quad Quad -> [Quad] -> [Quad]
forall a. a -> [a] -> [a]
: [Quad]
rest


-- | If a line segment (P1-P2) intersects the outer edge of an extent then
--   return the intersection point, that is closest to P1, if any.
--   If P1 is inside the extent then `Nothing`.
--
--   @
--                   P2
--                  /
--            ----/-
--            | /  |
--            +    |
--           /------
--         /
--        P1
--   @
--
intersectSegExtent :: Point -> Point -> Extent -> Maybe Point
intersectSegExtent :: Point -> Point -> Extent -> Maybe Point
intersectSegExtent p1 :: Point
p1@(Float
x1, Float
y1) Point
p2 (Extent Int
n' Int
s' Int
e' Int
w')
        -- starts below extent
        | Float
y1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
s
        , Just Point
pos      <- Point -> Point -> Float -> Float -> Float -> Maybe Point
intersectSegHorzSeg Point
p1 Point
p2 Float
s Float
w Float
e
        = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
pos

        -- starts above extent
        | Float
y1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
n
        , Just Point
pos      <- Point -> Point -> Float -> Float -> Float -> Maybe Point
intersectSegHorzSeg Point
p1 Point
p2 Float
n Float
w Float
e
        = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
pos

        -- starts left of extent
        | Float
x1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
w
        , Just Point
pos      <- Point -> Point -> Float -> Float -> Float -> Maybe Point
intersectSegVertSeg Point
p1 Point
p2 Float
w Float
s Float
n
        = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
pos

        -- starts right of extent
        | Float
x1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
e
        , Just Point
pos      <- Point -> Point -> Float -> Float -> Float -> Maybe Point
intersectSegVertSeg Point
p1 Point
p2 Float
e Float
s Float
n
        = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
pos

        -- must be starting inside extent.
        | Bool
otherwise
        = Maybe Point
forall a. Maybe a
Nothing

        where   n :: Float
n       = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n'
                s :: Float
s       = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s'
                e :: Float
e       = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
e'
                w :: Float
w       = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w'


-- | Check whether a line segment's endpoints are inside an extent, or if it
--   intersects with the boundary.
touchesSegExtent :: Point -> Point -> Extent -> Bool
touchesSegExtent :: Point -> Point -> Extent -> Bool
touchesSegExtent Point
p1 Point
p2 Extent
extent
        =   Extent -> Point -> Bool
pointInExtent Extent
extent Point
p1
         Bool -> Bool -> Bool
|| Extent -> Point -> Bool
pointInExtent Extent
extent Point
p2
         Bool -> Bool -> Bool
|| Maybe Point -> Bool
forall a. Maybe a -> Bool
isJust (Point -> Point -> Extent -> Maybe Point
intersectSegExtent Point
p1 Point
p2 Extent
extent)