Related
I'm trying to make what I think is called an Ulam spiral using Haskell.
It needs to go outwards in a clockwise rotation:
6 - 7 - 8 - 9
| |
5 0 - 1 10
| | |
4 - 3 - 2 11
|
..15- 14- 13- 12
For each step I'm trying to create coordinates, the function would be given a number and return spiral coordinates to the length of input number eg:
mkSpiral 9
> [(0,0),(1,0),(1,-1),(0,-1),(-1,-1),(-1,0),(-1,1),(0,1),(1,1)]
(-1, 1) - (0, 1) - (1, 1)
|
(-1, 0) (0, 0) - (1, 0)
| |
(-1,-1) - (0,-1) - (1,-1)
I've seen Looping in a spiral solution, but this goes counter-clockwise and it's inputs need to the size of the matrix.
I also found this code which does what I need but it seems to go counterclock-wise, stepping up rather than stepping right then clockwise :(
type Spiral = Int
type Coordinate = (Int, Int)
-- number of squares on each side of the spiral
sideSquares :: Spiral -> Int
sideSquares sp = (sp * 2) - 1
-- the coordinates for all squares in the given spiral
coordinatesForSpiral :: Spiral -> [Coordinate]
coordinatesForSpiral 1 = [(0, 0)]
coordinatesForSpiral sp = [(0, 0)] ++ right ++ top ++ left ++ bottom
where fixed = sp - 1
sides = sideSquares sp - 1
right = [(x, y) | x <- [fixed], y <- take sides [-1*(fixed-1)..]]
top = [(x, y) | x <- reverse (take sides [-1*fixed..]), y <- [fixed]]
left = [(x, y) | x <- [-1*fixed], y <- reverse(take sides [-1*fixed..])]
bottom = [(x, y) | x <- take sides [-1*fixed+1..], y <- [-1*fixed]]
-- an endless list of coordinates (the complete spiral)
mkSpiral :: Int -> [Coordinate]
mkSpiral x = take x endlessSpiral
endlessSpiral :: [Coordinate]
endlessSpiral = endlessSpiral' 1
endlessSpiral' start = coordinatesForSpiral start ++ endlessSpiral' (start + 1)
After much experimentation I can't seem to change the rotation or starting step direction, could someone point me in the right way or a solution that doesn't use list comprehension as I find them tricky to decode?
Let us first take a look at how the directions of a spiral are looking:
R D L L U U R R R D D D L L L L U U U U ....
We can split this in sequences like:
n times n+1 times
_^_ __^__
/ \ / \
R … R D … D L L … L U U … U
\_ _/ \__ __/
v v
n times n+1 times
We can repeat that, each time incrementing n by two, like:
data Dir = R | D | L | U
spiralSeq :: Int -> [Dir]
spiralSeq n = rn R ++ rn D ++ rn1 L ++ rn1 U
where rn = replicate n
rn1 = replicate (n + 1)
spiral :: [Dir]
spiral = concatMap spiralSeq [1, 3..]
Now we can use Dir here to calculate the next coordinate, like:
move :: (Int, Int) -> Dir -> (Int, Int)
move (x, y) = go
where go R = (x+1, y)
go D = (x, y-1)
go L = (x-1, y)
go U = (x, y+1)
We can use scanl :: (a -> b -> a) -> a -> [b] -> [a] to generate the points, like:
spiralPos :: [(Int, Int)]
spiralPos = scanl move (0,0) spiral
This will yield an infinite list of coordinates for the clockwise spiral. We can use take :: Int -> [a] -> [a] to take the first k items:
Prelude> take 9 spiralPos
[(0,0),(1,0),(1,-1),(0,-1),(-1,-1),(-1,0),(-1,1),(0,1),(1,1)]
The idea with the following solution is that instead of trying to generate the coordinates directly, we’ll look at the directions from one point to the next. If you do that, you’ll notice that starting from the first point, we go 1× right, 1× down, 2× left, 2× up, 3× right, 3× down, 4× left… These can then be seperated into the direction and the number of times repeated:
direction: > v < ^ > v < …
# reps: 1 1 2 2 3 3 4 …
And this actually gives us two really straightforward patterns! The directions just rotate > to v to < to ^ to >, while the # of reps goes up by 1 every 2 times. Once we’ve made two infinite lists with these patterns, they can be combined together to get an overall list of directions >v<<^^>>>vvv<<<<…, which can then be iterated over to get the coordinate values.
Now, I’ve always thought that just giving someone a bunch of code as the solution is not the best way to learn, so I would highly encourage you to try implementing the above idea yourself before looking at my solution below.
Welcome back (if you did try to implement it yourself). Now: onto my own solution. First I define a Stream data type for an infinite stream:
data Stream a = Stream a (Stream a) deriving (Show)
Strictly speaking, I don’t need streams for this; Haskell’s predefined lists are perfectly adequate for this task. But I happen to like streams, and they make some of the pattern matching a bit easier (because I don’t have to deal with the empty list).
Next, I define a type for directions, as well as a function specifying how they interact with points:
-- Note: I can’t use plain Left and Right
-- since they conflict with constructors
-- of the ‘Either’ data type
data Dir = LeftDir | RightDir | Up | Down deriving (Show)
type Point = (Int, Int)
move :: Dir -> Point -> Point
move LeftDir (x,y) = (x-1,y)
move RightDir (x,y) = (x+1, y)
move Up (x,y) = (x,y+1)
move Down (x,y) = (x,y-1)
Now I go on to the problem itself. I’ll define two streams — one for the directions, and one for the number of repetitions of each direction:
dirStream :: Stream Dir
dirStream = Stream RightDir $ Stream Down $ Stream LeftDir $ Stream Up dirVals
numRepsStream :: Stream Int
numRepsStream = go 1
where
go n = Stream n $ Stream n $ go (n+1)
At this point we’ll need a function for replicating each element of a stream a specific number of times:
replicateS :: Stream Int -> Stream a -> Stream a
replicateS (Stream n ns) (Stream a as) = conss (replicate n a) $ replicateS ns as
where
-- add more than one element to the beginning of a stream
conss :: [a] -> Stream a -> Stream a
conss [] s = s
conss (x:xs) s = Stream x $ appends xs s
This gives replicateS dirStream numRepsStream for the stream of directions. Now we just need a function to convert those directions to coordinates, and we’ve solved the problem:
integrate :: Stream Dir -> Stream Point
integrate = go (0,0)
where
go p (Stream d ds) = Stream p (go (move d p) ds)
spiral :: Stream Point
spiral = integrate $ replicateS numRepsStream dirStream
Unfortunately, it’s somewhat inconvenient to print an infinite stream, so the following function is useful for debugging and printing purposes:
takeS :: Int -> Stream a -> [a]
takeS 0 _ = []; takeS n (Stream x xs) = x : (takeS (n-1) xs)
When doing a ray trace with rayTraceP, I can find the point where a ray intersects with a diagram.
> rayTraceP (p2 (0, 0)) (r2 (1, 0)) ((p2 (1,-1) ~~ p2 (1,1))
Just (p2 (1.0, 0.0))
I want to use this to find not only the "collision point", but also the collision time and the normal vector to the surface at that point.
-- A Collision has a time, a contact point, and a normal vector.
-- The normal vector is perpendicular to the surface at the contact
-- point.
data Collision v n = Collision n (Point v n) (v n)
deriving (Show)
Given a start point for the ray and a velocity vector along the ray, I can find the contact point end using rayTraceP:
end <- rayTraceP start vel dia
And I can find the collision time using the distance between start and end:
time = distance start end / norm vel
But I'm stuck on finding the normal vector. I'm working within this function:
rayTraceC :: (Metric v, OrderedField n)
=> Point v n -> v n -> QDiagram B v n Any -> Maybe (Collision v n)
-- Takes a starting position for the ray, a velocity vector for the
-- ray, and a diagram to trace the ray to. If the ray intersects with
-- the diagram, it returns a Collision containing:
-- * The amount of time it takes for a point along the ray going at
-- the given velocity to intersect with the diagram.
-- * The point at which it intersects with the diagram.
-- * The normal vector to the surface at that point (which will be
-- perpendicular to the surface there).
-- If the ray does not intersect with the diagram, it returns Nothing.
rayTraceC start vel dia =
do
end <- rayTraceP start vel dia
let time = distance start end / norm vel
-- This is where I'm getting stuck.
-- How do I find the normal vector?
let normalV = ???
return (Collision time end normalV)
Some examples of what I want it to do:
> -- colliding straight on:
> rayTraceC (p2 (0, 0)) (r2 (1, 0)) (p2 (1,-1) ~~ p2 (1,1))
Just (Collision 1 (p2 (1, 0)) (r2 (-1, 0)))
> -- colliding from a diagonal:
> rayTraceC (p2 (0, 0)) (r2 (1, 1)) (p2 (1,0) ~~ p2 (1,2))
Just (Collision 1 (p2 (1, 1)) (r2 (-1, 0))
> -- colliding onto a diagonal:
> rayTraceC (p2 (0, 0)) (r2 (1, 0)) (p2 (0,-1) ~~ p2 (2,1))
Just (Collision 1 (p2 (1, 0)) (r2 (-√2/2, √2/2)))
> -- no collision
> rayTraceC (p2 (0, 0)) (r2 (1, 0)) (p2 (1,1) ~~ p2 (1,2))
Nothing
It is correct on everything in these examples except for the normal vector.
I have looked in the documentation for both Diagrams.Trace and Diagrams.Core.Trace, but maybe I'm looking in the wrong places.
There is no way to do this in general; it depends on what exactly you hit. There is a module Diagrams.Tangent for computing tangents of trails, but to compute the tangent at a given point you have to know its parameter with respect to the trail; and one thing we are missing at the moment is a way to convert from a given point to the parameter of the closest point on a given segment/trail/path (it's been on the to-do list for a while).
Dreaming even bigger, perhaps traces themselves ought to return something more informative---not just parameters telling you how far along the ray the hit are, but also information about what you hit (from which one could more easily do things like compute a normal vector).
What kinds of things are you computing traces of? There might be a way to take advantage of the particular details of your use case to get the normals you want in a not-too-terrible way.
Brent Yorgey's answer points out the Diagrams.Tangent module, and in particular normalAtParam, which works on Parameteric functions, including trails, but not all Diagrams.
Fortunately, many 2D diagram functions, like circle, square, rect, ~~, etc. can actually return any TrailLike type, including Trail V2 n. So a function with the type
rayTraceTrailC :: forall n . (RealFloat n, Epsilon n)
=>
Point V2 n
-> V2 n
-> Located (Trail V2 n)
-> Maybe (Collision V2 n)
Would actually work on the values returned by circle, square, rect, ~~, etc. if it could be defined:
> rayTraceTrailC
(p2 (0, 0))
(r2 (1, 0))
(circle 1 # moveTo (p2 (2,0)))
Just (Collision 1 (p2 (1, 0)) (r2 (-1, 0)))
And this function can be defined by breaking the trail up into a list of fixed segments which are either linear or bezier curves, using the fixTrail function. That reduces the problem to the simpler rayTraceFixedSegmentC.
rayTraceTrailC start vel trail =
combine (mapMaybe (rayTraceFixedSegmentC start vel) (fixTrail trail))
where
combine [] = Nothing
combine cs = Just (minimumBy (\(Collision a _ _) (Collision b _ _) -> compare a b) cs)
The rayTraceFixedSegmentC can use rayTraceP to calculate the contact point, but we can't find the normal vector right away because we don't know what the parameter is at that contact point. So punt further and add fixedSegmentNormalV helper function to the wish list:
rayTraceFixedSegmentC :: forall n . (RealFloat n, Epsilon n)
=>
Point V2 n
-> V2 n
-> FixedSegment V2 n
-> Maybe (Collision V2 n)
rayTraceFixedSegmentC start vel seg =
do
end <- rayTraceP start vel (unfixTrail [seg])
let time = distance start end / norm vel
let normalV = normalize (project (fixedSegmentNormalV seg end) (negated vel))
return (Collision time end normalV)
This fixedSegmentNormalV function just has to return a normal vector for a single segment going through a single point, without worrying about the vel direction. It can destruct the FixedSegment type, and if it's linear, that's easy:
fixedSegmentNormalV :: forall n . (OrderedField n)
=>
FixedSegment V2 n -> Point V2 n -> V2 n
fixedSegmentNormalV seg pt =
case seg of
FLinear a b -> perp (b .-. a)
FCubic a b c d ->
???
In the FCubic case, to calculate the parameter where the curve goes through pt, I'm not sure what to do, but if you don't mind approximations here we can just take a bunch of points along it and find the one closest to pt. After that we can call normalAtParam as Brent Yorgey suggested.
fixedSegmentNormalV seg pt =
case seg of
FLinear a b -> perp (b .-. a)
FCubic a b c d ->
-- APPROXIMATION: find the closest parameter value t
let ts = map ((/100) . fromIntegral) [0..100]
dist t = distance (seg `atParam` t) pt
t = minimumBy (\a b -> compare (dist a) (dist b)) ts
-- once we have that parameter value we can call a built-in function
in normalAtParam seg t
With this, the rayTraceTrailC function is working with this approximation. However, it doesn't work for Diagrams, only Located Trails.
It can work on the values returned by functions like circle and rect, but not on combined diagrams. So you have to keep those building blocks of diagrams separate, as trails, for as long as you need this collision ray tracing.
Using the normal vectors to reflect the rays (the outgoing ray has an equal angle from the normal vector) looks like this:
I want to take two different images (taken from image files, like .png) and draw one over the other several times in different positions. The resulting image should be presented on screen or generate a new image file, whichever is easier. I´ll be taking that new image and drawing on it more with further operations
Is there any Haskell library that allows me to do this?
You can use JuicyPixels to do that sort of thing:
module Triangles where
import Codec.Picture
import LineGraphics
{-| Parameterize color smoothly as a function of angle -}
colorWheel :: Float -> Colour
colorWheel x = (r, g, b, a)
where
r = floor $ (cos x + 1) * (255 / 2)
g = floor $ (sin x + 1) * (255 / 2)
b = floor $ (cos (x+(pi/2)) + 1) * (255 / 2)
a = 255
{-| Draw a triangle centered about the point (x, y) -}
triangle :: Point -> Path
triangle (x, y) =
[ (x - k, y - k)
, (x + k, y - k)
, (x, y + k)
, (x - k, y - k)
]
where
size = 30
k = size / 2
{-|
Draw 'n' equally-spaced triangles at a radius of 'r' about a center
point, '(x, y)'.
-}
triangles :: Float -> Radius -> Vector -> Picture
triangles n r (x, y) =
[ (colorWheel theta, tri theta) | theta <- steps n ]
where
tri theta = triangle ((r * cos theta) + x, (r * sin theta) + y)
{-| Interpolate the range [0, 2pi] by 'n' steps -}
steps :: Float -> [Float]
steps n = map (\i -> i * (2*pi/n)) [0 .. n]
And we'll use this module of supporting code:
module LineGraphics (
Point, Vector, Line, Path, Picture, Colour, Radius,
black,
drawPicture,
) where
import Graphics.Rasterific hiding (Point, Vector, Line, Path, polygon)
import Graphics.Rasterific.Texture
import Codec.Picture
type Radius = Float
type Point = (Float, Float)
type Vector = (Float, Float)
type Line = (Point, Point)
type Path = [Point]
type Picture = [(Colour, Path)]
type Colour = (Int, Int, Int, Int) -- red, green, blue, opacity
black = (0, 0, 0, 255)
drawPicture :: Float -> Picture -> Image PixelRGBA8
drawPicture linewidth picture =
renderDrawing 800 800 (toColour black) $
mapM_ renderFn picture
where
renderFn (col, path) = withTexture (uniformTexture $ toColour col) (drawPath path)
drawPath points = stroke linewidth JoinRound (CapRound, CapStraight 0) $
polyline (map (\(x, y) -> V2 x y) points)
toColour (a,b,c,d) = PixelRGBA8
(fromIntegral a) (fromIntegral b) (fromIntegral c) (fromIntegral d)
And here's what we get:
I have a rectangular matrix with cases containing B or N. An example of matrix:
g0 = [[B,B,B,B,B,B,N],
[B,B,N,B,N,B,B],
[N,B,N,N,N,N,N],
[B,B,B,N,N,B,N],
[N,N,N,B,B,B,B],
[B,B,B,N,N,B,N]]
I have a type rectangle like [Int,Int,Int,Int] and a function that gets a smaller rectangular matrix from my matrix with this type. Here's the function but that's not the most important part:
getRectangle :: Rectangle -> Grille -> Grille -- cette fonction récupère la grille qui correspond au rectangle donné
getRectangle (i,j,l,c) g = transpose (getLigne (j,c,(nbLigne (transpose g0))) (transpose (getLigne (i,l,(nbLigne g0)) g0)))
--transpose get create a matrix with (n,m) = (lines,columns) in a matrix (m,n) and nbLigne return the number of lines (or columns when used with transpose) of a matrix.
getLigne :: (Int,Int,Int) -> Grille -> Grille
getLigne (i,l,0) g = []
getLigne (1,l,1) g = [head g]
getLigne (i,l,indice) [] = []
getLigne (i,l,indice) g
| indice == (i+l) = getLigne (i,l,(indice-1)) (init g) ++ [last g]
| indice == i = [last g]
| i < indice && indice < (i+l) = getLigne (i,l,(indice-1)) (init g) ++ [last g]
| otherwise = getLigne (i,l,(indice-1)) (init g)
Here's an example:
*Main> affiche (getRectangle (1,2,2,3) g0)
[B,B,B,B]
[B,N,B,N]
[B,N,N,N]
So, I have a tuple with (i,j,l,c). Knowing that 1<=i<i+l<=n and 1<=j<j+c<=m with n the number of lines of the matrix and m the number of columns.
To be clear, with a tuple (i,j,l,c), my function create a rectangle, from my matrix, formed with these cases: (i,j), (i+l,j), (i,j+c) and (i+l,j+c).
Now that I can create a single rectangle, I need to create all the possibles rectangles in any matrix. I don't have any clue on how I can do this since I feel like there is so many rectangles in a single matrix and cover all the cases seems very hard and long to me.
Maybe that I wasn't clear on some points, feel free to ask.
Salut :),
For combinations, I often work with the list monad.
Note that using the do notation like this is equivalent to working with list comprehensions
From a position you can deduce all the rectangles that can originate from a given point:
allRectsOriginatingFrom :: Point -> Grille -> [Rectangle]
allRectsOriginatingFrom (x, y) g
-- Si le point est dans ta grille...
| (x >= 1 && x <= width g) && (y >= 1 && y <= height g) = do
w <- [0 .. width g - x]
h <- [0 .. height g - y]
return (x, y, w, h)
-- Sinon y'a pas de rectangle possible
| otherwise = []
From there, your just have to map the function over all the possible positions on your grid:
allPointsOf :: Grille -> [Point]
allPointsOf g = do
x <- [1 .. width g]
y <- [1 .. height g]
return (x, y)
allRectsOf :: Grille -> [Rectangle]
allRectsOf g = do
pos <- allPointsOf g
allRectsOriginatingFrom pos g
And finally, mapping it with your getLigne function will get you every rectangle in your grid.
PS: Try to create datatypes instead of type aliases, it's better in my opinion (e.g. create a datatype like data Rectangle = Rectangle Int Int Int Int instead of type Rectangle = (Int, Int, Int, Int)).
The output looks like this:
You should just see a flat, continuous red wall on one side, blue wall on another, green on another, yellow on another (see the definition of the map, testMapTiles, it's just a map with four walls). Yet there are these phantom wall faces of varying height, which are perpendicular to the real walls. Why?
Note that the white "gaps" aren't actually gaps: it's trying to draw a wall of height Infinity (distance 0). If you specifically account for it (this version of the code doesn't) and just cap it at screen height, then you just see a very high wall there.
The source code is below. It's plain Haskell, using Haste to compile to JavaScript and render to canvas. It is based on the C++ code from this tutorial, though note that I replaced mapX and mapY with tileX and tileY, and I don't have the ray prefix for pos and dir within the main loop. Any discrepancies from the C++ code are probably what's breaking everything, but I can't seem to find any after having pored over this code many times.
Any help?
import Data.Array.IArray
import Control.Arrow (first, second)
import Control.Monad (forM_)
import Haste
import Haste.Graphics.Canvas
data MapTile = Empty | RedWall | BlueWall | GreenWall | YellowWall deriving (Eq)
type TilemapArray = Array (Int, Int) MapTile
emptyTilemapArray :: (Int, Int) -> TilemapArray
emptyTilemapArray dim#(w, h) = listArray ((1, 1), dim) $ replicate (w * h) Empty
testMapTiles :: TilemapArray
testMapTiles =
let arr = emptyTilemapArray (16, 16)
myBounds#((xB, yB), (w, h)) = bounds arr
in listArray myBounds $ flip map (indices arr) (\(x, y) ->
if x == xB then RedWall
else if y == yB then BlueWall
else if x == w then GreenWall
else if y == h then YellowWall
else Empty)
type Vec2 a = (a, a)
type DblVec2 = Vec2 Double
type IntVec2 = Vec2 Int
add :: (Num a) => Vec2 a -> Vec2 a -> Vec2 a
add (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)
mul :: (Num a) => Vec2 a -> a -> Vec2 a
mul (x, y) factor = (x * factor, y * factor)
rot :: (Floating a) => Vec2 a -> a -> Vec2 a
rot (x, y) angle =
(x * (cos angle) - y * (sin angle), x * (sin angle) + y * (cos angle))
dbl :: Int -> Double
dbl = fromIntegral
-- fractional part of a float
-- `truncate` matches behaviour of C++'s int()
frac :: Double -> Double
frac d = d - dbl (truncate d)
-- get whole and fractional parts of a float
split :: Double -> (Int, Double)
split d = (truncate d, frac d)
-- stops 'Warning: Defaulting the following constraint(s) to type ‘Integer’'
square :: Double -> Double
square = (^ (2 :: Int))
-- raycasting algorithm based on code here:
-- http://lodev.org/cgtutor/raycasting.html#Untextured_Raycaster_
data HitSide = NorthSouth | EastWest deriving (Show)
-- direction, tile, distance
type HitInfo = (HitSide, IntVec2, Double)
-- pos: start position
-- dir: initial direction
-- plane: camera "plane" (a line, really, perpendicular to the direction)
traceRays :: TilemapArray -> Int -> DblVec2 -> DblVec2 -> DblVec2 -> [HitInfo]
traceRays arr numRays pos dir plane =
flip map [0..numRays] $ \x ->
let cameraX = 2 * ((dbl x) / (dbl numRays)) - 1
in traceRay arr pos $ dir `add` (plane `mul` cameraX)
traceRay :: TilemapArray -> DblVec2 -> DblVec2 -> HitInfo
traceRay arr pos#(posX, posY) dir#(dirX, dirY) =
-- map tile we're in (whole part of position)
-- position within map tile (fractional part of position)
let ((tileX, fracX), (tileY, fracY)) = (split posX, split posY)
tile = (tileX, tileY)
-- length of ray from one x or y-side to next x or y-side
deltaDistX = sqrt $ 1 + (square dirY / square dirX)
deltaDistY = sqrt $ 1 + (square dirX / square dirY)
deltaDist = (deltaDistX, deltaDistY)
-- direction of step
stepX = if dirX < 0 then -1 else 1
stepY = if dirY < 0 then -1 else 1
step = (stepX, stepY)
-- length of ray from current position to next x or y-side
sideDistX = deltaDistX * if dirX < 0 then fracX else 1 - fracX
sideDistY = deltaDistY * if dirY < 0 then fracY else 1 - fracY
sideDist = (sideDistX, sideDistY)
(hitSide, wallTile) = traceRayInner arr step deltaDist tile sideDist
in (hitSide, wallTile, calculateDistance hitSide pos dir wallTile step)
traceRayInner :: TilemapArray -> IntVec2 -> DblVec2 -> IntVec2 -> DblVec2 -> (HitSide, IntVec2)
traceRayInner arr step#(stepX, stepY) deltaDist#(deltaDistX, deltaDistY) tile sideDist#(sideDistX, sideDistY)
-- a wall has been hit, report hit direction and coördinates
| arr ! tile /= Empty = (hitSide, tile)
-- advance until a wall is hit
| otherwise = case hitSide of
EastWest ->
let newSideDist = first (deltaDistX+) sideDist
newTile = first (stepX+) tile
in
traceRayInner arr step deltaDist newTile newSideDist
NorthSouth ->
let newSideDist = second (deltaDistY+) sideDist
newTile = second (stepY+) tile
in
traceRayInner arr step deltaDist newTile newSideDist
where
hitSide = if sideDistX < sideDistY then EastWest else NorthSouth
-- calculate distance projected on camera direction
-- (an oblique distance would give a fisheye effect)
calculateDistance :: HitSide -> DblVec2 -> DblVec2 -> IntVec2 -> IntVec2 -> Double
calculateDistance EastWest (startX, _) (dirX, _) (tileX, _) (stepX, _) =
((dbl tileX) - startX + (1 - dbl stepX) / 2) / dirX
calculateDistance NorthSouth (_, startY) (_, dirY) (_, tileY) (_, stepY) =
((dbl tileY) - startY + (1 - dbl stepY) / 2) / dirY
-- calculate the height of the vertical line on-screen based on the distance
calculateHeight :: Double -> Double -> Double
calculateHeight screenHeight 0 = screenHeight
calculateHeight screenHeight perpWallDist = screenHeight / perpWallDist
width :: Double
height :: Double
(width, height) = (640, 480)
main :: IO ()
main = do
cvElem <- newElem "canvas" `with` [
attr "width" =: show width,
attr "height" =: show height
]
addChild cvElem documentBody
Just canvas <- getCanvas cvElem
let pos = (8, 8)
dir = (-1, 0)
plane = (0, 0.66)
renderGame canvas pos dir plane
renderGame :: Canvas -> DblVec2 -> DblVec2 -> DblVec2 -> IO ()
renderGame canvas pos dir plane = do
let rays = traceRays testMapTiles (floor width) pos dir plane
render canvas $ forM_ (zip [0..width - 1] rays) (\(x, (side, tile, dist)) ->
let lineHeight = calculateHeight height dist
wallColor = case testMapTiles ! tile of
RedWall -> RGB 255 0 0
BlueWall -> RGB 0 255 0
GreenWall -> RGB 0 0 255
YellowWall -> RGB 255 255 0
_ -> RGB 255 255 255
shadedWallColor = case side of
EastWest ->
let (RGB r g b) = wallColor
in RGB (r `div` 2) (g `div` 2) (b `div` 2)
NorthSouth -> wallColor
in color shadedWallColor $ do
translate (x, height / 2) $ stroke $ do
line (0, -lineHeight / 2) (0, lineHeight / 2))
-- 25fps
let fps = 25
timeout = (1000 `div` fps) :: Int
rots_per_min = 1
rots_per_sec = dbl rots_per_min / 60
rots_per_frame = rots_per_sec / dbl fps
tau = 2 * pi
increment = tau * rots_per_frame
setTimeout timeout $ do
renderGame canvas pos (rot dir $ -increment) (rot plane $ -increment)
HTML page:
<!doctype html>
<meta charset=utf-8>
<title>Raycaster</title>
<noscript>If you're seeing this message, either your browser doesn't support JavaScript, or it is disabled for some reason. This game requires JavaScript to play, so you'll need to make sure you're using a browser which supports it, and enable it, to play.</noscript>
<script src=raycast.js></script>
The "phantom faces" are occurring because an incorrect HitSide is being reported: you're saying the face was hit on a horizontal move (EastWest), but was actually hit on a vertical move (NorthSouth), or vice-versa.
Why is it reporting an incorrect value, then? if sideDistX < sideDistY then EastWest else NorthSouth seems pretty foolproof, right? And it is.
The problem isn't how we calculated that value. It's when we calculated that value. The distance calculation function needs to know the direction we moved in to get to the wall. However, what we've actually given is the direction we would move in if we were to keep going (that is, if that tile wasn't a wall, or we were to ignore it for some reason).
Look at the Haskell code:
traceRayInner arr step#(stepX, stepY) deltaDist#(deltaDistX, deltaDistY) tile sideDist#(sideDistX, sideDistY)
-- a wall has been hit, report hit direction and coördinates
| arr ! tile /= Empty = (hitSide, tile)
-- advance until a wall is hit
| otherwise = case hitSide of
EastWest ->
let newSideDist = first (deltaDistX+) sideDist
newTile = first (stepX+) tile
in
traceRayInner arr step deltaDist newTile newSideDist
NorthSouth ->
let newSideDist = second (deltaDistY+) sideDist
newTile = second (stepY+) tile
in
traceRayInner arr step deltaDist newTile newSideDist
where
hitSide = if sideDistX < sideDistY then EastWest else NorthSouth
Notice that we do things in this order:
calculate hitSide
check if a wall has been hit, and if so, report hitSide
move
Compare this to the original C++ code:
//perform DDA
while (hit == 0)
{
//jump to next map square, OR in x-direction, OR in y-direction
if (sideDistX < sideDistY)
{
sideDistX += deltaDistX;
mapX += stepX;
side = 0;
}
else
{
sideDistY += deltaDistY;
mapY += stepY;
side = 1;
}
//Check if ray has hit a wall
if (worldMap[mapX][mapY] > 0) hit = 1;
}
It does things in a different order:
check if a wall has been hit, and if so, report side (equivalent to hitSide)
move and calculate side
The C++ code only calculates side when it moves, and then it reports that value if it hits a wall. So, it reports the way it moved in order to hit the wall.
The Haskell code calculates side whether or not it moves: so it's correct for each move, but when it hits a wall, it reports the way it would have moved were it to keep going.
So, the Haskell code can be fixed by re-ordering it so that it checks for a hit after moving, and if so, reports the hitSide value from that move. This isn't pretty code, but it works:
traceRayInner arr step#(stepX, stepY) deltaDist#(deltaDistX, deltaDistY) tile sideDist#(sideDistX, sideDistY) =
let hitSide = if sideDistX < sideDistY then EastWest else NorthSouth
in case hitSide of
EastWest ->
let newSideDist = first (deltaDistX+) sideDist
newTile = first (stepX+) tile
in case arr ! newTile of
-- advance until a wall is hit
Empty -> traceRayInner arr step deltaDist newTile newSideDist
-- a wall has been hit, report hit direction and coördinates
_ -> (hitSide, newTile)
NorthSouth ->
let newSideDist = second (deltaDistY+) sideDist
newTile = second (stepY+) tile
in case arr ! newTile of
-- advance until a wall is hit
Empty -> traceRayInner arr step deltaDist newTile newSideDist
-- a wall has been hit, report hit direction and coördinates
_ -> (hitSide, newTile)
Problem solved!
Side note: I figured out what was wrong after carrying out the algorithm on paper. While in that particular case it just so happened the last two HitSide values matched, it became obvious that that they might not in every case. So, a big thanks to Madsy on Freenode's #algorithms for suggesting trying it out on paper. :)