-- | Common definitions for the Field of View algorithms. -- See <https://github.com/kosmikus/LambdaHack/wiki/Fov-and-los> -- for some more context and references. module Game.LambdaHack.FOV.Common ( -- * Current scan parameters Distance, Progress -- * Scanning coordinate system , Bump(..) -- * Geometry in system @Bump@ , Line, ConvexHull, Edge, EdgeInterval -- * Assorted minor operations , maximal, steeper, addHull ) where import qualified Data.List as L import Game.LambdaHack.PointXY -- | 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. newtype Bump = B (X, Y) deriving (Show) -- | Straight line between points. type Line = (Bump, Bump) -- | Convex hull represented as a list of points. type ConvexHull = [Bump] -- | An edge (comprising of a line and a convex hull) -- of the area to be scanned. type Edge = (Line, ConvexHull) -- | The area left to be scanned, delimited by edges. type EdgeInterval = (Edge, Edge) -- | Maximal element of a non-empty list. Prefers elements from the rear, -- which is essential for PFOV, to avoid ill-defined lines. maximal :: (a -> a -> Bool) -> [a] -> a maximal gte = L.foldl1' (\ acc e -> if gte e acc then e else acc) -- | Check if the line from the second point to the first is more steep -- than the line from the third point to the first. This is related -- to the formal notion of gradient (or angle), but hacked wrt signs -- to work fast in this particular setup. Returns True for ill-defined lines. steeper :: Bump -> Bump -> Bump -> Bool steeper (B(xf, yf)) (B(x1, y1)) (B(x2, y2)) = (yf - y1)*(xf - x2) >= (yf - y2)*(xf - x1) -- | Extends a convex hull of bumps with a new bump. Nothing needs to be done -- if the new bump already lies within the hull. The first argument is -- typically `steeper`, optionally negated, applied to the second argument. addHull :: (Bump -> Bump -> Bool) -- ^ a comparison function -> Bump -- ^ a new bump to consider -> ConvexHull -- ^ a convex hull of bumps represented as a list -> ConvexHull addHull gte new = (new :) . go where go (a:b:cs) | gte a b = go (b:cs) go l = l