-- | DFOV (Digital Field of View) implemented according to specification at <http://roguebasin.roguelikedevelopment.org/index.php?title=Digital_field_of_view_implementation>.
-- This fast version of the algorithm, based on PFOV, has AFAIK
-- never been described nor implemented before.
--
-- The map is processed in depth-first-search manner, that is, as soon
-- as we detect on obstacle we move away from the viewer up to the
-- FOV radius and then restart on the other side of the obstacle.
-- This has better cache behaviour than breadth-firsts-search,
-- where we would process all tiles equally distant from the viewer
-- in the same round, because then we'd need to keep the many convex hulls
-- and edges, not just a single set, and we'd potentially traverse all
-- of them each round.
module Game.LambdaHack.Server.FovDigital
  ( scan
    -- * Scanning coordinate system
  , Bump(..)
    -- * Assorted minor operations
#ifdef EXPOSE_INTERNAL
    -- * Current scan parameters
  , Distance, Progress
    -- * Geometry in system @Bump@
  , LineOrdering, Line(..), ConvexHull(..), CHull(..), Edge, EdgeInterval
    -- * Internal operations
  , 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)

-- | Distance from the (0, 0) point where FOV originates.
type Distance = Int

-- | Progress along an arc with a constant distance from (0, 0).
type Progress = Int

-- | Rotated and translated coordinates of 2D points, so that the points fit
-- in a single quadrant area (e, g., quadrant I for Permissive FOV, hence both
-- coordinates positive; adjacent diagonal halves of quadrant I and II
-- for Digital FOV, hence y positive).
-- The special coordinates are written using the standard mathematical
-- coordinate setup, where quadrant I, with x and y positive,
-- is on the upper right.
data Bump = B
  { Bump -> Int
bx :: Int
  , Bump -> Int
by :: Int
  }
  deriving Int -> Bump -> ShowS
[Bump] -> ShowS
Bump -> String
(Int -> Bump -> ShowS)
-> (Bump -> String) -> ([Bump] -> ShowS) -> Show Bump
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bump] -> ShowS
$cshowList :: [Bump] -> ShowS
show :: Bump -> String
$cshow :: Bump -> String
showsPrec :: Int -> Bump -> ShowS
$cshowsPrec :: Int -> Bump -> ShowS
Show

-- | Two strict orderings of lines with a common point.
data LineOrdering = Steeper | Shallower

-- | Straight line between points.
data Line = Line Bump Bump
  deriving Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show

-- | Convex hull represented as a non-empty list of points.
data ConvexHull = ConvexHull Bump CHull
  deriving Int -> ConvexHull -> ShowS
[ConvexHull] -> ShowS
ConvexHull -> String
(Int -> ConvexHull -> ShowS)
-> (ConvexHull -> String)
-> ([ConvexHull] -> ShowS)
-> Show ConvexHull
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConvexHull] -> ShowS
$cshowList :: [ConvexHull] -> ShowS
show :: ConvexHull -> String
$cshow :: ConvexHull -> String
showsPrec :: Int -> ConvexHull -> ShowS
$cshowsPrec :: Int -> ConvexHull -> ShowS
Show

data CHull =
    CHNil
  | CHCons Bump CHull
  deriving Int -> CHull -> ShowS
[CHull] -> ShowS
CHull -> String
(Int -> CHull -> ShowS)
-> (CHull -> String) -> ([CHull] -> ShowS) -> Show CHull
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CHull] -> ShowS
$cshowList :: [CHull] -> ShowS
show :: CHull -> String
$cshow :: CHull -> String
showsPrec :: Int -> CHull -> ShowS
$cshowsPrec :: Int -> CHull -> ShowS
Show

-- | An edge (comprising of a line and a convex hull) of the area to be scanned.
type Edge = (Line, ConvexHull)

-- | The contiguous area left to be scanned, delimited by edges.
type EdgeInterval = (Edge, Edge)

-- | Calculates the list of tiles visible from (0, 0) within the given
-- sight range.
scan :: Distance          -- ^ visiblity distance
     -> (PointI -> Bool)  -- ^ visually clear position predicate
     -> (Bump -> PointI)  -- ^ coordinate transformation
     -> [PointI]
{-# INLINE scan #-}
scan :: Int -> (Int -> Bool) -> (Bump -> Int) -> [Int]
scan !Int
r isClear :: Int -> Bool
isClear tr :: Bump -> Int
tr =
#ifdef WITH_EXPENSIVE_ASSERTIONS
 Bool -> [Int] -> [Int]
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Int -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` Int
r) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$  -- not really expensive, but obfuscates Core
#endif
  -- The scanned area is a square, which is a sphere in the chessboard metric.
  Int -> EdgeInterval -> [Int]
dscan 1 ( (Bump -> Bump -> Line
Line (Int -> Int -> Bump
B 1 0) (Int -> Int -> Bump
B (-Int
r) Int
r), Bump -> CHull -> ConvexHull
ConvexHull (Int -> Int -> Bump
B 0 0) CHull
CHNil)
          , (Bump -> Bump -> Line
Line (Int -> Int -> Bump
B 0 0) (Int -> Int -> Bump
B (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Int
r), Bump -> CHull -> ConvexHull
ConvexHull (Int -> Int -> Bump
B 1 0) CHull
CHNil) )
 where
  dscan :: Distance -> EdgeInterval -> [PointI]
  {-# INLINE dscan #-}
  dscan :: Int -> EdgeInterval -> [Int]
dscan !Int
d ( (sl :: Line
sl{-shallow line-}, sHull :: ConvexHull
sHull), (el :: Line
el{-steep line-}, eHull :: ConvexHull
eHull) ) =
    Int -> Line -> ConvexHull -> Line -> ConvexHull -> [Int]
dgo Int
d Line
sl ConvexHull
sHull Line
el ConvexHull
eHull

  -- Speed (mosty JS) and generally convincing GHC to unbox stuff.
  dgo :: Distance -> Line -> ConvexHull -> Line -> ConvexHull -> [PointI]
  dgo :: Int -> Line -> ConvexHull -> Line -> ConvexHull -> [Int]
dgo !Int
d !Line
sl sHull :: ConvexHull
sHull !Line
el eHull :: ConvexHull
eHull =  -- @sHull@ and @eHull@ may be unused

    let !ps0 :: Int
ps0 = let (n :: Int
n, k :: Int
k) = Line -> Int -> (Int, Int)
intersect Line
sl Int
d  -- minimal progress to consider
               in Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
k
        !pe :: Int
pe = let (n :: Int
n, k :: Int
k) = Line -> Int -> (Int, Int)
intersect Line
el Int
d   -- maximal progress to consider
                -- Corners obstruct view, so the steep line, constructed
                -- from corners, is itself not a part of the view,
                -- so if its intersection with the horizonstal line at distance
                -- @d@ is only at a corner, we choose the position leading
                -- to a smaller view.
              in -1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`divUp` Int
k
        outside :: [Int]
outside =
          if Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
r
          then let !trBump :: Int
trBump = Int -> Int
bump Int
ps0
               in if Int -> Bool
isClear Int
trBump
                  then Int
trBump Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Line -> ConvexHull -> Int -> [Int]
mscanVisible Line
sl ConvexHull
sHull (Int
ps0Int -> Int -> Int
forall a. Num a => a -> a -> a
+1)  -- start visible
                  else Int
trBump Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> [Int]
mscanShadowed (Int
ps0Int -> Int -> Int
forall a. Num a => a -> a -> a
+1)    -- start in shadow
          else (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int
bump [Int
ps0..Int
pe]

        bump :: Progress -> PointI
        bump :: Int -> Int
bump !Int
px = Bump -> Int
tr (Bump -> Int) -> Bump -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Bump
B Int
px Int
d

        -- We're in a visible interval.
        mscanVisible :: Line -> ConvexHull -> Progress -> [PointI]
        mscanVisible :: Line -> ConvexHull -> Int -> [Int]
mscanVisible line :: Line
line hull :: ConvexHull
hull = Int -> [Int]
goVisible
         where
          goVisible :: Progress -> [PointI]
          goVisible :: Int -> [Int]
goVisible !Int
ps =
            if Int
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
pe
            then let !trBump :: Int
trBump = Int -> Int
bump Int
ps
                 in if Int -> Bool
isClear Int
trBump  -- not entering shadow
                    then Int
trBump Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> [Int]
goVisible (Int
psInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
                    else let steepBump :: Bump
steepBump = Int -> Int -> Bump
B Int
ps Int
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 Int
trBump Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> Line -> ConvexHull -> Line -> ConvexHull -> [Int]
dgo (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Line
line ConvexHull
hull Line
neLine ConvexHull
neHull
                            [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
mscanShadowed (Int
psInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
                              -- note how we recursively scan more and more
                              -- distant tiles, up to the FOV radius,
                              -- before starting to process the shadow
            else Int -> Line -> ConvexHull -> Line -> ConvexHull -> [Int]
dgo (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Line
line ConvexHull
hull Line
el ConvexHull
eHull  -- reached end, scan next row

        -- We're in a shadowed interval.
        mscanShadowed :: Progress -> [PointI]
        mscanShadowed :: Int -> [Int]
mscanShadowed !Int
ps =
          if Int
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
pe
          then let !trBump :: Int
trBump = Int -> Int
bump Int
ps
               in if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Bool
isClear Int
trBump  -- not moving out of shadow
                  then Int
trBump Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> [Int]
mscanShadowed (Int
psInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
                  else let shallowBump :: Bump
shallowBump = Int -> Int -> Bump
B Int
ps Int
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 Int
trBump Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Line -> ConvexHull -> Int -> [Int]
mscanVisible Line
nsLine ConvexHull
nsHull (Int
psInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
          else []  -- reached end while in shadow

    in
#ifdef WITH_EXPENSIVE_ASSERTIONS
      Bool -> [Int] -> [Int]
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
d Bool -> Bool -> Bool
&& Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Int
pe Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ps0
              Bool
-> (Int, Int, Line, ConvexHull, Line, ConvexHull, Int, Int) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (Int
r,Int
d,Line
sl,ConvexHull
sHull,Line
el,ConvexHull
eHull,Int
ps0,Int
pe))
#endif
        [Int]
outside

-- | Specialized implementation for speed in the inner loop. Not partial.
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

-- | Standard @foldl'@ over @CHull@.
foldlCHull' :: (a -> Bump -> a) -> a -> CHull -> a
{-# INLINE foldlCHull' #-}
foldlCHull' :: (a -> Bump -> a) -> a -> CHull -> a
foldlCHull' f :: a -> Bump -> a
f = a -> CHull -> a
fgo
 where fgo :: a -> CHull -> a
fgo !a
z CHNil = a
z
       fgo z :: a
z (CHCons b :: Bump
b ch :: CHull
ch) = a -> CHull -> a
fgo (a -> Bump -> a
f a
z Bump
b) CHull
ch

-- | Extends a convex hull of bumps with a new bump. The new bump makes
-- some old bumps unnecessary, e.g. those that are joined with the new steep
-- bump with lines that are not shallower than any newer lines in the hull.
-- Removing such unnecessary bumps slightly speeds up computation
-- of 'steepestInHull'.
--
-- Recursion in @addToHullGo@ seems spurious, but it's called each time with
-- potentially different comparison predicate, so it's necessary.
addToHull :: LineOrdering  -- ^ the line ordering to use
          -> Bump          -- ^ a new bump to consider
          -> ConvexHull    -- ^ a convex hull of bumps represented as a list
          -> ConvexHull
{-# INLINE addToHull #-}
addToHull :: LineOrdering -> Bump -> ConvexHull -> ConvexHull
addToHull lineOrdering :: LineOrdering
lineOrdering new :: Bump
new (ConvexHull old :: Bump
old ch :: 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

-- This worker is needed to avoid Core returning a pair (new, result)
-- and also Bump-packing new (steepBump/shallowBump) twice, losing sharing.
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 a :: Bump
a ch :: CHull
ch@(CHCons b :: Bump
b _)) | Bool -> Bool
not (LineOrdering -> Bump -> Bump -> Bump -> Bool
steepness LineOrdering
lineOrdering Bump
new Bump
b Bump
a) = CHull -> CHull
hgo CHull
ch
  hgo ch :: CHull
ch = CHull
ch

-- | Create a line from two points.
--
-- Debug: check if well-defined.
createLine :: Bump -> Bump -> Line
{-# INLINE createLine #-}
createLine :: Bump -> Bump -> Line
createLine p1 :: Bump
p1 p2 :: Bump
p2 =
  let line :: Line
line = Bump -> Bump -> Line
Line Bump
p1 Bump
p2
  in
#ifdef WITH_EXPENSIVE_ASSERTIONS
    Bool -> Line -> Line
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ((Bool -> String -> Bool) -> (Bool, String) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> String -> Bool
forall a. Show a => Bool -> a -> Bool
blame ((Bool, String) -> Bool) -> (Bool, String) -> Bool
forall a b. (a -> b) -> a -> b
$ Line -> (Bool, String)
_debugLine Line
line)
#endif
      Line
line

-- | Strictly compare steepness of lines @(b1, bf)@ and @(b2, bf)@,
-- according to the @LineOrdering@ given. This is related to comparing
-- the slope (gradient, angle) of two lines, but simplified wrt signs
-- to work fast in this particular setup.
--
-- Debug: Verify that the results of 2 independent checks are equal.
steepness :: LineOrdering -> Bump -> Bump -> Bump -> Bool
{-# INLINE steepness #-}
steepness :: LineOrdering -> Bump -> Bump -> Bump -> Bool
steepness lineOrdering :: LineOrdering
lineOrdering (B xf :: Int
xf yf :: Int
yf) (B x1 :: Int
x1 y1 :: Int
y1) (B x2 :: Int
x2 y2 :: Int
y2) =
  let y2x1 :: Int
y2x1 = (Int
yf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y2) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
xf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x1)
      y1x2 :: Int
y1x2 = (Int
yf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
xf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x2)
      res :: Bool
res = case LineOrdering
lineOrdering of
        Steeper -> Int
y2x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
y1x2
        Shallower -> Int
y2x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y1x2
  in
#ifdef WITH_EXPENSIVE_ASSERTIONS
     Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool
res Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== LineOrdering -> Bump -> Bump -> Bump -> Bool
_debugSteeper LineOrdering
lineOrdering (Int -> Int -> Bump
B Int
xf Int
yf) (Int -> Int -> Bump
B Int
x1 Int
y1) (Int -> Int -> Bump
B Int
x2 Int
y2))
#endif
       Bool
res

{- |
A pair @(a, b)@ such that @a@ divided by @b@ is the X coordinate
of the intersection of a given line and the horizontal line at distance
@d@ above the X axis.

Derivation of the formula:
The intersection point @(xt, yt)@ satisfies the following equalities:

> yt = d
> (yt - y) (xf - x) = (xt - x) (yf - y)

hence

> (yt - y) (xf - x) = (xt - x) (yf - y)
> (d - y) (xf - x) = (xt - x) (yf - y)
> (d - y) (xf - x) + x (yf - y) = xt (yf - y)
> xt = ((d - y) (xf - x) + x (yf - y)) / (yf - y)

General remarks:
The FOV agrees with physical properties of tiles as diamonds
and visibility from any point to any point. A diamond is denoted
by the left corner of it's encompassing tile. Hero is at (0, 0).
Order of processing in the first quadrant rotated by 45 degrees is

> 45678
>  123
>   @

so the first processed diamond is at (-1, 1). The order is similar
as for the restrictive shadow casting algorithm and reversed wrt PFOV.
The fast moving line when scanning is called the shallow line,
and it's the one that delimits the view from the left, while the steep
line is on the right, opposite to PFOV. We start scanning from the left.

The 'PointI' ('Enum' representation of @Point@) coordinates are cartesian.
The 'Bump' coordinates are cartesian, translated so that
the hero is at (0, 0) and rotated so that he always
looks at the first (rotated 45 degrees) quadrant. The ('Progress', 'Distance')
cordinates coincide with the @Bump@ coordinates, unlike in PFOV.

Debug: check that the line fits in the upper half-plane.
-}
intersect :: Line -> Distance -> (Int, Int)
{-# INLINE intersect #-}
intersect :: Line -> Int -> (Int, Int)
intersect (Line (B x :: Int
x y :: Int
y) (B xf :: Int
xf yf :: Int
yf)) d :: Int
d =
#ifdef WITH_EXPENSIVE_ASSERTIONS
  Bool -> (Int, Int) -> (Int, Int)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ((Int -> Bool) -> [Int] -> Bool
forall a. Show a => (a -> Bool) -> [a] -> Bool
allB (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0) [Int
y, Int
yf])
#endif
    ((Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y)Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
xf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
yf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y), Int
yf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y)

-- | Debug functions for DFOV:

-- | Debug: calculate steepness for DFOV in another way and compare results.
_debugSteeper :: LineOrdering -> Bump -> Bump -> Bump -> Bool
{-# INLINE _debugSteeper #-}
_debugSteeper :: LineOrdering -> Bump -> Bump -> Bump -> Bool
_debugSteeper lineOrdering :: LineOrdering
lineOrdering f :: Bump
f@(B _xf :: Int
_xf yf :: Int
yf) p1 :: Bump
p1@(B _x1 :: Int
_x1 y1 :: Int
y1) p2 :: Bump
p2@(B _x2 :: Int
_x2 y2 :: Int
y2) =
  Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ((Int -> Bool) -> [Int] -> Bool
forall a. Show a => (a -> Bool) -> [a] -> Bool
allB (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0) [Int
yf, Int
y1, Int
y2]) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
  let (n1 :: Int
n1, k1 :: Int
k1) = Line -> Int -> (Int, Int)
intersect (Bump -> Bump -> Line
Line Bump
p1 Bump
f) 0
      (n2 :: Int
n2, k2 :: Int
k2) = Line -> Int -> (Int, Int)
intersect (Bump -> Bump -> Line
Line Bump
p2 Bump
f) 0
      sign :: Ordering
sign = case LineOrdering
lineOrdering of
        Steeper -> Ordering
GT
        Shallower -> Ordering
LT
  in Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int
k1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n2) (Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k2) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
sign

-- | Debug: check if a view border line for DFOV is legal.
_debugLine :: Line -> (Bool, String)
{-# INLINE _debugLine #-}
_debugLine :: Line -> (Bool, String)
_debugLine line :: Line
line@(Line (B x1 :: Int
x1 y1 :: Int
y1) (B x2 :: Int
x2 y2 :: Int
y2))
  | Bool -> Bool
not ((Int -> Bool) -> [Int] -> Bool
forall a. Show a => (a -> Bool) -> [a] -> Bool
allB (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0) [Int
y1, Int
y2]) =
      (Bool
False, "negative Y coordinates: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Line -> String
forall a. Show a => a -> String
show Line
line)
  | Int
y1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y2 Bool -> Bool -> Bool
&& Int
x1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x2 =
      (Bool
False, "ill-defined line: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Line -> String
forall a. Show a => a -> String
show Line
line)
  | Int
y1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y2 =
      (Bool
False, "horizontal line: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Line -> String
forall a. Show a => a -> String
show Line
line)
  | Bool
crossL0 =
      (Bool
False, "crosses the X axis below 0: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Line -> String
forall a. Show a => a -> String
show Line
line)
  | Bool
crossG1 =
      (Bool
False, "crosses the X axis above 1: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Line -> String
forall a. Show a => a -> String
show Line
line)
  | Bool
otherwise = (Bool
True, "")
 where
  (n :: Int
n, k :: Int
k)  = Line
line Line -> Int -> (Int, Int)
`intersect` 0
  (q :: Int
q, r :: Int
r)  = if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then (0, 0) else Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
k
  crossL0 :: Bool
crossL0 = Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0  -- q truncated toward negative infinity
  crossG1 :: Bool
crossG1 = Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1 Bool -> Bool -> Bool
&& (Int
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 Bool -> Bool -> Bool
|| Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0)