Visibility.hs

module Reanimate.Math.Visibility where

-- import qualified Data.Set              as Set
import           Data.Maybe
import           Linear.V2
import           Reanimate.Math.Common
import           Reanimate.Math.Polygon

-- import           Debug.Trace

visibility :: [P] -> [P]
visibility (z:v:vs) = reverse $ go z [v,z] vs
visibility _        = undefined

-- visibility (z:v0:v1:rest)
--   | isLeftTurn z v0 v1 = left z [v1,v0] rest
--   | otherwise = scanA

-- Three cases:
--   v is visible: zsv is a left-turn
--   v moves in front of the stack: s'sv is right turn
--   v moves behind stack:
go :: (Ord a, Fractional a, Epsilon a) => V2 a -> [V2 a] -> [V2 a] -> [V2 a]
go _z stack [] = stack
go z stack@(s:s':_ss) (v:vs)
  | isLeftTurn z s v  = {-trace ("Left: " ++ show (z,s,v)) $ -}go z (v:stack) vs
  | isLeftTurn s' s v = {-trace ("Right: " ++ show (s',s,v,vs)) $ -}rightTurn z stack v vs
  | otherwise         = {-trace ("FF: " ++ show (z,s,s',v)) $ -}fastForward z stack s (v:vs)
go _ _ _ = undefined

{-
z: 2,2
stack: [1,1  2,6]
v: 0,1
-}

rightTurn :: (Ord a, Fractional a, Epsilon a) => V2 a -> [V2 a] -> V2 a -> [V2 a] -> [V2 a]
rightTurn z stack' v (v1:vs)
  | isRightTurn z v v1 = {-trace ("Double right: " ++ show (v,v1)) $ -}rightTurn z stack v1 vs
  | isLeftTurn z v v1 && isRightTurn (head stack') v v1
    = {-trace ("Right->Left: " ++ show (v,v1)) $ -}go z (v:stack) (v1:vs)
  | otherwise
    = {-trace ("Scan: " ++ show (v, stack')) $ -}scanc z stack v (v1:vs)
  where
    stack@(_s1:_ss) = unwindStack z stack' v (v1:vs)
rightTurn z stack v [] = unwindStack z stack v []

-- scan forwards until edge intersects zv ray
scanc :: (Ord a, Fractional a, Epsilon a) => V2 a -> [V2 a] -> V2 a -> [V2 a] -> [V2 a]
scanc z stack v (v1:v2:vs)
  | isBetween u (v1,v2) = -- trace ("Found: " ++ show (u, stack)) $
    go z (u:stack) (v2:vs)
    --rightTurn z stack u (v2:vs)
  | otherwise           = scanc z stack v (v2:vs)
  where
    Just u = rayIntersect (z,v) (v1,v2)
scanc _z stack _v _vs = stack

unwindStack :: (Ord a, Fractional a, Epsilon a) => V2 a -> [V2 a] -> V2 a -> t -> [V2 a]
unwindStack z (s1:s2:ss) v vs
  | isRightTurn z s1 v && isLeftTurn z s2 v = (u:s2:ss)
  | otherwise                               = unwindStack z (s2:ss) v vs
  where
    Just u = rayIntersect (z,v) (s1,s2)
unwindStack _z stack _v _vs = stack

-- We've moved into shadow. There are three ways out:
--  1. Find edge that crosses zv from right to left.
--     In this case, push intersection point to the stack and continue as normal.
--  2. Find edge that crosses zv from left to right and is above v
--     unwind stack
--  3. Find edge that crosses zv from left to right and is below v

fastForward :: (Ord a, Fractional a, Epsilon a) => V2 a -> [V2 a] -> V2 a -> [V2 a] -> [V2 a]
fastForward z stack v (v1:v2:vs)
  | isNothing i || not (isBetween u (v1, v2))        = {-trace ("FF past: " ++ show (z,v,v1,v2)) $ -}fastForward z stack v (v2:vs)
  | distSquared v u > distSquared z u = {-trace ("FF skip: " ++ show (z,v,v1,v2)) $ -}fastForward z stack v (v2:vs)
  | isLeftTurn z u v2                 = {-trace ("FF to: " ++ show u) $ -}go z (v2:u:stack) vs
  | distSquared z v < distSquared z u = {-trace ("FF unwind: " ++ show (z,v,v1,v2,u)) $ -}unwindStack z stack v2 (vs)
  | otherwise                         = fastForward z stack v (v2:vs)
  where
    i = rayIntersect (z, v) (v1, v2)
    Just u = rayIntersect (z, v) (v1, v2)
fastForward _z stack _v _vs = stack

{-
v2: 2,1
v1: 1,1
v: 1,0
-}

{-
left z [] [] = finish
left z stack@(s1:s2:ss) (v1:vs)
  | isLeftTurn z s1 v1
    = left z (v1:stack) rest
  | isRightTurn z s1 v1 && isRightTurn s2 s1 v1
    = scanA
  | otherwise
    = right

-- We've made a right turn and need to find the edge in the stack that
-- intersects the zv ray.
-- zv intersects the segment ab iff zav is right-turn and zbv is a left-turn.
right z [] v vs = []
right z (s1:s2:ss) v1 (v2:vs)
  | isRightTurn z s1 v1 && isLeftTurn z s2 v1
  = let u = lineIntersect (z,v) (s1,s2)
    in if isRightTurn z v1 v2
      then right
      else if isLeftTurn z v1 v2 && isRightTurn
  -}

-- Joe and Simpson.
-- vispol (z:v0:v1:vs)
--   | isLeftTurn z v0 v1 = left z [v1,v0] vs
--   | otherwise = scana z [v0] (v1:vs)