moonlight-triangulation-0.1.0.0: src-dcel/Moonlight/Triangulation/Handles/Dynamic.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RoleAnnotations #-}

module Moonlight.Triangulation.Handles.Dynamic
  ( InnerTag
  , PossiblyOuterTag
  , FixedFaceHandle
  , asPossiblyOuter
  , fixedFaceId
  , VertexHandle
  , DirectedEdgeHandle
  , UndirectedEdgeHandle
  , FaceHandle
  , vertexHandle
  , directedEdgeHandle
  , undirectedEdgeHandle
  , faceHandle
  , innerFaceHandle
  , outerFaceHandle
  , fixVertex
  , fixDirectedEdge
  , fixUndirectedEdge
  , fixFace
  , vertexHandleData
  , vertexHandlePosition
  , vertexHandleOutEdge
  , vertexHandleOutEdges
  , directedEdgeDataH
  , directedEdgeFrom
  , directedEdgeTo
  , directedEdgeVertices
  , directedEdgePositions
  , directedEdgeReverse
  , directedEdgeNext
  , directedEdgePrevious
  , directedEdgeClockwise
  , directedEdgeCounterClockwise
  , directedEdgeFace
  , directedEdgeAsUndirected
  , directedEdgeIsOuter
  , directedEdgeSideQuery
  , directedEdgeOppositeVertex
  , directedEdgeOppositePosition
  , directedEdgeProjectionFactor
  , directedEdgeNearestPoint
  , undirectedEdgeDataH
  , undirectedEdgeAsDirected
  , undirectedEdgeVertices
  , undirectedEdgeIsConstraint
  , undirectedEdgeIsBoundary
  , faceDataH
  , faceIsOuter
  , faceAsInner
  , faceAdjacentEdge
  , faceAdjacentEdges
  , innerFaceVertices
  , innerFaceCircumcenter
  , innerFacePositions
  , innerFaceBarycentric
  ) where

import Moonlight.Triangulation.Dcel qualified as Dcel
import Moonlight.Triangulation.Handles.HandleDefs
import Moonlight.Triangulation.LineSideInfo (LineSideInfo)
import Moonlight.Triangulation.Math qualified as Math
import Moonlight.Triangulation.Types

-- | A face handle that is statically known not to denote the outer face.
data InnerTag

-- | A face handle that may denote the unique outer face.
data PossiblyOuterTag

type role FixedFaceHandle nominal
newtype FixedFaceHandle tag = FixedFaceHandle { unFixedFaceHandle :: FaceId }
  deriving stock (Show)
  deriving newtype (Eq, Ord)

asPossiblyOuter :: FixedFaceHandle InnerTag -> FixedFaceHandle PossiblyOuterTag
asPossiblyOuter (FixedFaceHandle face) = FixedFaceHandle face
{-# INLINE asPossiblyOuter #-}

fixedFaceId :: FixedFaceHandle tag -> FaceId
fixedFaceId (FixedFaceHandle face) = face
{-# INLINE fixedFaceId #-}

data VertexHandle mode vertex directed undirected face = VertexHandle
  !(Triangulation mode vertex directed undirected face)
  !VertexId

data DirectedEdgeHandle mode vertex directed undirected face = DirectedEdgeHandle
  !(Triangulation mode vertex directed undirected face)
  !DirectedEdgeId

data UndirectedEdgeHandle mode vertex directed undirected face = UndirectedEdgeHandle
  !(Triangulation mode vertex directed undirected face)
  !UndirectedEdgeId

data FaceHandle tag mode vertex directed undirected face = FaceHandle
  !(Triangulation mode vertex directed undirected face)
  !(FixedFaceHandle tag)

instance Show (VertexHandle mode vertex directed undirected face) where
  showsPrec precedence = showsPrec precedence . fixVertex

instance Show (DirectedEdgeHandle mode vertex directed undirected face) where
  showsPrec precedence = showsPrec precedence . fixDirectedEdge

instance Show (UndirectedEdgeHandle mode vertex directed undirected face) where
  showsPrec precedence = showsPrec precedence . fixUndirectedEdge

instance Show (FaceHandle tag mode vertex directed undirected face) where
  showsPrec precedence = showsPrec precedence . fixFace

vertexHandle
  :: Triangulation mode vertex directed undirected face
  -> VertexId
  -> Maybe (VertexHandle mode vertex directed undirected face)
vertexHandle triangulation vertex@(VertexId raw)
  | fromIntegral raw < Dcel.numVertices triangulation = Just (VertexHandle triangulation vertex)
  | otherwise = Nothing

directedEdgeHandle
  :: Triangulation mode vertex directed undirected face
  -> DirectedEdgeId
  -> Maybe (DirectedEdgeHandle mode vertex directed undirected face)
directedEdgeHandle triangulation edge@(DirectedEdgeId raw)
  | fromIntegral raw < Dcel.numDirectedEdges triangulation = Just (DirectedEdgeHandle triangulation edge)
  | otherwise = Nothing

undirectedEdgeHandle
  :: Triangulation mode vertex directed undirected face
  -> UndirectedEdgeId
  -> Maybe (UndirectedEdgeHandle mode vertex directed undirected face)
undirectedEdgeHandle triangulation edge@(UndirectedEdgeId raw)
  | fromIntegral raw < Dcel.numUndirectedEdges triangulation = Just (UndirectedEdgeHandle triangulation edge)
  | otherwise = Nothing

faceHandle
  :: Triangulation mode vertex directed undirected face
  -> FaceId
  -> Maybe (FaceHandle PossiblyOuterTag mode vertex directed undirected face)
faceHandle triangulation face@(FaceId raw)
  | fromIntegral raw < Dcel.numFaces triangulation = Just (FaceHandle triangulation (FixedFaceHandle face))
  | otherwise = Nothing

innerFaceHandle
  :: Triangulation mode vertex directed undirected face
  -> FaceId
  -> Maybe (FaceHandle InnerTag mode vertex directed undirected face)
innerFaceHandle triangulation face
  | face == Dcel.outerFace = Nothing
  | otherwise = do
      FaceHandle _ (FixedFaceHandle valid) <- faceHandle triangulation face
      pure (FaceHandle triangulation (FixedFaceHandle valid))

outerFaceHandle
  :: Triangulation mode vertex directed undirected face
  -> FaceHandle PossiblyOuterTag mode vertex directed undirected face
outerFaceHandle triangulation = FaceHandle triangulation (FixedFaceHandle Dcel.outerFace)

fixVertex :: VertexHandle mode vertex directed undirected face -> VertexId
fixVertex (VertexHandle _ vertex) = vertex
{-# INLINE fixVertex #-}

fixDirectedEdge :: DirectedEdgeHandle mode vertex directed undirected face -> DirectedEdgeId
fixDirectedEdge (DirectedEdgeHandle _ edge) = edge
{-# INLINE fixDirectedEdge #-}

fixUndirectedEdge :: UndirectedEdgeHandle mode vertex directed undirected face -> UndirectedEdgeId
fixUndirectedEdge (UndirectedEdgeHandle _ edge) = edge
{-# INLINE fixUndirectedEdge #-}

fixFace :: FaceHandle tag mode vertex directed undirected face -> FixedFaceHandle tag
fixFace (FaceHandle _ face) = face
{-# INLINE fixFace #-}

vertexHandleData :: VertexHandle mode vertex directed undirected face -> vertex
vertexHandleData (VertexHandle triangulation vertex) = Dcel.vertexData triangulation vertex
{-# INLINE vertexHandleData #-}

vertexHandlePosition
  :: VertexHandle mode vertex directed undirected face
  -> Point
vertexHandlePosition (VertexHandle triangulation vertex) = (Dcel.vertexPoint triangulation vertex)
{-# INLINE vertexHandlePosition #-}

vertexHandleOutEdge
  :: VertexHandle mode vertex directed undirected face
  -> Maybe (DirectedEdgeHandle mode vertex directed undirected face)
vertexHandleOutEdge (VertexHandle triangulation vertex) = DirectedEdgeHandle triangulation <$> Dcel.vertexOutEdge triangulation vertex

vertexHandleOutEdges
  :: VertexHandle mode vertex directed undirected face
  -> [DirectedEdgeHandle mode vertex directed undirected face]
vertexHandleOutEdges (VertexHandle triangulation vertex) = map (DirectedEdgeHandle triangulation) (Dcel.vertexOutgoingEdges triangulation vertex)

directedEdgeDataH :: DirectedEdgeHandle mode vertex directed undirected face -> directed
directedEdgeDataH (DirectedEdgeHandle triangulation edge) = Dcel.directedEdgeData triangulation edge
{-# INLINE directedEdgeDataH #-}

directedEdgeFrom :: DirectedEdgeHandle mode vertex directed undirected face -> VertexHandle mode vertex directed undirected face
directedEdgeFrom (DirectedEdgeHandle triangulation edge) = VertexHandle triangulation (Dcel.origin triangulation edge)
{-# INLINE directedEdgeFrom #-}

directedEdgeTo :: DirectedEdgeHandle mode vertex directed undirected face -> VertexHandle mode vertex directed undirected face
directedEdgeTo (DirectedEdgeHandle triangulation edge) = VertexHandle triangulation (Dcel.destination triangulation edge)
{-# INLINE directedEdgeTo #-}

directedEdgeVertices
  :: DirectedEdgeHandle mode vertex directed undirected face
  -> (VertexHandle mode vertex directed undirected face, VertexHandle mode vertex directed undirected face)
directedEdgeVertices edge = (directedEdgeFrom edge, directedEdgeTo edge)

directedEdgePositions
  :: DirectedEdgeHandle mode vertex directed undirected face
  -> (Point, Point)
directedEdgePositions edge = (vertexHandlePosition (directedEdgeFrom edge), vertexHandlePosition (directedEdgeTo edge))
{-# INLINE directedEdgePositions #-}

directedEdgeReverse :: DirectedEdgeHandle mode vertex directed undirected face -> DirectedEdgeHandle mode vertex directed undirected face
directedEdgeReverse (DirectedEdgeHandle triangulation edge) = DirectedEdgeHandle triangulation (reverseEdge edge)
{-# INLINE directedEdgeReverse #-}

directedEdgeNext :: DirectedEdgeHandle mode vertex directed undirected face -> DirectedEdgeHandle mode vertex directed undirected face
directedEdgeNext (DirectedEdgeHandle triangulation edge) = DirectedEdgeHandle triangulation (Dcel.next triangulation edge)
{-# INLINE directedEdgeNext #-}

directedEdgePrevious :: DirectedEdgeHandle mode vertex directed undirected face -> DirectedEdgeHandle mode vertex directed undirected face
directedEdgePrevious (DirectedEdgeHandle triangulation edge) = DirectedEdgeHandle triangulation (Dcel.previous triangulation edge)
{-# INLINE directedEdgePrevious #-}

directedEdgeClockwise :: DirectedEdgeHandle mode vertex directed undirected face -> DirectedEdgeHandle mode vertex directed undirected face
directedEdgeClockwise (DirectedEdgeHandle triangulation edge) = DirectedEdgeHandle triangulation (Dcel.clockwise triangulation edge)
{-# INLINE directedEdgeClockwise #-}

directedEdgeCounterClockwise :: DirectedEdgeHandle mode vertex directed undirected face -> DirectedEdgeHandle mode vertex directed undirected face
directedEdgeCounterClockwise (DirectedEdgeHandle triangulation edge) = DirectedEdgeHandle triangulation (Dcel.counterClockwise triangulation edge)
{-# INLINE directedEdgeCounterClockwise #-}

directedEdgeFace
  :: DirectedEdgeHandle mode vertex directed undirected face
  -> FaceHandle PossiblyOuterTag mode vertex directed undirected face
directedEdgeFace (DirectedEdgeHandle triangulation edge) = FaceHandle triangulation (FixedFaceHandle (Dcel.incidentFace triangulation edge))

directedEdgeAsUndirected
  :: DirectedEdgeHandle mode vertex directed undirected face
  -> UndirectedEdgeHandle mode vertex directed undirected face
directedEdgeAsUndirected (DirectedEdgeHandle triangulation edge) = UndirectedEdgeHandle triangulation (asUndirected edge)

directedEdgeIsOuter :: DirectedEdgeHandle mode vertex directed undirected face -> Bool
directedEdgeIsOuter = faceIsOuter . directedEdgeFace

directedEdgeSideQuery
  :: DirectedEdgeHandle mode vertex directed undirected face
  -> Point
  -> LineSideInfo
directedEdgeSideQuery edge query =
  let (from, to) = directedEdgePositions edge
   in Math.sideQuery from to query

undirectedEdgeDataH :: UndirectedEdgeHandle mode vertex directed undirected face -> undirected
undirectedEdgeDataH (UndirectedEdgeHandle triangulation edge) = Dcel.undirectedEdgeData triangulation edge
{-# INLINE undirectedEdgeDataH #-}

undirectedEdgeAsDirected
  :: UndirectedEdgeHandle mode vertex directed undirected face
  -> DirectedEdgeHandle mode vertex directed undirected face
undirectedEdgeAsDirected (UndirectedEdgeHandle triangulation edge) = DirectedEdgeHandle triangulation (normalizedDirected edge)

undirectedEdgeVertices
  :: UndirectedEdgeHandle mode vertex directed undirected face
  -> (VertexHandle mode vertex directed undirected face, VertexHandle mode vertex directed undirected face)
undirectedEdgeVertices = directedEdgeVertices . undirectedEdgeAsDirected

faceDataH :: FaceHandle tag mode vertex directed undirected face -> face
faceDataH (FaceHandle triangulation (FixedFaceHandle face)) = Dcel.faceData triangulation face
{-# INLINE faceDataH #-}

faceIsOuter :: FaceHandle tag mode vertex directed undirected face -> Bool
faceIsOuter (FaceHandle _ (FixedFaceHandle face)) = face == Dcel.outerFace
{-# INLINE faceIsOuter #-}

faceAsInner
  :: FaceHandle PossiblyOuterTag mode vertex directed undirected face
  -> Maybe (FaceHandle InnerTag mode vertex directed undirected face)
faceAsInner handle@(FaceHandle triangulation (FixedFaceHandle face))
  | faceIsOuter handle = Nothing
  | otherwise = Just (FaceHandle triangulation (FixedFaceHandle face))

faceAdjacentEdge
  :: FaceHandle tag mode vertex directed undirected face
  -> Maybe (DirectedEdgeHandle mode vertex directed undirected face)
faceAdjacentEdge (FaceHandle triangulation (FixedFaceHandle face)) = DirectedEdgeHandle triangulation <$> Dcel.adjacentEdge triangulation face

faceAdjacentEdges
  :: FaceHandle tag mode vertex directed undirected face
  -> [DirectedEdgeHandle mode vertex directed undirected face]
faceAdjacentEdges (FaceHandle triangulation (FixedFaceHandle face)) = map (DirectedEdgeHandle triangulation) (Dcel.faceDirectedEdges triangulation face)

innerFaceVertices
  :: FaceHandle InnerTag mode vertex directed undirected face
  -> Maybe
       ( VertexHandle mode vertex directed undirected face
       , VertexHandle mode vertex directed undirected face
       , VertexHandle mode vertex directed undirected face
       )
innerFaceVertices (FaceHandle triangulation (FixedFaceHandle face)) =
  (\(a, b, c) -> (VertexHandle triangulation a, VertexHandle triangulation b, VertexHandle triangulation c))
    <$> Dcel.innerFaceVertices triangulation face

innerFaceCircumcenter
  :: FaceHandle InnerTag mode vertex directed undirected face
  -> Maybe (Point)
innerFaceCircumcenter face = do
  (a, b, c) <- innerFaceVertices face
  Math.circumcenter (vertexHandlePosition a) (vertexHandlePosition b) (vertexHandlePosition c)

directedEdgeOppositeVertex
  :: DirectedEdgeHandle mode vertex directed undirected face
  -> Maybe (VertexHandle mode vertex directed undirected face)
directedEdgeOppositeVertex (DirectedEdgeHandle triangulation edge)
  | Dcel.incidentFace triangulation edge == Dcel.outerFace = Nothing
  | otherwise =
      Just (VertexHandle triangulation (Dcel.destination triangulation (Dcel.next triangulation edge)))

directedEdgeOppositePosition
  :: DirectedEdgeHandle mode vertex directed undirected face
  -> Maybe (Point)
directedEdgeOppositePosition = fmap vertexHandlePosition . directedEdgeOppositeVertex
{-# INLINE directedEdgeOppositePosition #-}

directedEdgeProjectionFactor
  :: DirectedEdgeHandle mode vertex directed undirected face
  -> Point
  -> Double
directedEdgeProjectionFactor edge query =
  let (from, to) = directedEdgePositions edge
   in Math.projectionFactor from to query

directedEdgeNearestPoint
  :: DirectedEdgeHandle mode vertex directed undirected face
  -> Point
  -> Point
directedEdgeNearestPoint edge query =
  let (from@(Point ax ay), to@(Point bx by)) = directedEdgePositions edge
      factor = max 0 (min 1 (Math.projectionFactor from to query))
   in Point (ax + factor * (bx - ax)) (ay + factor * (by - ay))

undirectedEdgeIsConstraint
  :: UndirectedEdgeHandle mode vertex directed undirected face
  -> Bool
undirectedEdgeIsConstraint (UndirectedEdgeHandle triangulation edge) =
  Dcel.isConstraintEdge triangulation edge

undirectedEdgeIsBoundary
  :: UndirectedEdgeHandle mode vertex directed undirected face
  -> Bool
undirectedEdgeIsBoundary (UndirectedEdgeHandle triangulation edge) =
  Dcel.isBoundaryEdge triangulation edge

innerFacePositions
  :: FaceHandle InnerTag mode vertex directed undirected face
  -> Maybe (Point, Point, Point)
innerFacePositions face = do
  (a, b, c) <- innerFaceVertices face
  pure (vertexHandlePosition a, vertexHandlePosition b, vertexHandlePosition c)
{-# INLINE innerFacePositions #-}

innerFaceBarycentric
  :: FaceHandle InnerTag mode vertex directed undirected face
  -> Point
  -> Maybe (Double, Double, Double)
innerFaceBarycentric face query = do
  (a, b, c) <- innerFacePositions face
  Math.barycentricCoordinates a b c query