module Game.LambdaHack.Server.DungeonGen.AreaRnd
(
mkFixed, pointInArea, findPointInArea, mkVoidRoom, mkRoom
, connectGrid, randomConnection
, HV(..), Corridor, connectPlaces
, SpecialArea(..), grid
#ifdef EXPOSE_INTERNAL
, connectGrid', sortPoint, mkCorridor, borderPlace
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Functor.Identity (runIdentity)
import qualified Data.IntSet as IS
import Game.LambdaHack.Common.Area
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Content.PlaceKind
import Game.LambdaHack.Core.Random
import Game.LambdaHack.Definition.Defs
mkFixed :: (X, Y)
-> Area
-> Point
-> Area
mkFixed :: (X, X) -> Area -> Point -> Area
mkFixed (X
xMax, X
yMax) Area
area p :: Point
p@Point{X
py :: Point -> X
px :: Point -> X
py :: X
px :: X
..} =
let (X
x0, X
y0, X
x1, X
y1) = Area -> (X, X, X, X)
fromArea Area
area
xradius :: X
xradius = X -> X -> X
forall a. Ord a => a -> a -> a
min ((X
xMax X -> X -> X
forall a. Num a => a -> a -> a
+ X
1) X -> X -> X
forall a. Integral a => a -> a -> a
`div` X
2) (X -> X) -> X -> X
forall a b. (a -> b) -> a -> b
$ X -> X -> X
forall a. Ord a => a -> a -> a
min (X
px X -> X -> X
forall a. Num a => a -> a -> a
- X
x0) (X
x1 X -> X -> X
forall a. Num a => a -> a -> a
- X
px)
yradius :: X
yradius = X -> X -> X
forall a. Ord a => a -> a -> a
min ((X
yMax X -> X -> X
forall a. Num a => a -> a -> a
+ X
1) X -> X -> X
forall a. Integral a => a -> a -> a
`div` X
2) (X -> X) -> X -> X
forall a b. (a -> b) -> a -> b
$ X -> X -> X
forall a. Ord a => a -> a -> a
min (X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
y0) (X
y1 X -> X -> X
forall a. Num a => a -> a -> a
- X
py)
a :: (X, X, X, X)
a = (X
px X -> X -> X
forall a. Num a => a -> a -> a
- X
xradius, X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
yradius, X
px X -> X -> X
forall a. Num a => a -> a -> a
+ X
xradius, X
py X -> X -> X
forall a. Num a => a -> a -> a
+ X
yradius)
in Area -> Maybe Area -> Area
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Area
forall a. HasCallStack => [Char] -> a
error ([Char] -> Area) -> [Char] -> Area
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> ((X, X, X, X), X, X, Area, Point) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ((X, X, X, X)
a, X
xMax, X
yMax, Area
area, Point
p)) (Maybe Area -> Area) -> Maybe Area -> Area
forall a b. (a -> b) -> a -> b
$ (X, X, X, X) -> Maybe Area
toArea (X, X, X, X)
a
pointInArea :: Area -> Rnd Point
pointInArea :: Area -> Rnd Point
pointInArea Area
area = do
let (Point X
x0 X
y0, X
xspan, X
yspan) = Area -> (Point, X, X)
spanArea Area
area
X
pxy <- X -> Rnd X
forall a. Integral a => a -> Rnd a
randomR0 (X
xspan X -> X -> X
forall a. Num a => a -> a -> a
* X
yspan X -> X -> X
forall a. Num a => a -> a -> a
- X
1)
let Point{X
py :: X
px :: X
py :: Point -> X
px :: Point -> X
..} = X -> X -> Point
punindex X
xspan X
pxy
Point -> Rnd Point
forall (m :: * -> *) a. Monad m => a -> m a
return (Point -> Rnd Point) -> Point -> Rnd Point
forall a b. (a -> b) -> a -> b
$! X -> X -> Point
Point (X
x0 X -> X -> X
forall a. Num a => a -> a -> a
+ X
px) (X
y0 X -> X -> X
forall a. Num a => a -> a -> a
+ X
py)
findPointInArea :: Area -> (Point -> Maybe Point)
-> Int -> (Point -> Maybe Point)
-> Rnd (Maybe Point)
findPointInArea :: Area
-> (Point -> Maybe Point)
-> X
-> (Point -> Maybe Point)
-> Rnd (Maybe Point)
findPointInArea Area
area Point -> Maybe Point
g X
gnumTries Point -> Maybe Point
f =
let (Point X
x0 X
y0, X
xspan, X
yspan) = Area -> (Point, X, X)
spanArea Area
area
checkPoint :: Applicative m
=> (Point -> Maybe Point) -> m (Maybe Point) -> Int
-> m (Maybe Point)
{-# INLINE checkPoint #-}
checkPoint :: (Point -> Maybe Point) -> m (Maybe Point) -> X -> m (Maybe Point)
checkPoint Point -> Maybe Point
check m (Maybe Point)
fallback X
pxyRelative =
let Point{X
py :: X
px :: X
py :: Point -> X
px :: Point -> X
..} = X -> X -> Point
punindex X
xspan X
pxyRelative
pos :: Point
pos = X -> X -> Point
Point (X
x0 X -> X -> X
forall a. Num a => a -> a -> a
+ X
px) (X
y0 X -> X -> X
forall a. Num a => a -> a -> a
+ X
py)
in case Point -> Maybe Point
check Point
pos of
Just Point
p -> Maybe Point -> m (Maybe Point)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Point -> m (Maybe Point)) -> Maybe Point -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p
Maybe Point
Nothing -> m (Maybe Point)
fallback
gsearch :: X -> Rnd (Maybe Point)
gsearch X
0 = X -> Rnd (Maybe Point)
fsearch (X
xspan X -> X -> X
forall a. Num a => a -> a -> a
* X
yspan X -> X -> X
forall a. Num a => a -> a -> a
* X
10)
gsearch X
count = do
X
pxy <- X -> Rnd X
forall a. Integral a => a -> Rnd a
randomR0 (X
xspan X -> X -> X
forall a. Num a => a -> a -> a
* X
yspan X -> X -> X
forall a. Num a => a -> a -> a
- X
1)
(Point -> Maybe Point)
-> Rnd (Maybe Point) -> X -> Rnd (Maybe Point)
forall (m :: * -> *).
Applicative m =>
(Point -> Maybe Point) -> m (Maybe Point) -> X -> m (Maybe Point)
checkPoint Point -> Maybe Point
g (X -> Rnd (Maybe Point)
gsearch (X
count X -> X -> X
forall a. Num a => a -> a -> a
- X
1)) X
pxy
fsearch :: X -> Rnd (Maybe Point)
fsearch X
0 = Maybe Point -> Rnd (Maybe Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Point -> Rnd (Maybe Point))
-> Maybe Point -> Rnd (Maybe Point)
forall a b. (a -> b) -> a -> b
$! Identity (Maybe Point) -> Maybe Point
forall a. Identity a -> a
runIdentity (Identity (Maybe Point) -> Maybe Point)
-> Identity (Maybe Point) -> Maybe Point
forall a b. (a -> b) -> a -> b
$ X -> Identity (Maybe Point)
searchAll (X
xspan X -> X -> X
forall a. Num a => a -> a -> a
* X
yspan X -> X -> X
forall a. Num a => a -> a -> a
- X
1)
fsearch X
count = do
X
pxy <- X -> Rnd X
forall a. Integral a => a -> Rnd a
randomR0 (X
xspan X -> X -> X
forall a. Num a => a -> a -> a
* X
yspan X -> X -> X
forall a. Num a => a -> a -> a
- X
1)
(Point -> Maybe Point)
-> Rnd (Maybe Point) -> X -> Rnd (Maybe Point)
forall (m :: * -> *).
Applicative m =>
(Point -> Maybe Point) -> m (Maybe Point) -> X -> m (Maybe Point)
checkPoint Point -> Maybe Point
f (X -> Rnd (Maybe Point)
fsearch (X
count X -> X -> X
forall a. Num a => a -> a -> a
- X
1)) X
pxy
searchAll :: X -> Identity (Maybe Point)
searchAll (-1) = Maybe Point -> Identity (Maybe Point)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Point
forall a. Maybe a
Nothing
searchAll X
pxyRelative =
(Point -> Maybe Point)
-> Identity (Maybe Point) -> X -> Identity (Maybe Point)
forall (m :: * -> *).
Applicative m =>
(Point -> Maybe Point) -> m (Maybe Point) -> X -> m (Maybe Point)
checkPoint Point -> Maybe Point
f (X -> Identity (Maybe Point)
searchAll (X
pxyRelative X -> X -> X
forall a. Num a => a -> a -> a
- X
1)) X
pxyRelative
in X -> Rnd (Maybe Point)
gsearch X
gnumTries
mkVoidRoom :: Area -> Rnd Area
mkVoidRoom :: Area -> Rnd Area
mkVoidRoom Area
area = do
let core :: Area
core = Area -> Maybe Area -> Area
forall a. a -> Maybe a -> a
fromMaybe Area
area (Maybe Area -> Area) -> Maybe Area -> Area
forall a b. (a -> b) -> a -> b
$ Area -> Maybe Area
shrink Area
area
Point
pxy <- Area -> Rnd Point
pointInArea Area
core
Area -> Rnd Area
forall (m :: * -> *) a. Monad m => a -> m a
return (Area -> Rnd Area) -> Area -> Rnd Area
forall a b. (a -> b) -> a -> b
$! Point -> Area
trivialArea Point
pxy
mkRoom :: (X, Y)
-> (X, Y)
-> Area
-> Rnd Area
mkRoom :: (X, X) -> (X, X) -> Area -> Rnd Area
mkRoom (X
xm, X
ym) (X
xM, X
yM) Area
area = do
let (X
x0, X
y0, X
x1, X
y1) = Area -> (X, X, X, X)
fromArea Area
area
xspan :: X
xspan = X
x1 X -> X -> X
forall a. Num a => a -> a -> a
- X
x0 X -> X -> X
forall a. Num a => a -> a -> a
+ X
1
yspan :: X
yspan = X
y1 X -> X -> X
forall a. Num a => a -> a -> a
- X
y0 X -> X -> X
forall a. Num a => a -> a -> a
+ X
1
aW :: (X, X, X, X)
aW = (X -> X -> X
forall a. Ord a => a -> a -> a
min X
xm X
xspan, X -> X -> X
forall a. Ord a => a -> a -> a
min X
ym X
yspan, X -> X -> X
forall a. Ord a => a -> a -> a
min X
xM X
xspan, X -> X -> X
forall a. Ord a => a -> a -> a
min X
yM X
yspan)
areaW :: Area
areaW = Area -> Maybe Area -> Area
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Area
forall a. HasCallStack => [Char] -> a
error ([Char] -> Area) -> [Char] -> Area
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (X, X, X, X) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (X, X, X, X)
aW) (Maybe Area -> Area) -> Maybe Area -> Area
forall a b. (a -> b) -> a -> b
$ (X, X, X, X) -> Maybe Area
toArea (X, X, X, X)
aW
Point X
xW X
yW <- Area -> Rnd Point
pointInArea Area
areaW
let a1 :: (X, X, X, X)
a1 = (X
x0, X
y0, X -> X -> X
forall a. Ord a => a -> a -> a
max X
x0 (X
x1 X -> X -> X
forall a. Num a => a -> a -> a
- X
xW X -> X -> X
forall a. Num a => a -> a -> a
+ X
1), X -> X -> X
forall a. Ord a => a -> a -> a
max X
y0 (X
y1 X -> X -> X
forall a. Num a => a -> a -> a
- X
yW X -> X -> X
forall a. Num a => a -> a -> a
+ X
1))
area1 :: Area
area1 = Area -> Maybe Area -> Area
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Area
forall a. HasCallStack => [Char] -> a
error ([Char] -> Area) -> [Char] -> Area
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (X, X, X, X) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (X, X, X, X)
a1) (Maybe Area -> Area) -> Maybe Area -> Area
forall a b. (a -> b) -> a -> b
$ (X, X, X, X) -> Maybe Area
toArea (X, X, X, X)
a1
Point X
rx1 X
ry1 <- Area -> Rnd Point
pointInArea Area
area1
let a3 :: (X, X, X, X)
a3 = (X
rx1, X
ry1, X
rx1 X -> X -> X
forall a. Num a => a -> a -> a
+ X
xW X -> X -> X
forall a. Num a => a -> a -> a
- X
1, X
ry1 X -> X -> X
forall a. Num a => a -> a -> a
+ X
yW X -> X -> X
forall a. Num a => a -> a -> a
- X
1)
area3 :: Area
area3 = Area -> Maybe Area -> Area
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Area
forall a. HasCallStack => [Char] -> a
error ([Char] -> Area) -> [Char] -> Area
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (X, X, X, X) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (X, X, X, X)
a3) (Maybe Area -> Area) -> Maybe Area -> Area
forall a b. (a -> b) -> a -> b
$ (X, X, X, X) -> Maybe Area
toArea (X, X, X, X)
a3
Area -> Rnd Area
forall (m :: * -> *) a. Monad m => a -> m a
return (Area -> Rnd Area) -> Area -> Rnd Area
forall a b. (a -> b) -> a -> b
$! Area
area3
connectGrid :: ES.EnumSet Point -> (X, Y) -> Rnd [(Point, Point)]
connectGrid :: EnumSet Point -> (X, X) -> Rnd [(Point, Point)]
connectGrid EnumSet Point
voidPlaces (X
nx, X
ny) = do
let unconnected :: EnumSet Point
unconnected = [Point] -> EnumSet Point
forall k. Enum k => [k] -> EnumSet k
ES.fromDistinctAscList [ X -> X -> Point
Point X
x X
y
| X
y <- [X
0..X
nyX -> X -> X
forall a. Num a => a -> a -> a
-X
1], X
x <- [X
0..X
nxX -> X -> X
forall a. Num a => a -> a -> a
-X
1] ]
Point
p <- [Point] -> Rnd Point
forall a. [a] -> Rnd a
oneOf ([Point] -> Rnd Point) -> [Point] -> Rnd Point
forall a b. (a -> b) -> a -> b
$ EnumSet Point -> [Point]
forall k. Enum k => EnumSet k -> [k]
ES.elems (EnumSet Point -> [Point]) -> EnumSet Point -> [Point]
forall a b. (a -> b) -> a -> b
$ EnumSet Point
unconnected EnumSet Point -> EnumSet Point -> EnumSet Point
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.\\ EnumSet Point
voidPlaces
let candidates :: EnumSet Point
candidates = Point -> EnumSet Point
forall k. Enum k => k -> EnumSet k
ES.singleton Point
p
EnumSet Point
-> (X, X)
-> EnumSet Point
-> EnumSet Point
-> [(Point, Point)]
-> Rnd [(Point, Point)]
connectGrid' EnumSet Point
voidPlaces (X
nx, X
ny) EnumSet Point
unconnected EnumSet Point
candidates []
connectGrid' :: ES.EnumSet Point -> (X, Y)
-> ES.EnumSet Point -> ES.EnumSet Point
-> [(Point, Point)]
-> Rnd [(Point, Point)]
connectGrid' :: EnumSet Point
-> (X, X)
-> EnumSet Point
-> EnumSet Point
-> [(Point, Point)]
-> Rnd [(Point, Point)]
connectGrid' EnumSet Point
voidPlaces (X
nx, X
ny) EnumSet Point
unconnected EnumSet Point
candidates ![(Point, Point)]
acc
| EnumSet Point
unconnected EnumSet Point -> EnumSet Point -> Bool
forall k. EnumSet k -> EnumSet k -> Bool
`ES.isSubsetOf` EnumSet Point
voidPlaces = [(Point, Point)] -> Rnd [(Point, Point)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Point, Point)]
acc
| Bool
otherwise = do
let candidatesBest :: EnumSet Point
candidatesBest = EnumSet Point
candidates EnumSet Point -> EnumSet Point -> EnumSet Point
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.\\ EnumSet Point
voidPlaces
Point
c <- [Point] -> Rnd Point
forall a. [a] -> Rnd a
oneOf ([Point] -> Rnd Point) -> [Point] -> Rnd Point
forall a b. (a -> b) -> a -> b
$ EnumSet Point -> [Point]
forall k. Enum k => EnumSet k -> [k]
ES.elems (EnumSet Point -> [Point]) -> EnumSet Point -> [Point]
forall a b. (a -> b) -> a -> b
$ if EnumSet Point -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet Point
candidatesBest
then EnumSet Point
candidates
else EnumSet Point
candidatesBest
let ns :: EnumSet Point
ns = [Point] -> EnumSet Point
forall k. Enum k => [k] -> EnumSet k
ES.fromList ([Point] -> EnumSet Point) -> [Point] -> EnumSet Point
forall a b. (a -> b) -> a -> b
$ X -> X -> Point -> [Point]
vicinityCardinal X
nx X
ny Point
c
nu :: EnumSet Point
nu = Point -> EnumSet Point -> EnumSet Point
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.delete Point
c EnumSet Point
unconnected
(EnumSet Point
nc, EnumSet Point
ds) = (Point -> Bool) -> EnumSet Point -> (EnumSet Point, EnumSet Point)
forall k.
Enum k =>
(k -> Bool) -> EnumSet k -> (EnumSet k, EnumSet k)
ES.partition (Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet Point
nu) EnumSet Point
ns
[(Point, Point)] -> [(Point, Point)]
new <- if EnumSet Point -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet Point
ds
then ([(Point, Point)] -> [(Point, Point)])
-> StateT SMGen Identity ([(Point, Point)] -> [(Point, Point)])
forall (m :: * -> *) a. Monad m => a -> m a
return [(Point, Point)] -> [(Point, Point)]
forall a. a -> a
id
else do
Point
d <- [Point] -> Rnd Point
forall a. [a] -> Rnd a
oneOf (EnumSet Point -> [Point]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet Point
ds)
([(Point, Point)] -> [(Point, Point)])
-> StateT SMGen Identity ([(Point, Point)] -> [(Point, Point)])
forall (m :: * -> *) a. Monad m => a -> m a
return ((Point, Point) -> (Point, Point)
sortPoint (Point
c, Point
d) (Point, Point) -> [(Point, Point)] -> [(Point, Point)]
forall a. a -> [a] -> [a]
:)
EnumSet Point
-> (X, X)
-> EnumSet Point
-> EnumSet Point
-> [(Point, Point)]
-> Rnd [(Point, Point)]
connectGrid' EnumSet Point
voidPlaces (X
nx, X
ny) EnumSet Point
nu
(Point -> EnumSet Point -> EnumSet Point
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.delete Point
c (EnumSet Point
candidates EnumSet Point -> EnumSet Point -> EnumSet Point
forall k. EnumSet k -> EnumSet k -> EnumSet k
`ES.union` EnumSet Point
nc)) ([(Point, Point)] -> [(Point, Point)]
new [(Point, Point)]
acc)
sortPoint :: (Point, Point) -> (Point, Point)
sortPoint :: (Point, Point) -> (Point, Point)
sortPoint (Point
a, Point
b) | Point
a Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
b = (Point
a, Point
b)
| Bool
otherwise = (Point
b, Point
a)
randomConnection :: (X, Y) -> Rnd (Point, Point)
randomConnection :: (X, X) -> Rnd (Point, Point)
randomConnection (X
nx, X
ny) =
Bool -> Rnd (Point, Point) -> Rnd (Point, Point)
forall a. HasCallStack => Bool -> a -> a
assert (X
nx X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
1 Bool -> Bool -> Bool
&& X
ny X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
0 Bool -> Bool -> Bool
|| X
nx X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
0 Bool -> Bool -> Bool
&& X
ny X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
1 Bool -> (X, X) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (X
nx, X
ny)) (Rnd (Point, Point) -> Rnd (Point, Point))
-> Rnd (Point, Point) -> Rnd (Point, Point)
forall a b. (a -> b) -> a -> b
$ do
Bool
rb <- [Bool] -> Rnd Bool
forall a. [a] -> Rnd a
oneOf [Bool
False, Bool
True]
if Bool
rb Bool -> Bool -> Bool
&& X
nx X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
1
then do
X
rx <- X -> Rnd X
forall a. Integral a => a -> Rnd a
randomR0 (X
nx X -> X -> X
forall a. Num a => a -> a -> a
- X
2)
X
ry <- X -> Rnd X
forall a. Integral a => a -> Rnd a
randomR0 (X
ny X -> X -> X
forall a. Num a => a -> a -> a
- X
1)
(Point, Point) -> Rnd (Point, Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (X -> X -> Point
Point X
rx X
ry, X -> X -> Point
Point (X
rxX -> X -> X
forall a. Num a => a -> a -> a
+X
1) X
ry)
else do
X
rx <- X -> Rnd X
forall a. Integral a => a -> Rnd a
randomR0 (X
nx X -> X -> X
forall a. Num a => a -> a -> a
- X
1)
X
ry <- X -> Rnd X
forall a. Integral a => a -> Rnd a
randomR0 (X
ny X -> X -> X
forall a. Num a => a -> a -> a
- X
2)
(Point, Point) -> Rnd (Point, Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (X -> X -> Point
Point X
rx X
ry, X -> X -> Point
Point X
rx (X
ryX -> X -> X
forall a. Num a => a -> a -> a
+X
1))
data HV = Horiz | Vert
deriving HV -> HV -> Bool
(HV -> HV -> Bool) -> (HV -> HV -> Bool) -> Eq HV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HV -> HV -> Bool
$c/= :: HV -> HV -> Bool
== :: HV -> HV -> Bool
$c== :: HV -> HV -> Bool
Eq
type Corridor = (Point, Point, Point, Point)
mkCorridor :: HV
-> Point
-> Bool
-> Point
-> Bool
-> Area
-> Rnd Corridor
mkCorridor :: HV -> Point -> Bool -> Point -> Bool -> Area -> Rnd Corridor
mkCorridor HV
hv (Point X
x0 X
y0) Bool
p0floor (Point X
x1 X
y1) Bool
p1floor Area
area = do
Point X
rxRaw X
ryRaw <- Area -> Rnd Point
pointInArea Area
area
let (X
sx0, X
sy0, X
sx1, X
sy1) = Area -> (X, X, X, X)
fromArea Area
area
rx :: X
rx = if | X
rxRaw X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
sx0 X -> X -> X
forall a. Num a => a -> a -> a
+ X
1 Bool -> Bool -> Bool
&& Bool
p0floor -> X
sx0
| X
rxRaw X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
sx1 X -> X -> X
forall a. Num a => a -> a -> a
- X
1 Bool -> Bool -> Bool
&& Bool
p1floor -> X
sx1
| Bool
otherwise -> X
rxRaw
ry :: X
ry = if | X
ryRaw X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
sy0 X -> X -> X
forall a. Num a => a -> a -> a
+ X
1 Bool -> Bool -> Bool
&& Bool
p0floor -> X
sy0
| X
ryRaw X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
sy1 X -> X -> X
forall a. Num a => a -> a -> a
- X
1 Bool -> Bool -> Bool
&& Bool
p1floor -> X
sy1
| Bool
otherwise -> X
ryRaw
Corridor -> Rnd Corridor
forall (m :: * -> *) a. Monad m => a -> m a
return (Corridor -> Rnd Corridor) -> Corridor -> Rnd Corridor
forall a b. (a -> b) -> a -> b
$! case HV
hv of
HV
Horiz -> (X -> X -> Point
Point X
x0 X
y0, X -> X -> Point
Point X
rx X
y0, X -> X -> Point
Point X
rx X
y1, X -> X -> Point
Point X
x1 X
y1)
HV
Vert -> (X -> X -> Point
Point X
x0 X
y0, X -> X -> Point
Point X
x0 X
ry, X -> X -> Point
Point X
x1 X
ry, X -> X -> Point
Point X
x1 X
y1)
connectPlaces :: (Area, Fence, Area) -> (Area, Fence, Area)
-> Rnd (Maybe Corridor)
connectPlaces :: (Area, Fence, Area) -> (Area, Fence, Area) -> Rnd (Maybe Corridor)
connectPlaces (Area
_, Fence
_, Area
sg) (Area
_, Fence
_, Area
tg) | Area
sg Area -> Area -> Bool
forall a. Eq a => a -> a -> Bool
== Area
tg = Maybe Corridor -> Rnd (Maybe Corridor)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Corridor
forall a. Maybe a
Nothing
connectPlaces s3 :: (Area, Fence, Area)
s3@(Area
sqarea, Fence
spfence, Area
sg) t3 :: (Area, Fence, Area)
t3@(Area
tqarea, Fence
tpfence, Area
tg) = do
let (Area
sa, Area
so, Bool
stiny) = Area -> Fence -> (Area, Area, Bool)
borderPlace Area
sqarea Fence
spfence
(Area
ta, Area
to, Bool
ttiny) = Area -> Fence -> (Area, Area, Bool)
borderPlace Area
tqarea Fence
tpfence
trim :: Area -> Area
trim Area
area =
let (X
x0, X
y0, X
x1, X
y1) = Area -> (X, X, X, X)
fromArea Area
area
dx :: X
dx = case (X
x1 X -> X -> X
forall a. Num a => a -> a -> a
- X
x0) X -> X -> X
forall a. Integral a => a -> a -> a
`div` X
2 of
X
0 -> X
0
X
1 -> X
1
X
2 -> X
1
X
3 -> X
1
X
_ -> X
3
dy :: X
dy = case (X
y1 X -> X -> X
forall a. Num a => a -> a -> a
- X
y0) X -> X -> X
forall a. Integral a => a -> a -> a
`div` X
2 of
X
0 -> X
0
X
1 -> X
1
X
2 -> X
1
X
3 -> X
1
X
_ -> X
3
in Area -> Maybe Area -> Area
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Area
forall a. HasCallStack => [Char] -> a
error ([Char] -> Area) -> [Char] -> Area
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char]
-> (Area, (Area, Fence, Area), (Area, Fence, Area)) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (Area
area, (Area, Fence, Area)
s3, (Area, Fence, Area)
t3))
(Maybe Area -> Area) -> Maybe Area -> Area
forall a b. (a -> b) -> a -> b
$ (X, X, X, X) -> Maybe Area
toArea (X
x0 X -> X -> X
forall a. Num a => a -> a -> a
+ X
dx, X
y0 X -> X -> X
forall a. Num a => a -> a -> a
+ X
dy, X
x1 X -> X -> X
forall a. Num a => a -> a -> a
- X
dx, X
y1 X -> X -> X
forall a. Num a => a -> a -> a
- X
dy)
Point X
sx X
sy <- Area -> Rnd Point
pointInArea (Area -> Rnd Point) -> Area -> Rnd Point
forall a b. (a -> b) -> a -> b
$ Area -> Area
trim Area
sa
Point X
tx X
ty <- Area -> Rnd Point
pointInArea (Area -> Rnd Point) -> Area -> Rnd Point
forall a b. (a -> b) -> a -> b
$ Area -> Area
trim Area
ta
let (X
_, X
_, X
sax1Raw, X
say1Raw) = Area -> (X, X, X, X)
fromArea Area
sa
sslim :: Bool
sslim = Bool
stiny Bool -> Bool -> Bool
&& Fence
spfence Fence -> Fence -> Bool
forall a. Eq a => a -> a -> Bool
== Fence
FNone
(X
sax1, X
say1) = if Bool
sslim
then (X
sax1Raw X -> X -> X
forall a. Num a => a -> a -> a
- X
1, X
say1Raw X -> X -> X
forall a. Num a => a -> a -> a
- X
1)
else (X
sax1Raw, X
say1Raw)
(X
tax0Raw, X
tay0Raw, X
_, X
_) = Area -> (X, X, X, X)
fromArea Area
ta
tslim :: Bool
tslim = Bool
ttiny Bool -> Bool -> Bool
&& Fence
tpfence Fence -> Fence -> Bool
forall a. Eq a => a -> a -> Bool
== Fence
FNone
(X
tax0, X
tay0) = if Bool
tslim
then (X
tax0Raw X -> X -> X
forall a. Num a => a -> a -> a
+ X
1, X
tay0Raw X -> X -> X
forall a. Num a => a -> a -> a
+ X
1)
else (X
tax0Raw, X
tay0Raw)
(X
_, X
_, X
sox1, X
soy1) = Area -> (X, X, X, X)
fromArea Area
so
(X
tox0, X
toy0, X
_, X
_) = Area -> (X, X, X, X)
fromArea Area
to
(X
sgx0, X
sgy0, X
sgx1, X
sgy1) = Area -> (X, X, X, X)
fromArea Area
sg
(X
tgx0, X
tgy0, X
tgx1, X
tgy1) = Area -> (X, X, X, X)
fromArea Area
tg
(HV
hv, Area
area, Point
p0, Point
p1)
| X
sgx1 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
tgx0 =
let x0 :: X
x0 = if X
sgy0 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= X
ty Bool -> Bool -> Bool
&& X
ty X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= X
sgy1 then X
sox1 X -> X -> X
forall a. Num a => a -> a -> a
+ X
1 else X
sgx1
x1 :: X
x1 = if X
tgy0 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= X
sy Bool -> Bool -> Bool
&& X
sy X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= X
tgy1 then X
tox0 X -> X -> X
forall a. Num a => a -> a -> a
- X
1 else X
sgx1
in case (X, X, X, X) -> Maybe Area
toArea (X
x0, X -> X -> X
forall a. Ord a => a -> a -> a
min X
sy X
ty, X
x1, X -> X -> X
forall a. Ord a => a -> a -> a
max X
sy X
ty) of
Just Area
a -> (HV
Horiz, Area
a, X -> X -> Point
Point (X
sax1 X -> X -> X
forall a. Num a => a -> a -> a
+ X
1) X
sy, X -> X -> Point
Point (X
tax0 X -> X -> X
forall a. Num a => a -> a -> a
- X
1) X
ty)
Maybe Area
Nothing -> [Char] -> (HV, Area, Point, Point)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (HV, Area, Point, Point))
-> [Char] -> (HV, Area, Point, Point)
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char]
-> (X, X, X, X, (Area, Fence, Area), (Area, Fence, Area)) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (X
sx, X
sy, X
tx, X
ty, (Area, Fence, Area)
s3, (Area, Fence, Area)
t3)
| Bool
otherwise = Bool -> (HV, Area, Point, Point) -> (HV, Area, Point, Point)
forall a. HasCallStack => Bool -> a -> a
assert (X
sgy1 X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
tgy0) ((HV, Area, Point, Point) -> (HV, Area, Point, Point))
-> (HV, Area, Point, Point) -> (HV, Area, Point, Point)
forall a b. (a -> b) -> a -> b
$
let y0 :: X
y0 = if X
sgx0 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= X
tx Bool -> Bool -> Bool
&& X
tx X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= X
sgx1 then X
soy1 X -> X -> X
forall a. Num a => a -> a -> a
+ X
1 else X
sgy1
y1 :: X
y1 = if X
tgx0 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= X
sx Bool -> Bool -> Bool
&& X
sx X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= X
tgx1 then X
toy0 X -> X -> X
forall a. Num a => a -> a -> a
- X
1 else X
sgy1
in case (X, X, X, X) -> Maybe Area
toArea (X -> X -> X
forall a. Ord a => a -> a -> a
min X
sx X
tx, X
y0, X -> X -> X
forall a. Ord a => a -> a -> a
max X
sx X
tx, X
y1) of
Just Area
a -> (HV
Vert, Area
a, X -> X -> Point
Point X
sx (X
say1 X -> X -> X
forall a. Num a => a -> a -> a
+ X
1), X -> X -> Point
Point X
tx (X
tay0 X -> X -> X
forall a. Num a => a -> a -> a
- X
1))
Maybe Area
Nothing -> [Char] -> (HV, Area, Point, Point)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (HV, Area, Point, Point))
-> [Char] -> (HV, Area, Point, Point)
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char]
-> (X, X, X, X, (Area, Fence, Area), (Area, Fence, Area)) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (X
sx, X
sy, X
tx, X
ty, (Area, Fence, Area)
s3, (Area, Fence, Area)
t3)
nin :: Point -> Bool
nin Point
p = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Area -> Point -> Bool
inside Area
sa Point
p Bool -> Bool -> Bool
|| Area -> Point -> Bool
inside Area
ta Point
p
!_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Bool
sslim Bool -> Bool -> Bool
|| Bool
tslim
Bool -> Bool -> Bool
|| (Point -> Bool) -> [Point] -> Bool
forall a. Show a => (a -> Bool) -> [a] -> Bool
allB Point -> Bool
nin [Point
p0, Point
p1] Bool
-> (X, X, X, X, (Area, Fence, Area), (Area, Fence, Area)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (X
sx, X
sy, X
tx, X
ty, (Area, Fence, Area)
s3, (Area, Fence, Area)
t3)) ()
cor :: Corridor
cor@(Point
c1, Point
c2, Point
c3, Point
c4) <- HV -> Point -> Bool -> Point -> Bool -> Area -> Rnd Corridor
mkCorridor HV
hv Point
p0 (Area
sa Area -> Area -> Bool
forall a. Eq a => a -> a -> Bool
== Area
so) Point
p1 (Area
ta Area -> Area -> Bool
forall a. Eq a => a -> a -> Bool
== Area
to) Area
area
let !_A2 :: ()
_A2 = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Bool
sslim Bool -> Bool -> Bool
|| Bool
tslim Bool -> Bool -> Bool
|| (Point -> Bool) -> [Point] -> Bool
forall a. Show a => (a -> Bool) -> [a] -> Bool
allB Point -> Bool
nin [Point
c1, Point
c2, Point
c3, Point
c4]
Bool
-> (Corridor, X, X, X, X, (Area, Fence, Area), (Area, Fence, Area))
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (Corridor
cor, X
sx, X
sy, X
tx, X
ty, (Area, Fence, Area)
s3, (Area, Fence, Area)
t3)) ()
Maybe Corridor -> Rnd (Maybe Corridor)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Corridor -> Rnd (Maybe Corridor))
-> Maybe Corridor -> Rnd (Maybe Corridor)
forall a b. (a -> b) -> a -> b
$ Corridor -> Maybe Corridor
forall a. a -> Maybe a
Just Corridor
cor
borderPlace :: Area -> Fence -> (Area, Area, Bool)
borderPlace :: Area -> Fence -> (Area, Area, Bool)
borderPlace Area
qarea Fence
pfence = case Fence
pfence of
Fence
FWall -> (Area
qarea, Area -> Area
expand Area
qarea, Bool
False)
Fence
FFloor -> (Area
qarea, Area
qarea, Bool
False)
Fence
FGround -> (Area
qarea, Area
qarea, Bool
False)
Fence
FNone -> case Area -> Maybe Area
shrink Area
qarea of
Maybe Area
Nothing -> (Area
qarea, Area
qarea, Bool
True)
Just Area
sr -> (Area
sr, Area
qarea, Bool
False)
data SpecialArea =
SpecialArea Area
| SpecialFixed Point (Freqs PlaceKind) Area
| SpecialMerged SpecialArea Point
deriving X -> SpecialArea -> ShowS
[SpecialArea] -> ShowS
SpecialArea -> [Char]
(X -> SpecialArea -> ShowS)
-> (SpecialArea -> [Char])
-> ([SpecialArea] -> ShowS)
-> Show SpecialArea
forall a.
(X -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SpecialArea] -> ShowS
$cshowList :: [SpecialArea] -> ShowS
show :: SpecialArea -> [Char]
$cshow :: SpecialArea -> [Char]
showsPrec :: X -> SpecialArea -> ShowS
$cshowsPrec :: X -> SpecialArea -> ShowS
Show
grid :: EM.EnumMap Point (Freqs PlaceKind) -> [Point] -> Area -> (X, Y)
-> ((X, Y), EM.EnumMap Point SpecialArea)
grid :: EnumMap Point (Freqs PlaceKind)
-> [Point] -> Area -> (X, X) -> ((X, X), EnumMap Point SpecialArea)
grid EnumMap Point (Freqs PlaceKind)
fixedCenters [Point]
boot Area
area (X, X)
cellSize =
let (X
x0, X
y0, X
x1, X
y1) = Area -> (X, X, X, X)
fromArea Area
area
f :: X -> X -> X -> X -> [X] -> [(X, X, Maybe X)]
f X
zsize X
z1 X
n X
prev (X
c1 : X
c2 : [X]
rest) =
let len :: X
len = X
c2 X -> X -> X
forall a. Num a => a -> a -> a
- X
c1
cn :: X
cn = X
len X -> X -> X
forall a. Num a => a -> a -> a
* X
n X -> X -> X
forall a. Integral a => a -> a -> a
`div` X
zsize
in
if X
cn X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
2
then let mid1 :: X
mid1 = (X
c1 X -> X -> X
forall a. Num a => a -> a -> a
+ X
c2) X -> X -> X
forall a. Integral a => a -> a -> a
`div` X
2
mid2 :: X
mid2 = (X
c1 X -> X -> X
forall a. Num a => a -> a -> a
+ X
c2) X -> X -> X
forall a. Integral a => a -> a -> a
`divUp` X
2
mid :: X
mid = if X
mid1 X -> X -> X
forall a. Num a => a -> a -> a
- X
prev X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
4 then X
mid1 else X
mid2
in (X
prev, X
mid, X -> Maybe X
forall a. a -> Maybe a
Just X
c1) (X, X, Maybe X) -> [(X, X, Maybe X)] -> [(X, X, Maybe X)]
forall a. a -> [a] -> [a]
: X -> X -> X -> X -> [X] -> [(X, X, Maybe X)]
f X
zsize X
z1 X
n X
mid (X
c2 X -> [X] -> [X]
forall a. a -> [a] -> [a]
: [X]
rest)
else (X
prev, X
c1 X -> X -> X
forall a. Num a => a -> a -> a
+ X
len X -> X -> X
forall a. Integral a => a -> a -> a
`div` (X
2 X -> X -> X
forall a. Num a => a -> a -> a
* X
cn), X -> Maybe X
forall a. a -> Maybe a
Just X
c1)
(X, X, Maybe X) -> [(X, X, Maybe X)] -> [(X, X, Maybe X)]
forall a. a -> [a] -> [a]
: [ ( X
c1 X -> X -> X
forall a. Num a => a -> a -> a
+ X
len X -> X -> X
forall a. Num a => a -> a -> a
* (X
2 X -> X -> X
forall a. Num a => a -> a -> a
* X
z X -> X -> X
forall a. Num a => a -> a -> a
- X
1) X -> X -> X
forall a. Integral a => a -> a -> a
`div` (X
2 X -> X -> X
forall a. Num a => a -> a -> a
* X
cn)
, X
c1 X -> X -> X
forall a. Num a => a -> a -> a
+ X
len X -> X -> X
forall a. Num a => a -> a -> a
* (X
2 X -> X -> X
forall a. Num a => a -> a -> a
* X
z X -> X -> X
forall a. Num a => a -> a -> a
+ X
1) X -> X -> X
forall a. Integral a => a -> a -> a
`div` (X
2 X -> X -> X
forall a. Num a => a -> a -> a
* X
cn)
, Maybe X
forall a. Maybe a
Nothing )
| X
z <- [X
1 .. X
cn X -> X -> X
forall a. Num a => a -> a -> a
- X
1] ]
[(X, X, Maybe X)] -> [(X, X, Maybe X)] -> [(X, X, Maybe X)]
forall a. [a] -> [a] -> [a]
++ X -> X -> X -> X -> [X] -> [(X, X, Maybe X)]
f X
zsize X
z1 X
n (X
c1 X -> X -> X
forall a. Num a => a -> a -> a
+ X
len X -> X -> X
forall a. Num a => a -> a -> a
* (X
2 X -> X -> X
forall a. Num a => a -> a -> a
* X
cn X -> X -> X
forall a. Num a => a -> a -> a
- X
1) X -> X -> X
forall a. Integral a => a -> a -> a
`div` (X
2 X -> X -> X
forall a. Num a => a -> a -> a
* X
cn))
(X
c2 X -> [X] -> [X]
forall a. a -> [a] -> [a]
: [X]
rest)
f X
_ X
z1 X
_ X
prev [X
c1] = [(X
prev, X
z1, X -> Maybe X
forall a. a -> Maybe a
Just X
c1)]
f X
_ X
_ X
_ X
_ [] = [Char] -> [(X, X, Maybe X)]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [(X, X, Maybe X)]) -> [Char] -> [(X, X, Maybe X)]
forall a b. (a -> b) -> a -> b
$ [Char]
"empty list of centers" [Char] -> EnumMap Point (Freqs PlaceKind) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` EnumMap Point (Freqs PlaceKind)
fixedCenters
([X]
xCenters, [X]
yCenters) = [(X, X)] -> ([X], [X])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(X, X)] -> ([X], [X])) -> [(X, X)] -> ([X], [X])
forall a b. (a -> b) -> a -> b
$ (Point -> (X, X)) -> [Point] -> [(X, X)]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> X
px (Point -> X) -> (Point -> X) -> Point -> (X, X)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Point -> X
py) ([Point] -> [(X, X)]) -> [Point] -> [(X, X)]
forall a b. (a -> b) -> a -> b
$ EnumMap Point (Freqs PlaceKind) -> [Point]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys EnumMap Point (Freqs PlaceKind)
fixedCenters
xset :: IntSet
xset = [X] -> IntSet
IS.fromList ([X] -> IntSet) -> [X] -> IntSet
forall a b. (a -> b) -> a -> b
$ [X]
xCenters [X] -> [X] -> [X]
forall a. [a] -> [a] -> [a]
++ (Point -> X) -> [Point] -> [X]
forall a b. (a -> b) -> [a] -> [b]
map Point -> X
px [Point]
boot
yset :: IntSet
yset = [X] -> IntSet
IS.fromList ([X] -> IntSet) -> [X] -> IntSet
forall a b. (a -> b) -> a -> b
$ [X]
yCenters [X] -> [X] -> [X]
forall a. [a] -> [a] -> [a]
++ (Point -> X) -> [Point] -> [X]
forall a b. (a -> b) -> [a] -> [b]
map Point -> X
py [Point]
boot
xsize :: X
xsize = IntSet -> X
IS.findMax IntSet
xset X -> X -> X
forall a. Num a => a -> a -> a
- IntSet -> X
IS.findMin IntSet
xset
ysize :: X
ysize = IntSet -> X
IS.findMax IntSet
yset X -> X -> X
forall a. Num a => a -> a -> a
- IntSet -> X
IS.findMin IntSet
yset
lgrid :: (X, X)
lgrid = ( X
xsize X -> X -> X
forall a. Integral a => a -> a -> a
`div` (X, X) -> X
forall a b. (a, b) -> a
fst (X, X)
cellSize
, X
ysize X -> X -> X
forall a. Integral a => a -> a -> a
`div` (X, X) -> X
forall a b. (a, b) -> b
snd (X, X)
cellSize )
xallSegments :: [(X, (X, X, Maybe X))]
xallSegments = [X] -> [(X, X, Maybe X)] -> [(X, (X, X, Maybe X))]
forall a b. [a] -> [b] -> [(a, b)]
zip [X
0..] ([(X, X, Maybe X)] -> [(X, (X, X, Maybe X))])
-> [(X, X, Maybe X)] -> [(X, (X, X, Maybe X))]
forall a b. (a -> b) -> a -> b
$ X -> X -> X -> X -> [X] -> [(X, X, Maybe X)]
f X
xsize X
x1 ((X, X) -> X
forall a b. (a, b) -> a
fst (X, X)
lgrid) X
x0 ([X] -> [(X, X, Maybe X)]) -> [X] -> [(X, X, Maybe X)]
forall a b. (a -> b) -> a -> b
$ IntSet -> [X]
IS.toList IntSet
xset
yallSegments :: [(X, (X, X, Maybe X))]
yallSegments = [X] -> [(X, X, Maybe X)] -> [(X, (X, X, Maybe X))]
forall a b. [a] -> [b] -> [(a, b)]
zip [X
0..] ([(X, X, Maybe X)] -> [(X, (X, X, Maybe X))])
-> [(X, X, Maybe X)] -> [(X, (X, X, Maybe X))]
forall a b. (a -> b) -> a -> b
$ X -> X -> X -> X -> [X] -> [(X, X, Maybe X)]
f X
ysize X
y1 ((X, X) -> X
forall a b. (a, b) -> b
snd (X, X)
lgrid) X
y0 ([X] -> [(X, X, Maybe X)]) -> [X] -> [(X, X, Maybe X)]
forall a b. (a -> b) -> a -> b
$ IntSet -> [X]
IS.toList IntSet
yset
in
( ([(X, (X, X, Maybe X))] -> X
forall a. [a] -> X
length [(X, (X, X, Maybe X))]
xallSegments, [(X, (X, X, Maybe X))] -> X
forall a. [a] -> X
length [(X, (X, X, Maybe X))]
yallSegments)
, [(Point, SpecialArea)] -> EnumMap Point SpecialArea
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList
[ ( X -> X -> Point
Point X
x X
y
, case (Maybe X
mcx, Maybe X
mcy) of
(Just X
cx, Just X
cy) ->
case Point -> EnumMap Point (Freqs PlaceKind) -> Maybe (Freqs PlaceKind)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup (X -> X -> Point
Point X
cx X
cy) EnumMap Point (Freqs PlaceKind)
fixedCenters of
Maybe (Freqs PlaceKind)
Nothing -> Area -> SpecialArea
SpecialArea Area
sarea
Just Freqs PlaceKind
placeFreq -> Point -> Freqs PlaceKind -> Area -> SpecialArea
SpecialFixed (X -> X -> Point
Point X
cx X
cy) Freqs PlaceKind
placeFreq Area
sarea
(Maybe X, Maybe X)
_ -> Area -> SpecialArea
SpecialArea Area
sarea )
| (X
y, (X
cy0, X
cy1, Maybe X
mcy)) <- [(X, (X, X, Maybe X))]
yallSegments
, (X
x, (X
cx0, X
cx1, Maybe X
mcx)) <- [(X, (X, X, Maybe X))]
xallSegments
, let sarea :: Area
sarea = Area -> Maybe Area -> Area
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Area
forall a. HasCallStack => [Char] -> a
error ([Char] -> Area) -> [Char] -> Area
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (X, X) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (X
x, X
y))
(Maybe Area -> Area) -> Maybe Area -> Area
forall a b. (a -> b) -> a -> b
$ (X, X, X, X) -> Maybe Area
toArea (X
cx0, X
cy0, X
cx1, X
cy1) ] )