module Reanimate.Math.Visibility where
import Data.Maybe
import Linear.V2
import Reanimate.Math.Common
import Reanimate.Math.Polygon
visibility :: [P] -> [P]
visibility (z:v:vs) = reverse $ go z [v,z] vs
visibility _ = undefined
go :: (Ord a, Fractional 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 = go z (v:stack) vs
| isLeftTurn s' s v = rightTurn z stack v vs
| otherwise = fastForward z stack s (v:vs)
go _ _ _ = undefined
rightTurn :: (Ord a, Fractional a) => V2 a -> [V2 a] -> V2 a -> [V2 a] -> [V2 a]
rightTurn z stack' v (v1:vs)
| isRightTurn z v v1 = rightTurn z stack v1 vs
| isLeftTurn z v v1 && isRightTurn (head stack') v v1
= go z (v:stack) (v1:vs)
| otherwise
= scanc z stack v (v1:vs)
where
stack@(_s1:_ss) = unwindStack z stack' v (v1:vs)
rightTurn z stack v [] = unwindStack z stack v []
scanc :: (Ord a, Fractional a) => V2 a -> [V2 a] -> V2 a -> [V2 a] -> [V2 a]
scanc z stack v (v1:v2:vs)
| isBetween u (v1,v2) =
go z (u:stack) (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) => 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
fastForward :: (Ord a, Fractional 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)) = fastForward z stack v (v2:vs)
| distSquared v u > distSquared z u = fastForward z stack v (v2:vs)
| isLeftTurn z u v2 = go z (v2:u:stack) vs
| distSquared z v < distSquared z 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