1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
-- | 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 (Show, Eq)
-- | Checks if it's an area with at least one field.
toArea :: (X, Y, X, Y) -> Maybe Area
toArea (x0, y0, x1, y1) = if x0 <= x1 && y0 <= y1
then Just $ Area x0 y0 x1 y1
else Nothing
fromArea :: Area -> (X, Y, X, Y)
{-# INLINE fromArea #-}
fromArea (Area x0 y0 x1 y1) = (x0, y0, x1, y1)
-- Funny thing, Trivial area, a point, has span 1 in each dimension.
spanArea :: Area -> (Point, X, Y)
spanArea (Area x0 y0 x1 y1) = (Point x0 y0, x1 - x0 + 1, y1 - y0 + 1)
trivialArea :: Point -> Area
trivialArea (Point x y) = Area x y x y
isTrivialArea :: Area -> Bool
isTrivialArea (Area x0 y0 x1 y1) = x0 == x1 && y0 == y1
-- | Checks that a point belongs to an area.
inside :: Area -> Point -> Bool
{-# INLINE inside #-}
inside = insideP . fromArea
-- | Shrink the given area on all fours sides by the amount.
shrink :: Area -> Maybe Area
shrink (Area x0 y0 x1 y1) = toArea (x0 + 1, y0 + 1, x1 - 1, y1 - 1)
expand :: Area -> Area
expand (Area x0 y0 x1 y1) = Area (x0 - 1) (y0 - 1) (x1 + 1) (y1 + 1)
middlePoint :: Area -> Point
middlePoint (Area x0 y0 x1 y1) = Point (x0 + (x1 - x0) `div` 2)
(y0 + (y1 - y0) `div` 2)
areaInnerBorder :: Area -> [Point]
areaInnerBorder (Area x0 y0 x1 y1) =
[ Point x y
| x <- [x0, x1], y <- [y0..y1] ]
++ [ Point x y
| x <- [x0+1..x1-1], y <- [y0, y1] ]
-- We assume the areas are adjacent.
sumAreas :: Area -> Area -> Area
sumAreas a@(Area x0 y0 x1 y1) a'@(Area x0' y0' x1' y1') =
if | y1 == y0' -> assert (x0 == x0' && x1 == x1' `blame` (a, a')) $
Area x0 y0 x1 y1'
| y0 == y1' -> assert (x0 == x0' && x1 == x1' `blame` (a, a')) $
Area x0' y0' x1' y1
| x1 == x0' -> assert (y0 == y0' && y1 == y1' `blame` (a, a')) $
Area x0 y0 x1' y1
| x0 == x1' -> assert (y0 == y0' && y1 == y1' `blame` (a, a')) $
Area x0' y0' x1 y1'
| otherwise -> error $ "areas not adjacent" `showFailure` (a, a')
punindex :: X -> Int -> Point
{-# INLINE punindex #-}
punindex xsize n = let (py, px) = n `quotRem` xsize
in Point{..}
instance Binary Area where
put (Area x0 y0 x1 y1) = do
put x0
put y0
put x1
put y1
get = Area <$> get <*> get <*> get <*> get
|
