{-# 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 ]
	
	_ -> []