{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RankNTypes #-}

-- | Various ray casting algorithms.
module Brillo.Algorithms.RayCast (
  castSegIntoCellularQuadTree,
  traceSegIntoCellularQuadTree,
)
where

import Brillo.Data.Extent
import Brillo.Data.Picture
import Brillo.Data.Quad
import Brillo.Data.QuadTree
import Data.Function
import Data.List


{-| 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 :: forall a.
Point -> Point -> Extent -> QuadTree a -> Maybe (Point, Extent, a)
castSegIntoCellularQuadTree Point
p1 Point
p2 Extent
extent QuadTree a
tree
  | cells :: [(Point, Extent, a)]
cells@((Point, Extent, a)
_ : [(Point, Extent, a)]
_) <- Point -> Point -> Extent -> QuadTree a -> [(Point, Extent, a)]
forall a.
Point -> Point -> Extent -> QuadTree a -> [(Point, Extent, a)]
traceSegIntoCellularQuadTree Point
p1 Point
p2 Extent
extent QuadTree a
tree
  , (Point, Extent, a)
c : [(Point, Extent, a)]
_ <- ((Point, Extent, a) -> (Point, Extent, a) -> Ordering)
-> [(Point, Extent, a)] -> [(Point, Extent, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Point -> Point -> Point -> Ordering
compareDistanceTo Point
p1) (Point -> Point -> Ordering)
-> ((Point, Extent, a) -> Point)
-> (Point, Extent, a)
-> (Point, Extent, a)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (\(Point
a, Extent
_, a
_) -> Point
a)) [(Point, Extent, a)]
cells =
      (Point, Extent, a) -> Maybe (Point, Extent, a)
forall a. a -> Maybe a
Just (Point, Extent, a)
c
  | Bool
otherwise =
      Maybe (Point, Extent, a)
forall a. Maybe a
Nothing


compareDistanceTo :: Point -> Point -> Point -> Ordering
compareDistanceTo :: Point -> Point -> Point -> Ordering
compareDistanceTo Point
p0 Point
p1 Point
p2 =
  let d1 :: Float
d1 = Point -> Point -> Float
distance Point
p0 Point
p1
      d2 :: Float
d2 = Point -> Point -> Float
distance Point
p0 Point
p2
  in  Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
d1 Float
d2


distance :: Point -> Point -> Float
distance :: Point -> Point -> Float
distance (Float
x1, Float
y1) (Float
x2, Float
y2) =
  let xd :: Float
xd = Float
x2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x1
      yd :: Float
yd = Float
y2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y1
  in  Float -> Float
forall a. Floating a => a -> a
sqrt (Float
xd Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
xd Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
yd Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
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 :: forall a.
Point -> Point -> Extent -> QuadTree a -> [(Point, Extent, a)]
traceSegIntoCellularQuadTree Point
p1 Point
p2 Extent
extent QuadTree a
tree =
  case QuadTree a
tree of
    QuadTree a
TNil -> []
    TLeaf a
a ->
      case Point -> Point -> Extent -> Maybe Point
intersectSegExtent Point
p1 Point
p2 Extent
extent of
        Just Point
pos -> [(Point
pos, Extent
extent, a
a)]
        Maybe Point
Nothing -> []
    TNode QuadTree a
nw QuadTree a
ne QuadTree a
sw QuadTree a
se
      | Point -> Point -> Extent -> Bool
touchesSegExtent Point
p1 Point
p2 Extent
extent ->
          [[(Point, Extent, a)]] -> [(Point, Extent, a)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ Point -> Point -> Extent -> QuadTree a -> [(Point, Extent, a)]
forall a.
Point -> Point -> Extent -> QuadTree a -> [(Point, Extent, a)]
traceSegIntoCellularQuadTree Point
p1 Point
p2 (Quad -> Extent -> Extent
cutQuadOfExtent Quad
NW Extent
extent) QuadTree a
nw
            , Point -> Point -> Extent -> QuadTree a -> [(Point, Extent, a)]
forall a.
Point -> Point -> Extent -> QuadTree a -> [(Point, Extent, a)]
traceSegIntoCellularQuadTree Point
p1 Point
p2 (Quad -> Extent -> Extent
cutQuadOfExtent Quad
NE Extent
extent) QuadTree a
ne
            , Point -> Point -> Extent -> QuadTree a -> [(Point, Extent, a)]
forall a.
Point -> Point -> Extent -> QuadTree a -> [(Point, Extent, a)]
traceSegIntoCellularQuadTree Point
p1 Point
p2 (Quad -> Extent -> Extent
cutQuadOfExtent Quad
SW Extent
extent) QuadTree a
sw
            , Point -> Point -> Extent -> QuadTree a -> [(Point, Extent, a)]
forall a.
Point -> Point -> Extent -> QuadTree a -> [(Point, Extent, a)]
traceSegIntoCellularQuadTree Point
p1 Point
p2 (Quad -> Extent -> Extent
cutQuadOfExtent Quad
SE Extent
extent) QuadTree a
se
            ]
    QuadTree a
_ -> []