HandleDefs.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | The identifier family and the arithmetic on it: a directed edge's twin is
-- its index complement, so orientation is a bit rather than a lookup.
module Moonlight.Triangulation.Handles.HandleDefs
  ( VertexId (..)
  , FaceId (..)
  , DirectedEdgeId (..)
  , UndirectedEdgeId (..)
  , reverseEdge
  , asUndirected
  , normalizedDirected
  , reversedDirected
  , directedPair
  , isNormalized
  ) where

import Control.DeepSeq (NFData)
import Data.Bits (shiftL, shiftR, xor, (.&.))
import Data.Word (Word32)

-- | Index of a vertex in the immutable DCEL.
newtype VertexId = VertexId { unVertexId :: Word32 }
  deriving stock (Show)
  deriving newtype (Eq, Ord, NFData)

-- | Index of a face in the immutable DCEL; zero denotes the outer face.
newtype FaceId = FaceId { unFaceId :: Word32 }
  deriving stock (Show)
  deriving newtype (Eq, Ord, NFData)

-- | Oriented half-edge index. Twin orientations differ only in the low bit.
newtype DirectedEdgeId = DirectedEdgeId { unDirectedEdgeId :: Word32 }
  deriving stock (Show)
  deriving newtype (Eq, Ord, NFData)

-- | Index of a twin pair, with orientation forgotten.
newtype UndirectedEdgeId = UndirectedEdgeId { unUndirectedEdgeId :: Word32 }
  deriving stock (Show)
  deriving newtype (Eq, Ord, NFData)

-- | Select the opposite orientation of the same undirected edge.
reverseEdge :: DirectedEdgeId -> DirectedEdgeId
reverseEdge (DirectedEdgeId edge) = DirectedEdgeId (edge `xor` 1)
{-# INLINE reverseEdge #-}

-- | Forget a directed edge's orientation.
asUndirected :: DirectedEdgeId -> UndirectedEdgeId
asUndirected (DirectedEdgeId edge) = UndirectedEdgeId (edge `shiftR` 1)
{-# INLINE asUndirected #-}

-- | Select the even-indexed orientation of an undirected edge.
normalizedDirected :: UndirectedEdgeId -> DirectedEdgeId
normalizedDirected (UndirectedEdgeId edge) = DirectedEdgeId (edge `shiftL` 1)
{-# INLINE normalizedDirected #-}

-- | Select the odd-indexed orientation of an undirected edge.
reversedDirected :: UndirectedEdgeId -> DirectedEdgeId
reversedDirected edge = reverseEdge (normalizedDirected edge)
{-# INLINE reversedDirected #-}

-- | Both orientations, normalized first and reversed second.
directedPair :: UndirectedEdgeId -> (DirectedEdgeId, DirectedEdgeId)
directedPair edge = (normalizedDirected edge, reversedDirected edge)
{-# INLINE directedPair #-}

-- | Whether a directed edge is the normalized orientation of its pair.
isNormalized :: DirectedEdgeId -> Bool
isNormalized (DirectedEdgeId edge) = edge .&. 1 == 0
{-# INLINE isNormalized #-}