Field of View
This Week's Music is a spookier track, since this week is all about not knowing what's out there.
This week we will add field of view to our game, including having the game remember where the player has explored or not, so when drawing we can distinguish between currently seen, previously seen, and never seen locations. (It later came to my attention that the reddit post also has beginning monsters this week, but it's cleaner to have all FOV this week and all monsters next week so that's how we're doing it).
The particular Field of View (FOV) flavor that we'll be using is Precise Permissive Field of View. Specifically, we'll be using the Python Version by Aaron MacDonald as our basis, because it's easier to read than the C++ version. I won't include the full thing here like I did with PCG code because there's a whole lot more of it. Just check out the wiki page on roguebasin if you want every little detail.
Note that there are lots of types of FOV, and no clear winner in every category you're likely to care about. The basic trade off is that more accuracy gives less speed. That's kinda how it always goes in computing. Precise Permissive FOV is a slightly earlier version of the "PERMISSIVE" style that the comparison page talks about where the permissive level is always set to 8 instead of being adjustable.
PPFOV: The Theory
Again, the page that fully explains in detail how the technique works is here, but here's the basic idea:
- This is a quadrant based technique. We only write how to perform one quadrant worth of checking, and then we perform mirroring to make it work in the other three quadrants.
- This only uses integral math. As a result, we won't have any possibility of view errors coming from floating point rounding trouble.
- We start with one "view", which is an arc across the entire quadrant. We sweep out from the center of the FOV testing squares one at a time.
- When a square blocks vision, we have to update our current list of views based on how it blocks the view. A blocking tile might make a view narrower, split it into two views, or block a view entirely (which kills the view).
- When we're out of live views, or we reach the edge of the range we were given, we stop.
PPFOV: The Python
We're not going to have every bit of the python code here, but let's start by looking at the top level signatures the python code has.
def fieldOfView(startX, startY, mapWidth, mapHeight, radius, \
funcVisitTile, funcTileBlocked):
class __Line(object):
class __ViewBump:
class __View:
def __checkQuadrant(visited, startX, startY, dx, dy, \
extentX, extentY, funcVisitTile, funcTileBlocked):
def __visitCoord(visited, startX, startY, x, y, dx, dy, viewIndex, \
activeViews, funcVisitTile, funcTileBlocked):
def __addShallowBump(x, y, activeViews, viewIndex):
def __addSteepBump(x, y, activeViews, viewIndex):
def __checkView(activeViews, viewIndex):
So, it looks like in python you pass a function of what to do at each location. Well, we don't want to do arbitrary mutations, so we'll just return the set of locations found and let the caller decide what to do. So we'll accept a starting point, and a map edge (I guess we assume that the map has 0 as the lower bounds), a radius, and then a function to determine if a tile is blocked at a location.
PPFOV: The Haskell
(Note: As with the PCG stuff, I'm cheating a little bit here and using an old version of PPFOV that I converted from Python to Haskell a year ago to help me though some of the mental jumps here).
Well, assuming that tiles run from 0 through some max seems lame to me when we're already accepting a func that says if a tile blocks or not. We'll just force that function to accept any possible location at all, and then that simplifies how you call the FOV quite a bit. Let's try some signatures out.
module PPFOV (ppfov, VisionBlocked) where
type VisionBlocked = (Int,Int) -> Bool
fov :: (Int,Int) -> Int -> VisionBlocked -> Set (Int,Int)
data SightLine = SightLine Int Int Int Int
deriving (Eq, Show)
data ViewBump = ViewBump Int Int (Maybe ViewBump)
deriving (Eq, Show)
data View = View SightLine SightLine (Maybe ViewBump) (Maybe ViewBump)
deriving (Eq, Show)
checkQuadrant :: Set (Int,Int) -> (Int,Int) -> (Int,Int) -> (Int,Int) -> VisionBlocked -> Set (Int,Int) -> Set (Int,Int)
addShallowBump :: (Int,Int) -> Int -> [View] -> [View]
addSteepBump :: (Int,Int) -> Int -> [View] -> [View]
checkView :: Int -> [View] -> [View]
Oof! Three (Int,Int) in a row? That's not the best, you could mix up the ordering on those tuples very easily. The results would be obviously not what we want, but we wouldn't necessarily have any clear reason why. It'd be much better to use some alternate types like passing around a Quadrant value or something, so that it's not a big list of identically typed values you're passing in, and if you get the order wrong you get a compile error instead of silent breakage. However, since it's private to our own module, we can probably stomach the situation. If it was a function that we exposed to the world we'd be at a much bigger obligation to make it an easier to use signature.
Well, something that I skipped over is that we've got a bunch of sub-functions for the SightLine type that we have to write out too. They've got some slightly confusing names, so instead of saying pBelow for pointBelow, we'll say belowPoint. Then if we use it infix it reads like an actual sentence
relativeSlope :: SightLine -> (Int,Int) -> Int
relativeSlope (SightLine xi yi xf yf) (x,y) = let
dx = xf - xi
dy = yf - yi
in (dy * (xf - x)) - (dx * (yf - y))
collinearLine :: SightLine -> SightLine -> Bool
collinearLine self (SightLine xi yi xf yf) =
collinearPoint self (xi,yi) && collinearPoint self (xf,yf)
collinearPoint :: SightLine -> (Int,Int) -> Bool
collinearPoint self p = relativeSlope self p == 0
aboveOrCollinearPoint :: SightLine -> (Int,Int) -> Bool
aboveOrCollinearPoint self p = relativeSlope self p <= 0
abovePoint :: SightLine -> (Int,Int) -> Bool
abovePoint self p = relativeSlope self p < 0
belowOrCollinearPoint :: SightLine -> (Int,Int) -> Bool
belowOrCollinearPoint self p = relativeSlope self p >= 0
belowPoint :: SightLine -> (Int,Int) -> Bool
belowPoint self p = relativeSlope self p > 0
And a ghci check of course,
RL-tut> s = SightLine 0 0 1 1
RL-tut> s `belowPoint` (0,70)
True
RL-tut> s `collinearLine` (SightLine 5 5 6 6)
True
RL-tut> s `aboveOrCollinearPoint` (4,4)
True
RL-tut> s `aboveOrCollinearPoint` (4,3)
True
RL-tut> s `aboveOrCollinearPoint` (4,5)
False
Seems good. We'll keep building up from the smallest stuff to the bigger stuff, going good so far.
-- | Deletes the View at the index specified from the list if the two lines of
-- the View are collinear and the lines pass through either extremity of the FOV
-- origin, (0,1) or (1,0).
--
-- checkView 0 [View (SightLine 0 0 1 1) (SightLine 2 2 3 3) Nothing Nothing] == id
--
-- checkView 0 [View (SightLine 0 1 1 2) (SightLine 2 3 3 4) Nothing Nothing] == []
checkView :: Int -> [View] -> [View]
checkView index views = let
theView = views !! index
(View shallowLine _ _ _) = theView
(View _ steepLine _ _) = theView
delete i list = take i list ++ drop (i+1) list
in if (shallowLine `collinearLine` steepLine) &&
(shallowLine `collinearPoint` (0,1) || shallowLine `collinearPoint` (1,0))
then delete index views
else views
Not... looking... so good. Seems like View should use record syntax. Let's persist just a little more, this might be just a weird situation.
addSteepBump :: (Int,Int) -> Int -> [View] -> [View]
addSteepBump (x,y) index views = let
theView = views !! index
(View shallowLineO steepLineO maybeShallowBumpO maybeSteepBumpO) = theView
(SightLine xiShO yiShO xfShO yfShO) = shallowLine
newSteepXF = x
newSteepYF = y
newSteepBump = ViewBump x y maybeSteepBumpO
steepBelow bump xc yc = case bump of
Just (ViewBump cbx cby nextBump) -> if .....???
Nothing -> (xc,yc)
(newSteepXI,newSteepYI) = steepBelow
in ...
That's seriously as far as I got trying to do the direct translation. This is not gonna work. You can't always just convert code into Haskell line by line, and this is a great example of when you can't. We need a better approach to things.
Take 2: Representation Matters
Let's start with a better View representation and a helper to make building View values easy while we're at ait. In this case, part of the problem is that the list of bumps going back is being a clumsy linked list, but Haskell already has a linked list you're supposed to use: the normal list type. That way we can use all our normal list functions that we know and love.
-- | A view within the FOV computation.
data View = View {
getShallowBumps :: [(Int,Int)],
getShallowLine :: SightLine,
getSteepBumps :: [(Int,Int)],
getSteepLine :: SightLine
} deriving (Eq, Show)
-- | Makes a new view using the shallow and steep line given, and no bumps.
mkView :: SightLine -> SightLine -> View
mkView shallowLine steepLine = View {
getShallowBumps=[],
getShallowLine=shallowLine,
getSteepBumps=[],
getSteepLine=steepLine}
Great, so what's checkView look like now?
checkView :: Int -> [View] -> [View]
checkView viewIndex activeViews = let
shallowIsSteep = theShallowLine `collinearLine` theSteepLine
lineOnExtremity = (theShallowLine `collinearPoint` (0,1) || theShallowLine `collinearPoint` (1,0))
theView = activeViews !! viewIndex
theShallowLine = shallowLine theView
theSteepLine = steepLine theView
delete i list = take i list ++ drop (i+1) list
in if shallowIsSteep && lineOnExtremity
then delete viewIndex activeViews
else activeViews
Do our previous checks still work? Allowing for a difference in how you declare View values,
RL-tut> checkView 0 [mkView (SightLine 0 0 1 1) (SightLine 2 2 3 3)]
[View {getShallowBumps = [], getShallowLine = SightLine 0 0 1 1, getSteepBumps = [], getSteepLine = SightLine 2 2 3 3}]
RL-tut> checkView 0 [mkView (SightLine 0 1 1 2) (SightLine 2 3 3 4)]
[]
Folding
Now let's try to add a steep bump just to a View. We can adjust a [View] into a new [View] once we'd hammered out how to change just one view. Careful readers will note that to add a steep bump we just need to replace the steep bump and steep line values. We read from the shallow bump as part of the loop, but we don't change it.
Adding the new steep bump into the front of the list of steep bumps is super easy. To add an item to the front of the list we use the (:) constructor (called "cons", thanks to Haskell's ancient alliance with the Lisp clan). I know that (:) looks like an operator, but symbol operators that start with a : character, including just (:) on its own, are constructors. It's a little arbitrary, but since there's no way to write something like + "in uppercase" you need some other way to distinguish symbol functions from symbol constructors, so that's how you do it.
addSteepBump :: (Int,Int) -> View -> View
addSteepBump loc view = let
newSteepBumps = loc : (steepBumps view)
newSteepLine =
Now comes the hard part. We have to think about what the loop here is trying to accomplish. This is a kind of thing that Haskell calls a "fold". A fold is when you take a collection of values and a binary operator, and you collapse the collection down into an accumulation value one at a time using the binary operator, and you get just one value at the end. There are left folds and right folds and the fold can be strict or not, but they all take a complex structure and combine it down into one value. A catamorphism it's called. The super common folds are things that you've already heard of:
sumcollapses a group of numbers using the(+)operator.productis the same but with(*).anycombinesBoolvalues using(||)allis the same but for(&&)maxandmin"combine" a group of numbers using(>)and(<), which is close to what we'll be doing with theSightLinehere.
As I said there are many flavors of folding, and learning all of them and how they're slightly different is an interesting way to spend 20 minutes. Sometimes the fold you want is already in a library, and sometimes you have to build one yourself using one of the base fold operations, foldr, foldl, and foldl'. In our case, this is a kinda weird loop and we'll be building our own fold operation and running it with one of the base folding functions. Which one? We'll pick foldl': it gives you the effect of doing a loop over a finite list and evaluating the accumulator at each step. The ' bit is because it's strict (usually in Haskell the version of a function with a ' at the end is more strict than the version without). The Haskell Wiki has a page about folds if you want to read more about the basic fold patterns. So, how do we use foldl'?
foldl' :: Foldable t => (b -> a -> b) -> b -> t a -> b
Lists are Foldable, so we're gonna be fine there. We need some sort of folding operation, a starting value, a list of inputs, and we get a value back at the end. Our base value is a SightLine with the new bump's x and y in the "final" position and the current steep line's initial values as our own "initial" values. Our list to fold over when adding a shallow bump is the steepBumps list. Have a look and hopefully it will make sense:
addSteepBump :: (Int,Int) -> View -> View
addSteepBump loc@(x,y) view = let
(SightLine xi yi xf yf) = steepLine view
newSteepBumps = loc : (steepBumps view)
newSteepLine = foldl' (\line@(SightLine _ _ xfL yfL) p@(x,y) -> if line `belowPoint` p
then (SightLine x y xfL yfL)
else line
) (SightLine xi yi x y) (shallowBumps view)
in view { steepBumps = newSteepBumps, steepLine = newSteepLine }
Well, that doesn't seem clear at all. Let's write it more clearly.
-- | Computes the next line when adding a shallow or steep bump. If the
-- predicate passes then you get a line with its final coordinates replaced with
-- the point given. Otherwise you get the same SightLine back.
foldLineUsing :: (SightLine -> (Int,Int) -> Bool) -> SightLine -> (Int,Int) -> SightLine
foldLineUsing pred line@(SightLine _ _ xf yf) loc@(x,y) = if line `pred` loc
then SightLine x y xf yf
else line
-- | Adds a steep bump to a View, updating its steep line as necessary.
addSteepBump :: (Int,Int) -> View -> View
addSteepBump loc@(x,y) view = let
(SightLine xi yi _ _) = steepLine view
newSteepBumps = loc : (steepBumps view)
newSteepLine = foldl' (foldLineUsing belowPoint) (SightLine xi yi x y) (shallowBumps view)
in view { steepBumps = newSteepBumps, steepLine = newSteepLine }
That feels a lot better. We're folding along the shallowBumps by determining the next line depending on if the line is below the point or not. If so, we update the initial coordinates of the line. Hey, look! That's what the Python code did. We're on the right track. Adding a shallow bump is nearly identical.
-- | Adds a shallow bump to a View, updating its shallow line as necessary.
addShallowBump :: (Int,Int) -> View -> View
addShallowBump loc@(x,y) view = let
(SightLine xi yi _ _) = shallowLine view
newShallowBumps = loc : (shallowBumps view)
newShallowLine = foldl' (foldLineUsing abovePoint) (SightLine xi yi x y) (steepBumps view)
in view { shallowBumps = newShallowBumps, shallowLine = nhallowLine }
Pretty much the exact inverse as before. Seems good to go.
Visiting a Coordinate
Since we started at the bottom of the list and we're working our way up the list this bring us to the all important visitCoord function.
This will be ugly.
You have been warned.
-- | Adds a single Location to the set of visited locations if it's within
-- one of the views, and updates any views as necessary.
visitCoord :: (Int,Int) -> (Int,Int) -> (Int,Int) -> [View] -> VisionBlocked -> Set (Int,Int) -> (Set (Int,Int), [View])
visitCoord (sx,sy) (dx,dy) (qx,qy) activeViews vision visited =
let topLeft = (dx,dy+1)
bottomRight = (dx+1,dy)
realX = dx * qx
realY = dy * qy
trueLocation = (sx + realX, sy + realY)
viewIndex = calcViewIndex activeViews bottomRight
in if viewIndex == (length activeViews) || (shallowLine (activeViews !! viewIndex)) `aboveOrCollinearPoint` topLeft
then (visited, activeViews) -- No compatible views. Return without altering visited or activeViews
else let newVisited = S.insert trueLocation visited
visionBlocked = vision trueLocation
in if visionBlocked
then let currentView = activeViews !! viewIndex -- Vision is blocked, calculate how it affects the view.
shallowAboveBottomRight = (shallowLine currentView) `abovePoint` bottomRight
steepBelowTopLeft = (steepLine currentView) `belowPoint` topLeft
in case (shallowAboveBottomRight, steepBelowTopLeft) of
(True, True) -> (newVisited, remove viewIndex activeViews)
(True, False) -> (newVisited, bumpAndCheck addShallowBump activeViews viewIndex topLeft)
(False, True) -> (newVisited, bumpAndCheck addSteepBump activeViews viewIndex bottomRight)
(False, False) -> let clonedViews = add viewIndex activeViews currentView in
let shallowChecked = bumpAndCheck addShallowBump clonedViews (viewIndex+1) topLeft in
let steepChecked = bumpAndCheck addSteepBump shallowChecked viewIndex bottomRight
in (newVisited, steepChecked)
else (newVisited,activeViews) -- Vision not blocked, we don't adjust any views.
calcViewIndex :: [View] -> (Int,Int) -> Int
calcViewIndex activeViews bottomRight = let
go tmp views bottomRight = if tmp < (length views) &&
(steepLine (views!!tmp)) `belowOrCollinearPoint` bottomRight
then go (tmp+1) views bottomRight
else tmp
in go 0 activeViews bottomRight
bumpAndCheck :: ((Int,Int) -> View -> View) -> [View] -> Int -> (Int,Int) -> [View]
bumpAndCheck bumpf activeViews viewIndex bump = out
where view = activeViews !! viewIndex
bumpedView = bumpf bump view
out = if validView bumpedView
then update viewIndex activeViews bumpedView
else remove viewIndex activeViews
validView :: View -> Bool
validView view = not (shallowIsSteep && lineOnExtremity)
where shallowIsSteep = shallowLine' `collinearLine` steepLine'
lineOnExtremity = (shallowLine' `collinearPoint` (0,1) || shallowLine' `collinearPoint` (1,0))
shallowLine' = shallowLine view
steepLine' = steepLine view
add :: (Integral a) => a -> [b] -> b -> [b]
add a (b:bs) new
| a < 0 = b : bs
| a == 0 = new : b : bs
| otherwise = b : add (a-1) bs new
add 0 [] new = [new]
add _ [] _ = []
update :: (Integral a) => a -> [b] -> b -> [b]
update a (b:bs) new
| a < 0 = b : bs
| a == 0 = new : bs
| otherwise = b : update (a-1) bs new
update _ [] _ = []
remove :: (Integral a) => a -> [b] -> [b]
remove a (b:bs)
| a < 0 = b : bs
| a == 0 = bs
| otherwise = b : remove (a-1) bs
remove _ [] = []
It's the worst, but I dare not change a thing until we can turn it on and see if it works each time we make a change. So, we must endure. In enduring, grow strong.
What happened here is that at each location we visit we have to do some conversions (to account for the mirroring across quadrants) and check what view the location is within (if any) and then if it is in a view we have to check if vision is blocked and update our view if so. The wiki page explains the logic behind it better than I can.
One final, ugly, sprint before we can fiddle with things.
-- | Performs view calculations on a single Quadrant relative to the start
-- position of the overall FOV computation.
checkQuadrant :: VisionBlocked -> Int -> (Int,Int) -> (Int,Int) -> Set (Int,Int)
checkQuadrant vision range (sx,sy) (qx,qy) = checkSub coordsToCheck (S.singleton (sx,sy)) startViewList
where shallowLineStart = SightLine 0 1 range 0
steepLineStart = SightLine 1 0 0 range
startViewList = [mkView shallowLineStart steepLineStart]
coordsToCheck = coordsFromRange range
{- During each subfunction pass, if there are no more active views we halt
and return the set of visited coordinates so far. Otherwise we use visitCoord
to compute the next pass, giving us a new set of visited coordinates and
a new list of active views. -}
checkSub :: [(Int,Int)] -> Set (Int,Int) -> [View] -> Set (Int,Int)
checkSub _ visited [] = visited
checkSub [] visited _ = visited
checkSub ((dx,dy):cs) visited activeViews = checkSub cs newVisited newActiveViews
where (newVisited,newActiveViews) = visitCoord (sx,sy) (dx,dy) (qx,qy) activeViews vision visited
-- | Turns a range for the vision into a list of the locations, relative
-- to the start position, that should be checked per quadrant.
coordsFromRange :: Int -> [(Int,Int)]
coordsFromRange range = do
let maxIndex = (2*range) + 1
i <- [1..(maxIndex-1)]
let startJ = max (i-range) 0
let maxJ = (min i range) + 1
j <- [startJ..(maxJ-1)]
pure (i-j,j)
-- | Maps the function given over the list given, and return a set
-- that is the union of all the result sets.
unionMap :: (Ord b) => (a -> Set b) -> [a] -> Set b
unionMap f list = S.unions $ map f list
fov :: VisionBlocked -> Int -> (Int,Int) -> Set (Int,Int)
fov vision range start = unionMap (checkQuadrant vision range start)
[(1,1),((-1),1),(1,(-1)),((-1),(-1))]
So for each quadrant, we sweep outward checking locations and updating views and so forth, and then at the end we dump it all into a single Set (Int,Int) and hand it back to the caller.
Finally we can update Main.hs a bit and see if it gives good results. commit
Cleaning Up A Bit Of The Tire Fire
First of all we can make calcViewIndex better by making it drop items from the list as it goes and stop passing the same arg over and over each cycle of the loop. Incidentally it'll be ever so slightly faster because the lookup each loop doesn't have to iterate over the past views that we already skipped. That's pretty minor though since the number of views is usually never more than a handful anyway.
-- | This is a freakish version of 'dropWhile' that keeps track of how many times
-- it dropped an item from the list and gives that as the final value.
calcViewIndex :: [View] -> (Int,Int) -> Int
calcViewIndex activeViews bottomRight = let
go tmp [] = tmp
go tmp (v:vs) = if (steepLine v) `belowOrCollinearPoint` bottomRight
then go (tmp+1) vs
else tmp
in go 0 activeViews
We can make bumpAndCheck a little more ideomatic
-- | Applies a bump operation, checks, and returns the new view list as a single operation.
bumpAndCheck :: ((Int,Int) -> View -> View) -> [View] -> Int -> (Int,Int) -> [View]
bumpAndCheck bumpf activeViews viewIndex bump = let
view = activeViews !! viewIndex
bumpedView = bumpf bump view
in take viewIndex activeViews ++ if validView bumpedView
then bumpedView : drop (viewIndex+1) activeViews
else drop (viewIndex+1) activeViews
This lets us cut one use of remove, and also our one use of update. We're still using delete within checkView and also remove within visitCoord. We don't actaully use checkView anywhere, so we'll cut that. Then we can define remove as just an inner fuction of visitCoord. We can redefine it in terms of take and drop so that it's somewhat easier to see the intent of what's going on.
remove i list = take i list ++ drop (i+1) list
There's other minor cleanups we can do, like converting some of my old where based code to use let instead just so that the style matches. Nothing huge.
More?
Our FOV code runs and returns correct results.
It probably doesn't run as fast as possible. However, without writing some benchmarking code that's impossible to say. Benchmarks are beyond the scope of this week's lesson though. All I can say at the moment is that if you hold a direction the character runs down a hall seemingly as fast as the keyboard generates KeyState'Repeating events. So that's good enough.
When speed becomes a real problem, we'll go over it. If never turns out to be a problem I'll still go over it as a bonus lesson once the main content of this series is done.