-- | 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 Int -> Bool isClear 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 > Int 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 Int 1 ( (Bump -> Bump -> Line Line (Int -> Int -> Bump B Int 1 Int 0) (Int -> Int -> Bump B (-Int r) Int r), Bump -> CHull -> ConvexHull ConvexHull (Int -> Int -> Bump B Int 0 Int 0) CHull CHNil) , (Bump -> Bump -> Line Line (Int -> Int -> Bump B Int 0 Int 0) (Int -> Int -> Bump B (Int rInt -> Int -> Int forall a. Num a => a -> a -> a +Int 1) Int r), Bump -> CHull -> ConvexHull ConvexHull (Int -> Int -> Bump B Int 1 Int 0) CHull CHNil) ) where dscan :: Distance -> EdgeInterval -> [PointI] {-# INLINE dscan #-} dscan :: Int -> EdgeInterval -> [Int] dscan !Int d ( (Line sl{-shallow line-}, ConvexHull sHull), (Line el{-steep line-}, 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 ConvexHull sHull !Line el ConvexHull eHull = -- @sHull@ and @eHull@ may be unused let !ps0 :: Int ps0 = let (Int n, 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 (Int n, 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 -Int 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 +Int 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 +Int 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 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 +Int 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 +Int 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 +Int 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 +Int 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 +Int 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 +Int 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 >= Int 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' 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 -- | 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 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 -- 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 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 -- | Create a line from two points. -- -- Debug: check if well-defined. 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 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 (B Int xf Int yf) (B Int x1 Int y1) (B Int x2 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 LineOrdering Steeper -> Int y2x1 Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int y1x2 LineOrdering 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 its 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 Int x Int y) (B Int xf Int yf)) 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 >= Int 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 f :: Bump f@(B Int _xf Int yf) p1 :: Bump p1@(B Int _x1 Int y1) p2 :: Bump p2@(B Int _x2 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 >= Int 0) [Int yf, Int y1, Int y2]) (Bool -> Bool) -> Bool -> Bool forall a b. (a -> b) -> a -> b $ let (Int n1, Int k1) = Line -> Int -> (Int, Int) intersect (Bump -> Bump -> Line Line Bump p1 Bump f) Int 0 (Int n2, Int k2) = Line -> Int -> (Int, Int) intersect (Bump -> Bump -> Line Line Bump p2 Bump f) Int 0 sign :: Ordering sign = case LineOrdering lineOrdering of LineOrdering Steeper -> Ordering GT LineOrdering 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 Int x1 Int y1) (B Int x2 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 >= Int 0) [Int y1, Int y2]) = (Bool False, String "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, String "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, String "horizontal line: " String -> ShowS forall a. [a] -> [a] -> [a] ++ Line -> String forall a. Show a => a -> String show Line line) | Bool crossL0 = (Bool False, String "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, String "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, String "") where (Int n, Int k) = Line line Line -> Int -> (Int, Int) `intersect` Int 0 (Int q, Int r) = if Int k Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int 0 then (Int 0, Int 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 < Int 0 -- q truncated toward negative infinity crossG1 :: Bool crossG1 = Int q Int -> Int -> Bool forall a. Ord a => a -> a -> Bool >= Int 1 Bool -> Bool -> Bool && (Int q Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int 1 Bool -> Bool -> Bool || Int r Int -> Int -> Bool forall a. Eq a => a -> a -> Bool /= Int 0)