module Game.LambdaHack.Server.FovDigital
( scan
, Bump(..)
#ifdef EXPOSE_INTERNAL
, Distance, Progress
, LineOrdering, Line(..), ConvexHull(..), CHull(..), Edge, EdgeInterval
, steepestInHull, foldlCHull', addToHull, addToHullGo
, createLine, steepness, intersect
, _debugSteeper, _debugLine
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude hiding (intersect)
import Game.LambdaHack.Common.Point (PointI)
type Distance = Int
type Progress = Int
data Bump = B
{ Bump -> Distance
bx :: Int
, Bump -> Distance
by :: Int
}
deriving Distance -> Bump -> ShowS
[Bump] -> ShowS
Bump -> [Char]
(Distance -> Bump -> ShowS)
-> (Bump -> [Char]) -> ([Bump] -> ShowS) -> Show Bump
forall a.
(Distance -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Bump] -> ShowS
$cshowList :: [Bump] -> ShowS
show :: Bump -> [Char]
$cshow :: Bump -> [Char]
showsPrec :: Distance -> Bump -> ShowS
$cshowsPrec :: Distance -> Bump -> ShowS
Show
data LineOrdering = Steeper | Shallower
data Line = Line Bump Bump
deriving Distance -> Line -> ShowS
[Line] -> ShowS
Line -> [Char]
(Distance -> Line -> ShowS)
-> (Line -> [Char]) -> ([Line] -> ShowS) -> Show Line
forall a.
(Distance -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> [Char]
$cshow :: Line -> [Char]
showsPrec :: Distance -> Line -> ShowS
$cshowsPrec :: Distance -> Line -> ShowS
Show
data ConvexHull = ConvexHull Bump CHull
deriving Distance -> ConvexHull -> ShowS
[ConvexHull] -> ShowS
ConvexHull -> [Char]
(Distance -> ConvexHull -> ShowS)
-> (ConvexHull -> [Char])
-> ([ConvexHull] -> ShowS)
-> Show ConvexHull
forall a.
(Distance -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConvexHull] -> ShowS
$cshowList :: [ConvexHull] -> ShowS
show :: ConvexHull -> [Char]
$cshow :: ConvexHull -> [Char]
showsPrec :: Distance -> ConvexHull -> ShowS
$cshowsPrec :: Distance -> ConvexHull -> ShowS
Show
data CHull =
CHNil
| CHCons Bump CHull
deriving Distance -> CHull -> ShowS
[CHull] -> ShowS
CHull -> [Char]
(Distance -> CHull -> ShowS)
-> (CHull -> [Char]) -> ([CHull] -> ShowS) -> Show CHull
forall a.
(Distance -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CHull] -> ShowS
$cshowList :: [CHull] -> ShowS
show :: CHull -> [Char]
$cshow :: CHull -> [Char]
showsPrec :: Distance -> CHull -> ShowS
$cshowsPrec :: Distance -> CHull -> ShowS
Show
type Edge = (Line, ConvexHull)
type EdgeInterval = (Edge, Edge)
scan :: Distance
-> (PointI -> Bool)
-> (Bump -> PointI)
-> [PointI]
{-# INLINE scan #-}
scan :: Distance -> (Distance -> Bool) -> (Bump -> Distance) -> [Distance]
scan !Distance
r Distance -> Bool
isClear Bump -> Distance
tr =
#ifdef WITH_EXPENSIVE_ASSERTIONS
assert (r > 0 `blame` r) $
#endif
Distance -> EdgeInterval -> [Distance]
dscan Distance
1 ( (Bump -> Bump -> Line
Line (Distance -> Distance -> Bump
B Distance
1 Distance
0) (Distance -> Distance -> Bump
B (-Distance
r) Distance
r), Bump -> CHull -> ConvexHull
ConvexHull (Distance -> Distance -> Bump
B Distance
0 Distance
0) CHull
CHNil)
, (Bump -> Bump -> Line
Line (Distance -> Distance -> Bump
B Distance
0 Distance
0) (Distance -> Distance -> Bump
B (Distance
rDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
+Distance
1) Distance
r), Bump -> CHull -> ConvexHull
ConvexHull (Distance -> Distance -> Bump
B Distance
1 Distance
0) CHull
CHNil) )
where
dscan :: Distance -> EdgeInterval -> [PointI]
{-# INLINE dscan #-}
dscan :: Distance -> EdgeInterval -> [Distance]
dscan !Distance
d ( (Line
sl, ConvexHull
sHull), (Line
el, ConvexHull
eHull) ) =
Distance -> Line -> ConvexHull -> Line -> ConvexHull -> [Distance]
dgo Distance
d Line
sl ConvexHull
sHull Line
el ConvexHull
eHull
dgo :: Distance -> Line -> ConvexHull -> Line -> ConvexHull -> [PointI]
dgo :: Distance -> Line -> ConvexHull -> Line -> ConvexHull -> [Distance]
dgo !Distance
d !Line
sl ConvexHull
sHull !Line
el ConvexHull
eHull =
let !ps0 :: Distance
ps0 = let (Distance
n, Distance
k) = Line -> Distance -> (Distance, Distance)
intersect Line
sl Distance
d
in Distance
n Distance -> Distance -> Distance
forall a. Integral a => a -> a -> a
`div` Distance
k
!pe :: Distance
pe = let (Distance
n, Distance
k) = Line -> Distance -> (Distance, Distance)
intersect Line
el Distance
d
in -Distance
1 Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
+ Distance
n Distance -> Distance -> Distance
forall a. Integral a => a -> a -> a
`divUp` Distance
k
outside :: [Distance]
outside =
if Distance
d Distance -> Distance -> Bool
forall a. Ord a => a -> a -> Bool
< Distance
r
then let !trBump :: Distance
trBump = Distance -> Distance
bump Distance
ps0
in if Distance -> Bool
isClear Distance
trBump
then Distance
trBump Distance -> [Distance] -> [Distance]
forall a. a -> [a] -> [a]
: Line -> ConvexHull -> Distance -> [Distance]
mscanVisible Line
sl ConvexHull
sHull (Distance
ps0Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
+Distance
1)
else Distance
trBump Distance -> [Distance] -> [Distance]
forall a. a -> [a] -> [a]
: Distance -> [Distance]
mscanShadowed (Distance
ps0Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
+Distance
1)
else (Distance -> Distance) -> [Distance] -> [Distance]
forall a b. (a -> b) -> [a] -> [b]
map Distance -> Distance
bump [Distance
ps0..Distance
pe]
bump :: Progress -> PointI
bump :: Distance -> Distance
bump !Distance
px = Bump -> Distance
tr (Bump -> Distance) -> Bump -> Distance
forall a b. (a -> b) -> a -> b
$ Distance -> Distance -> Bump
B Distance
px Distance
d
mscanVisible :: Line -> ConvexHull -> Progress -> [PointI]
mscanVisible :: Line -> ConvexHull -> Distance -> [Distance]
mscanVisible Line
line ConvexHull
hull = Distance -> [Distance]
goVisible
where
goVisible :: Progress -> [PointI]
goVisible :: Distance -> [Distance]
goVisible !Distance
ps =
if Distance
ps Distance -> Distance -> Bool
forall a. Ord a => a -> a -> Bool
<= Distance
pe
then let !trBump :: Distance
trBump = Distance -> Distance
bump Distance
ps
in if Distance -> Bool
isClear Distance
trBump
then Distance
trBump Distance -> [Distance] -> [Distance]
forall a. a -> [a] -> [a]
: Distance -> [Distance]
goVisible (Distance
psDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
+Distance
1)
else let steepBump :: Bump
steepBump = Distance -> Distance -> Bump
B Distance
ps Distance
d
nep :: Bump
nep = LineOrdering -> Bump -> ConvexHull -> Bump
steepestInHull LineOrdering
Shallower Bump
steepBump ConvexHull
hull
neLine :: Line
neLine = Bump -> Bump -> Line
createLine Bump
nep Bump
steepBump
neHull :: ConvexHull
neHull = LineOrdering -> Bump -> ConvexHull -> ConvexHull
addToHull LineOrdering
Shallower Bump
steepBump ConvexHull
eHull
in Distance
trBump Distance -> [Distance] -> [Distance]
forall a. a -> [a] -> [a]
: Distance -> Line -> ConvexHull -> Line -> ConvexHull -> [Distance]
dgo (Distance
dDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
+Distance
1) Line
line ConvexHull
hull Line
neLine ConvexHull
neHull
[Distance] -> [Distance] -> [Distance]
forall a. [a] -> [a] -> [a]
++ Distance -> [Distance]
mscanShadowed (Distance
psDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
+Distance
1)
else Distance -> Line -> ConvexHull -> Line -> ConvexHull -> [Distance]
dgo (Distance
dDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
+Distance
1) Line
line ConvexHull
hull Line
el ConvexHull
eHull
mscanShadowed :: Progress -> [PointI]
mscanShadowed :: Distance -> [Distance]
mscanShadowed !Distance
ps =
if Distance
ps Distance -> Distance -> Bool
forall a. Ord a => a -> a -> Bool
<= Distance
pe
then let !trBump :: Distance
trBump = Distance -> Distance
bump Distance
ps
in if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Distance -> Bool
isClear Distance
trBump
then Distance
trBump Distance -> [Distance] -> [Distance]
forall a. a -> [a] -> [a]
: Distance -> [Distance]
mscanShadowed (Distance
psDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
+Distance
1)
else let shallowBump :: Bump
shallowBump = Distance -> Distance -> Bump
B Distance
ps Distance
d
nsp :: Bump
nsp = LineOrdering -> Bump -> ConvexHull -> Bump
steepestInHull LineOrdering
Steeper Bump
shallowBump ConvexHull
eHull
nsLine :: Line
nsLine = Bump -> Bump -> Line
createLine Bump
nsp Bump
shallowBump
nsHull :: ConvexHull
nsHull = LineOrdering -> Bump -> ConvexHull -> ConvexHull
addToHull LineOrdering
Steeper Bump
shallowBump ConvexHull
sHull
in Distance
trBump Distance -> [Distance] -> [Distance]
forall a. a -> [a] -> [a]
: Line -> ConvexHull -> Distance -> [Distance]
mscanVisible Line
nsLine ConvexHull
nsHull (Distance
psDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
+Distance
1)
else []
in
#ifdef WITH_EXPENSIVE_ASSERTIONS
assert (r >= d && d >= 0 && pe >= ps0
`blame` (r,d,sl,sHull,el,eHull,ps0,pe))
#endif
[Distance]
outside
steepestInHull :: LineOrdering -> Bump -> ConvexHull -> Bump
{-# NOINLINE steepestInHull #-}
steepestInHull :: LineOrdering -> Bump -> ConvexHull -> Bump
steepestInHull !LineOrdering
lineOrdering !Bump
new (ConvexHull !Bump
b !CHull
ch) = (Bump -> Bump -> Bump) -> Bump -> CHull -> Bump
forall a. (a -> Bump -> a) -> a -> CHull -> a
foldlCHull' Bump -> Bump -> Bump
max' Bump
b CHull
ch
where max' :: Bump -> Bump -> Bump
max' !Bump
x !Bump
y = if LineOrdering -> Bump -> Bump -> Bump -> Bool
steepness LineOrdering
lineOrdering Bump
new Bump
x Bump
y then Bump
x else Bump
y
foldlCHull' :: (a -> Bump -> a) -> a -> CHull -> a
{-# INLINE foldlCHull' #-}
foldlCHull' :: forall a. (a -> Bump -> a) -> a -> CHull -> a
foldlCHull' a -> Bump -> a
f = a -> CHull -> a
fgo
where fgo :: a -> CHull -> a
fgo !a
z CHull
CHNil = a
z
fgo a
z (CHCons Bump
b CHull
ch) = a -> CHull -> a
fgo (a -> Bump -> a
f a
z Bump
b) CHull
ch
addToHull :: LineOrdering
-> Bump
-> ConvexHull
-> ConvexHull
{-# INLINE addToHull #-}
addToHull :: LineOrdering -> Bump -> ConvexHull -> ConvexHull
addToHull LineOrdering
lineOrdering Bump
new (ConvexHull Bump
old CHull
ch) =
Bump -> CHull -> ConvexHull
ConvexHull Bump
new (CHull -> ConvexHull) -> CHull -> ConvexHull
forall a b. (a -> b) -> a -> b
$ LineOrdering -> Bump -> CHull -> CHull
addToHullGo LineOrdering
lineOrdering Bump
new (CHull -> CHull) -> CHull -> CHull
forall a b. (a -> b) -> a -> b
$ Bump -> CHull -> CHull
CHCons Bump
old CHull
ch
addToHullGo :: LineOrdering -> Bump -> CHull -> CHull
{-# NOINLINE addToHullGo #-}
addToHullGo :: LineOrdering -> Bump -> CHull -> CHull
addToHullGo !LineOrdering
lineOrdering !Bump
new = CHull -> CHull
hgo
where
hgo :: CHull -> CHull
hgo :: CHull -> CHull
hgo (CHCons Bump
a ch :: CHull
ch@(CHCons Bump
b CHull
_)) | Bool -> Bool
not (LineOrdering -> Bump -> Bump -> Bump -> Bool
steepness LineOrdering
lineOrdering Bump
new Bump
b Bump
a) = CHull -> CHull
hgo CHull
ch
hgo CHull
ch = CHull
ch
createLine :: Bump -> Bump -> Line
{-# INLINE createLine #-}
createLine :: Bump -> Bump -> Line
createLine Bump
p1 Bump
p2 =
let line :: Line
line = Bump -> Bump -> Line
Line Bump
p1 Bump
p2
in
#ifdef WITH_EXPENSIVE_ASSERTIONS
assert (uncurry blame $ _debugLine line)
#endif
Line
line
steepness :: LineOrdering -> Bump -> Bump -> Bump -> Bool
{-# INLINE steepness #-}
steepness :: LineOrdering -> Bump -> Bump -> Bump -> Bool
steepness LineOrdering
lineOrdering (B Distance
xf Distance
yf) (B Distance
x1 Distance
y1) (B Distance
x2 Distance
y2) =
let y2x1 :: Distance
y2x1 = (Distance
yf Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
- Distance
y2) Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
* (Distance
xf Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
- Distance
x1)
y1x2 :: Distance
y1x2 = (Distance
yf Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
- Distance
y1) Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
* (Distance
xf Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
- Distance
x2)
res :: Bool
res = case LineOrdering
lineOrdering of
LineOrdering
Steeper -> Distance
y2x1 Distance -> Distance -> Bool
forall a. Ord a => a -> a -> Bool
> Distance
y1x2
LineOrdering
Shallower -> Distance
y2x1 Distance -> Distance -> Bool
forall a. Ord a => a -> a -> Bool
< Distance
y1x2
in
#ifdef WITH_EXPENSIVE_ASSERTIONS
assert (res == _debugSteeper lineOrdering (B xf yf) (B x1 y1) (B x2 y2))
#endif
Bool
res
intersect :: Line -> Distance -> (Int, Int)
{-# INLINE intersect #-}
intersect :: Line -> Distance -> (Distance, Distance)
intersect (Line (B Distance
x Distance
y) (B Distance
xf Distance
yf)) Distance
d =
#ifdef WITH_EXPENSIVE_ASSERTIONS
assert (allB (>= 0) [y, yf])
#endif
((Distance
d Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
- Distance
y)Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
*(Distance
xf Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
- Distance
x) Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
+ Distance
xDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
*(Distance
yf Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
- Distance
y), Distance
yf Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
- Distance
y)
_debugSteeper :: LineOrdering -> Bump -> Bump -> Bump -> Bool
{-# INLINE _debugSteeper #-}
_debugSteeper :: LineOrdering -> Bump -> Bump -> Bump -> Bool
_debugSteeper LineOrdering
lineOrdering f :: Bump
f@(B Distance
_xf Distance
yf) p1 :: Bump
p1@(B Distance
_x1 Distance
y1) p2 :: Bump
p2@(B Distance
_x2 Distance
y2) =
Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ((Distance -> Bool) -> [Distance] -> Bool
forall v. Show v => (v -> Bool) -> [v] -> Bool
allB (Distance -> Distance -> Bool
forall a. Ord a => a -> a -> Bool
>= Distance
0) [Distance
yf, Distance
y1, Distance
y2]) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
let (Distance
n1, Distance
k1) = Line -> Distance -> (Distance, Distance)
intersect (Bump -> Bump -> Line
Line Bump
p1 Bump
f) Distance
0
(Distance
n2, Distance
k2) = Line -> Distance -> (Distance, Distance)
intersect (Bump -> Bump -> Line
Line Bump
p2 Bump
f) Distance
0
sign :: Ordering
sign = case LineOrdering
lineOrdering of
LineOrdering
Steeper -> Ordering
GT
LineOrdering
Shallower -> Ordering
LT
in Distance -> Distance -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Distance
k1 Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
* Distance
n2) (Distance
n1 Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
* Distance
k2) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
sign
_debugLine :: Line -> (Bool, String)
{-# INLINE _debugLine #-}
_debugLine :: Line -> (Bool, [Char])
_debugLine line :: Line
line@(Line (B Distance
x1 Distance
y1) (B Distance
x2 Distance
y2))
| Bool -> Bool
not ((Distance -> Bool) -> [Distance] -> Bool
forall v. Show v => (v -> Bool) -> [v] -> Bool
allB (Distance -> Distance -> Bool
forall a. Ord a => a -> a -> Bool
>= Distance
0) [Distance
y1, Distance
y2]) =
(Bool
False, [Char]
"negative Y coordinates: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Line -> [Char]
forall a. Show a => a -> [Char]
show Line
line)
| Distance
y1 Distance -> Distance -> Bool
forall a. Eq a => a -> a -> Bool
== Distance
y2 Bool -> Bool -> Bool
&& Distance
x1 Distance -> Distance -> Bool
forall a. Eq a => a -> a -> Bool
== Distance
x2 =
(Bool
False, [Char]
"ill-defined line: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Line -> [Char]
forall a. Show a => a -> [Char]
show Line
line)
| Distance
y1 Distance -> Distance -> Bool
forall a. Eq a => a -> a -> Bool
== Distance
y2 =
(Bool
False, [Char]
"horizontal line: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Line -> [Char]
forall a. Show a => a -> [Char]
show Line
line)
| Bool
crossL0 =
(Bool
False, [Char]
"crosses the X axis below 0: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Line -> [Char]
forall a. Show a => a -> [Char]
show Line
line)
| Bool
crossG1 =
(Bool
False, [Char]
"crosses the X axis above 1: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Line -> [Char]
forall a. Show a => a -> [Char]
show Line
line)
| Bool
otherwise = (Bool
True, [Char]
"")
where
(Distance
n, Distance
k) = Line
line Line -> Distance -> (Distance, Distance)
`intersect` Distance
0
(Distance
q, Distance
r) = if Distance
k Distance -> Distance -> Bool
forall a. Eq a => a -> a -> Bool
== Distance
0 then (Distance
0, Distance
0) else Distance
n Distance -> Distance -> (Distance, Distance)
forall a. Integral a => a -> a -> (a, a)
`divMod` Distance
k
crossL0 :: Bool
crossL0 = Distance
q Distance -> Distance -> Bool
forall a. Ord a => a -> a -> Bool
< Distance
0
crossG1 :: Bool
crossG1 = Distance
q Distance -> Distance -> Bool
forall a. Ord a => a -> a -> Bool
>= Distance
1 Bool -> Bool -> Bool
&& (Distance
q Distance -> Distance -> Bool
forall a. Ord a => a -> a -> Bool
> Distance
1 Bool -> Bool -> Bool
|| Distance
r Distance -> Distance -> Bool
forall a. Eq a => a -> a -> Bool
/= Distance
0)