{-# LANGUAGE PatternGuards, RankNTypes #-}-- | Various ray casting algorithms.moduleGraphics.Gloss.Algorithms.RayCast(castSegIntoCellularQuadTree,traceSegIntoCellularQuadTree)whereimportGraphics.Gloss.Data.PictureimportGraphics.Gloss.Data.QuadimportGraphics.Gloss.Data.ExtentimportGraphics.Gloss.Data.QuadTreeimportData.ListimportData.Function-- | The quadtree contains cells of unit extent (NetHack style).-- Given a line segement (P1-P2) through the tree, get the cell -- closest to P1 that intersects the segment, if any.-- -- TODO: This currently uses a naive algorithm. It just calls -- `traceSegIntoCellularQuadTree` and sorts the results-- to get the one closest to P1. It'd be better to do a -- proper walk over the tree in the direction of the ray.-- castSegIntoCellularQuadTree::foralla.Point-- ^ (P1) Starting point of seg.->Point-- ^ (P2) Final point of seg.->Extent-- ^ Extent convering the whole tree.->QuadTreea-- ^ The tree.->Maybe(Point,Extent,a)-- ^ Intersection point, extent of cell, value of cell (if any).castSegIntoCellularQuadTreep1p2extenttree|cells@(_:_)<-traceSegIntoCellularQuadTreep1p2extenttree,c:_<-sortBy((compareDistanceTop1)`on`(\(a,_,_)->a))cells=Justc|otherwise=NothingcompareDistanceTo::Point->Point->Point->OrderingcompareDistanceTop0p1p2=letd1=distancep0p1d2=distancep0p2incompared1d2distance::Point->Point->Floatdistance(x1,y1)(x2,y2)=letxd=x2-x1yd=y2-y1insqrt(xd*xd+yd*yd)-- | The quadtree contains cells of unit extent (NetHack style).-- Given a line segment (P1-P2) through the tree, return the list of cells -- that intersect the segment.-- traceSegIntoCellularQuadTree::foralla.Point-- ^ (P1) Starting point of seg.->Point-- ^ (P2) Final point of seg.->Extent-- ^ Extent covering the whole tree.->QuadTreea-- ^ The tree.->[(Point,Extent,a)]-- ^ Intersection point, extent of cell, value of cell.traceSegIntoCellularQuadTreep1p2extenttree=casetreeofTNil->[]TLeafa->caseintersectSegExtentp1p2extentofJustpos->[(pos,extent,a)]Nothing->[]TNodenwneswse|touchesSegExtentp1p2extent->concat[traceSegIntoCellularQuadTreep1p2(cutQuadOfExtentNWextent)nw,traceSegIntoCellularQuadTreep1p2(cutQuadOfExtentNEextent)ne,traceSegIntoCellularQuadTreep1p2(cutQuadOfExtentSWextent)sw,traceSegIntoCellularQuadTreep1p2(cutQuadOfExtentSEextent)se]_->[]