```{-# LANGUAGE PatternGuards, RankNTypes #-}

-- | Various ray casting algorithms.
module Graphics.Gloss.Algorithms.RayCast
( castSegIntoCellularQuadTree
, traceSegIntoCellularQuadTree)
where
import Graphics.Gloss.Data.Picture
import Graphics.Gloss.Data.Quad
import Graphics.Gloss.Data.Extent
import Graphics.Gloss.Data.QuadTree
import Data.List
import Data.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
:: forall a
.  Point 			-- ^ (P1) Starting point of seg.
-> Point 			-- ^ (P2) Final point of seg.
-> Extent 			-- ^ Extent convering the whole tree.
-> QuadTree a 			-- ^ The tree.
-> Maybe (Point, Extent, a)	-- ^ Intersection point, extent of cell, value of cell (if any).

castSegIntoCellularQuadTree p1 p2 extent tree
| cells@(_:_)	<- traceSegIntoCellularQuadTree p1 p2 extent tree
, c : _		<- sortBy ((compareDistanceTo p1) `on` (\(a, _, _) -> a) ) cells
= Just c

| otherwise
= Nothing

compareDistanceTo :: Point -> Point -> Point -> Ordering
compareDistanceTo p0 p1 p2
= let	d1	= distance p0 p1
d2	= distance p0 p2
in	compare d1 d2

distance :: Point -> Point -> Float
distance (x1, y1) (x2, y2)
= let	xd	= x2 - x1
yd	= y2 - y1
in	sqrt (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
:: forall a
.  Point 			-- ^ (P1) Starting point of seg.
-> Point 			-- ^ (P2) Final point of seg.
-> Extent 			-- ^ Extent covering the whole tree.
-> QuadTree a 			-- ^ The tree.
-> [(Point, Extent, a)]		-- ^ Intersection point, extent of cell, value of cell.

traceSegIntoCellularQuadTree p1 p2 extent tree
= case tree of
TNil	-> []
TLeaf a
-> case intersectSegExtent p1 p2 extent of
Just pos	-> [(pos, extent, a)]
Nothing		-> []

TNode nw ne sw se
| touchesSegExtent p1 p2 extent
-> concat
[ traceSegIntoCellularQuadTree p1 p2 (cutQuadOfExtent NW extent) nw
, traceSegIntoCellularQuadTree p1 p2 (cutQuadOfExtent NE extent) ne
, traceSegIntoCellularQuadTree p1 p2 (cutQuadOfExtent SW extent) sw
, traceSegIntoCellularQuadTree p1 p2 (cutQuadOfExtent SE extent) se ]

_ -> []
```