-- | Rectangular areas of levels and their basic operations.
module Game.LambdaHack.Common.Area
  ( Area, toArea, fromArea, spanArea, trivialArea, isTrivialArea
  , inside, shrink, expand, middlePoint, areaInnerBorder, sumAreas, punindex
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import Data.Binary

import Game.LambdaHack.Common.Point
import Game.LambdaHack.Definition.Defs

-- | The type of areas. The bottom left and the top right points.
data Area = Area X Y X Y
  deriving (Int -> Area -> ShowS
[Area] -> ShowS
Area -> String
(Int -> Area -> ShowS)
-> (Area -> String) -> ([Area] -> ShowS) -> Show Area
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Area] -> ShowS
$cshowList :: [Area] -> ShowS
show :: Area -> String
$cshow :: Area -> String
showsPrec :: Int -> Area -> ShowS
$cshowsPrec :: Int -> Area -> ShowS
Show, Area -> Area -> Bool
(Area -> Area -> Bool) -> (Area -> Area -> Bool) -> Eq Area
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Area -> Area -> Bool
$c/= :: Area -> Area -> Bool
== :: Area -> Area -> Bool
$c== :: Area -> Area -> Bool
Eq)

-- | Checks if it's an area with at least one field.
toArea :: (X, Y, X, Y) -> Maybe Area
toArea :: (Int, Int, Int, Int) -> Maybe Area
toArea (Int
x0, Int
y0, Int
x1, Int
y1) = if Int
x0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x1 Bool -> Bool -> Bool
&& Int
y0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
y1
                          then Area -> Maybe Area
forall a. a -> Maybe a
Just (Area -> Maybe Area) -> Area -> Maybe Area
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Area
Area Int
x0 Int
y0 Int
x1 Int
y1
                          else Maybe Area
forall a. Maybe a
Nothing

fromArea :: Area -> (X, Y, X, Y)
{-# INLINE fromArea #-}
fromArea :: Area -> (Int, Int, Int, Int)
fromArea (Area Int
x0 Int
y0 Int
x1 Int
y1) = (Int
x0, Int
y0, Int
x1, Int
y1)

-- Funny thing, Trivial area, a point, has span 1 in each dimension.
spanArea :: Area -> (Point, X, Y)
spanArea :: Area -> (Point, Int, Int)
spanArea (Area Int
x0 Int
y0 Int
x1 Int
y1) = (Int -> Int -> Point
Point Int
x0 Int
y0, Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

trivialArea :: Point -> Area
trivialArea :: Point -> Area
trivialArea (Point Int
x Int
y) = Int -> Int -> Int -> Int -> Area
Area Int
x Int
y Int
x Int
y

isTrivialArea :: Area -> Bool
isTrivialArea :: Area -> Bool
isTrivialArea (Area Int
x0 Int
y0 Int
x1 Int
y1) = Int
x0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x1 Bool -> Bool -> Bool
&& Int
y0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y1

-- | Checks that a point belongs to an area.
inside :: Area -> Point -> Bool
{-# INLINE inside #-}
inside :: Area -> Point -> Bool
inside = (Int, Int, Int, Int) -> Point -> Bool
insideP ((Int, Int, Int, Int) -> Point -> Bool)
-> (Area -> (Int, Int, Int, Int)) -> Area -> Point -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Area -> (Int, Int, Int, Int)
fromArea

-- | Shrink the given area on all fours sides by the amount.
shrink :: Area -> Maybe Area
shrink :: Area -> Maybe Area
shrink (Area Int
x0 Int
y0 Int
x1 Int
y1) = (Int, Int, Int, Int) -> Maybe Area
toArea (Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
y0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

expand :: Area -> Area
expand :: Area -> Area
expand (Area Int
x0 Int
y0 Int
x1 Int
y1) = Int -> Int -> Int -> Int -> Area
Area (Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
y0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

middlePoint :: Area -> Point
middlePoint :: Area -> Point
middlePoint (Area Int
x0 Int
y0 Int
x1 Int
y1) = Int -> Int -> Point
Point (Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x0) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
                                       (Int
y0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y0) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)

areaInnerBorder :: Area -> [Point]
areaInnerBorder :: Area -> [Point]
areaInnerBorder (Area Int
x0 Int
y0 Int
x1 Int
y1) =
  [ Int -> Int -> Point
Point Int
x Int
y
  | Int
x <- [Int
x0, Int
x1], Int
y <- [Int
y0..Int
y1] ]
  [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ [ Int -> Int -> Point
Point Int
x Int
y
     | Int
x <- [Int
x0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1..Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1], Int
y <- [Int
y0, Int
y1] ]

-- We assume the areas are adjacent.
sumAreas :: Area -> Area -> Area
sumAreas :: Area -> Area -> Area
sumAreas a :: Area
a@(Area Int
x0 Int
y0 Int
x1 Int
y1) a' :: Area
a'@(Area Int
x0' Int
y0' Int
x1' Int
y1') =
  if | Int
y1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y0' -> Bool -> Area -> Area
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
x0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x0' Bool -> Bool -> Bool
&& Int
x1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x1' Bool -> (Area, Area) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (Area
a, Area
a')) (Area -> Area) -> Area -> Area
forall a b. (a -> b) -> a -> b
$
       Int -> Int -> Int -> Int -> Area
Area Int
x0 Int
y0 Int
x1 Int
y1'
     | Int
y0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y1' -> Bool -> Area -> Area
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
x0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x0' Bool -> Bool -> Bool
&& Int
x1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x1' Bool -> (Area, Area) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (Area
a, Area
a')) (Area -> Area) -> Area -> Area
forall a b. (a -> b) -> a -> b
$
       Int -> Int -> Int -> Int -> Area
Area Int
x0' Int
y0' Int
x1' Int
y1
     | Int
x1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x0' -> Bool -> Area -> Area
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
y0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y0' Bool -> Bool -> Bool
&& Int
y1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y1' Bool -> (Area, Area) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (Area
a, Area
a')) (Area -> Area) -> Area -> Area
forall a b. (a -> b) -> a -> b
$
       Int -> Int -> Int -> Int -> Area
Area Int
x0 Int
y0 Int
x1' Int
y1
     | Int
x0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x1' -> Bool -> Area -> Area
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
y0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y0' Bool -> Bool -> Bool
&& Int
y1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y1' Bool -> (Area, Area) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (Area
a, Area
a')) (Area -> Area) -> Area -> Area
forall a b. (a -> b) -> a -> b
$
       Int -> Int -> Int -> Int -> Area
Area Int
x0' Int
y0' Int
x1 Int
y1'
     | Bool
otherwise -> String -> Area
forall a. (?callStack::CallStack) => String -> a
error (String -> Area) -> String -> Area
forall a b. (a -> b) -> a -> b
$ String
"areas not adjacent" String -> (Area, Area) -> String
forall v. Show v => String -> v -> String
`showFailure` (Area
a, Area
a')

punindex :: X -> Int -> Point
{-# INLINE punindex #-}
punindex :: Int -> Int -> Point
punindex Int
xsize Int
n = let (Int
py, Int
px) = Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
xsize
                   in Point :: Int -> Int -> Point
Point{Int
py :: Int
px :: Int
px :: Int
py :: Int
..}

instance Binary Area where
  put :: Area -> Put
put (Area Int
x0 Int
y0 Int
x1 Int
y1) = do
    Int -> Put
forall t. Binary t => t -> Put
put Int
x0
    Int -> Put
forall t. Binary t => t -> Put
put Int
y0
    Int -> Put
forall t. Binary t => t -> Put
put Int
x1
    Int -> Put
forall t. Binary t => t -> Put
put Int
y1
  get :: Get Area
get = Int -> Int -> Int -> Int -> Area
Area (Int -> Int -> Int -> Int -> Area)
-> Get Int -> Get (Int -> Int -> Int -> Area)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall t. Binary t => Get t
get Get (Int -> Int -> Int -> Area)
-> Get Int -> Get (Int -> Int -> Area)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get Get (Int -> Int -> Area) -> Get Int -> Get (Int -> Area)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get Get (Int -> Area) -> Get Int -> Get Area
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get