{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} module Moonlight.Triangulation.Voronoi.Handles ( VoronoiFaceHandle , DirectedVoronoiEdgeHandle , UndirectedVoronoiEdgeHandle , VoronoiVertexHandle , voronoiFaceHandle , directedVoronoiEdgeHandle , undirectedVoronoiEdgeHandle , vertexAsVoronoiFaceH , directedEdgeAsVoronoiH , undirectedEdgeAsVoronoiH , innerFaceAsVoronoiVertexH , fixVoronoiFace , fixDirectedVoronoiEdge , fixUndirectedVoronoiEdge , fixVoronoiVertex , voronoiEdgeReverseH , voronoiEdgeNextH , voronoiEdgePreviousH , voronoiEdgeFromH , voronoiEdgeToH , voronoiEdgeFaceH , voronoiEdgeAsUndirectedH , voronoiEdgeAsDelaunayH , voronoiFaceSiteH , voronoiFaceAdjacentEdgesH , voronoiVertexPositionH , voronoiVertexOutEdgesH , voronoiVertexAsDelaunayFaceH , voronoiVertexAsOuterEdgeH , voronoiEdgeDirectionH , voronoiEdgeGeometryH ) where import Moonlight.Triangulation.Handles.Dynamic import Moonlight.Triangulation.Math (midpoint) import Moonlight.Triangulation.Types import Moonlight.Triangulation.Voronoi -- | Zero-copy dual handles. Each dual value contains exactly one primal handle, -- so it cannot accidentally combine an identifier from one triangulation with -- the storage of another. newtype VoronoiFaceHandle mode vertex directed undirected face = VoronoiFaceHandle (VertexHandle mode vertex directed undirected face) newtype DirectedVoronoiEdgeHandle mode vertex directed undirected face = DirectedVoronoiEdgeHandle (DirectedEdgeHandle mode vertex directed undirected face) newtype UndirectedVoronoiEdgeHandle mode vertex directed undirected face = UndirectedVoronoiEdgeHandle (UndirectedEdgeHandle mode vertex directed undirected face) data VoronoiVertexHandle mode vertex directed undirected face = InnerVoronoiVertexHandle !(FaceHandle InnerTag mode vertex directed undirected face) | OuterVoronoiVertexHandle !(DirectedVoronoiEdgeHandle mode vertex directed undirected face) instance Show (VoronoiFaceHandle mode vertex directed undirected face) where showsPrec precedence = showsPrec precedence . fixVoronoiFace instance Show (DirectedVoronoiEdgeHandle mode vertex directed undirected face) where showsPrec precedence = showsPrec precedence . fixDirectedVoronoiEdge instance Show (UndirectedVoronoiEdgeHandle mode vertex directed undirected face) where showsPrec precedence = showsPrec precedence . fixUndirectedVoronoiEdge instance Show (VoronoiVertexHandle mode vertex directed undirected face) where showsPrec precedence = showsPrec precedence . fixVoronoiVertex voronoiFaceHandle :: Triangulation mode vertex directed undirected face -> VoronoiFaceId -> Maybe (VoronoiFaceHandle mode vertex directed undirected face) voronoiFaceHandle triangulation (VoronoiFaceId site) = VoronoiFaceHandle <$> vertexHandle triangulation site vertexAsVoronoiFaceH :: VertexHandle mode vertex directed undirected face -> VoronoiFaceHandle mode vertex directed undirected face vertexAsVoronoiFaceH = VoronoiFaceHandle directedVoronoiEdgeHandle :: Triangulation mode vertex directed undirected face -> DirectedVoronoiEdgeId -> Maybe (DirectedVoronoiEdgeHandle mode vertex directed undirected face) directedVoronoiEdgeHandle triangulation (DirectedVoronoiEdgeId edge) = DirectedVoronoiEdgeHandle <$> directedEdgeHandle triangulation edge directedEdgeAsVoronoiH :: DirectedEdgeHandle mode vertex directed undirected face -> DirectedVoronoiEdgeHandle mode vertex directed undirected face directedEdgeAsVoronoiH = DirectedVoronoiEdgeHandle undirectedVoronoiEdgeHandle :: Triangulation mode vertex directed undirected face -> UndirectedVoronoiEdgeId -> Maybe (UndirectedVoronoiEdgeHandle mode vertex directed undirected face) undirectedVoronoiEdgeHandle triangulation (UndirectedVoronoiEdgeId edge) = UndirectedVoronoiEdgeHandle <$> undirectedEdgeHandle triangulation edge undirectedEdgeAsVoronoiH :: UndirectedEdgeHandle mode vertex directed undirected face -> UndirectedVoronoiEdgeHandle mode vertex directed undirected face undirectedEdgeAsVoronoiH = UndirectedVoronoiEdgeHandle innerFaceAsVoronoiVertexH :: FaceHandle InnerTag mode vertex directed undirected face -> VoronoiVertexHandle mode vertex directed undirected face innerFaceAsVoronoiVertexH = InnerVoronoiVertexHandle fixVoronoiFace :: VoronoiFaceHandle mode vertex directed undirected face -> VoronoiFaceId fixVoronoiFace (VoronoiFaceHandle site) = VoronoiFaceId (fixVertex site) {-# INLINE fixVoronoiFace #-} fixDirectedVoronoiEdge :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> DirectedVoronoiEdgeId fixDirectedVoronoiEdge (DirectedVoronoiEdgeHandle edge) = DirectedVoronoiEdgeId (fixDirectedEdge edge) {-# INLINE fixDirectedVoronoiEdge #-} fixUndirectedVoronoiEdge :: UndirectedVoronoiEdgeHandle mode vertex directed undirected face -> UndirectedVoronoiEdgeId fixUndirectedVoronoiEdge (UndirectedVoronoiEdgeHandle edge) = UndirectedVoronoiEdgeId (fixUndirectedEdge edge) {-# INLINE fixUndirectedVoronoiEdge #-} fixVoronoiVertex :: VoronoiVertexHandle mode vertex directed undirected face -> VoronoiVertexId fixVoronoiVertex (InnerVoronoiVertexHandle face) = InnerVoronoiVertex (fixedFaceId (fixFace face)) fixVoronoiVertex (OuterVoronoiVertexHandle edge) = OuterVoronoiVertex (fixDirectedVoronoiEdge edge) {-# INLINE fixVoronoiVertex #-} voronoiEdgeReverseH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> DirectedVoronoiEdgeHandle mode vertex directed undirected face voronoiEdgeReverseH (DirectedVoronoiEdgeHandle edge) = DirectedVoronoiEdgeHandle (directedEdgeReverse edge) voronoiEdgeNextH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> DirectedVoronoiEdgeHandle mode vertex directed undirected face voronoiEdgeNextH (DirectedVoronoiEdgeHandle edge) = DirectedVoronoiEdgeHandle (directedEdgeCounterClockwise edge) voronoiEdgePreviousH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> DirectedVoronoiEdgeHandle mode vertex directed undirected face voronoiEdgePreviousH (DirectedVoronoiEdgeHandle edge) = DirectedVoronoiEdgeHandle (directedEdgeClockwise edge) voronoiEdgeFromH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> VoronoiVertexHandle mode vertex directed undirected face voronoiEdgeFromH edge@(DirectedVoronoiEdgeHandle primal) = case faceAsInner (directedEdgeFace primal) of Just inner -> InnerVoronoiVertexHandle inner Nothing -> OuterVoronoiVertexHandle edge voronoiEdgeToH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> VoronoiVertexHandle mode vertex directed undirected face voronoiEdgeToH = voronoiEdgeFromH . voronoiEdgeReverseH voronoiEdgeFaceH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> VoronoiFaceHandle mode vertex directed undirected face voronoiEdgeFaceH (DirectedVoronoiEdgeHandle edge) = VoronoiFaceHandle (directedEdgeFrom edge) voronoiEdgeAsUndirectedH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> UndirectedVoronoiEdgeHandle mode vertex directed undirected face voronoiEdgeAsUndirectedH (DirectedVoronoiEdgeHandle edge) = UndirectedVoronoiEdgeHandle (directedEdgeAsUndirected edge) voronoiEdgeAsDelaunayH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> DirectedEdgeHandle mode vertex directed undirected face voronoiEdgeAsDelaunayH (DirectedVoronoiEdgeHandle edge) = edge voronoiFaceSiteH :: VoronoiFaceHandle mode vertex directed undirected face -> VertexHandle mode vertex directed undirected face voronoiFaceSiteH (VoronoiFaceHandle site) = site voronoiFaceAdjacentEdgesH :: VoronoiFaceHandle mode vertex directed undirected face -> [DirectedVoronoiEdgeHandle mode vertex directed undirected face] voronoiFaceAdjacentEdgesH (VoronoiFaceHandle site) = map DirectedVoronoiEdgeHandle (vertexHandleOutEdges site) voronoiVertexPositionH :: VoronoiVertexHandle mode vertex directed undirected face -> Maybe (Point) voronoiVertexPositionH (InnerVoronoiVertexHandle face) = innerFaceCircumcenter face voronoiVertexPositionH (OuterVoronoiVertexHandle _) = Nothing voronoiVertexOutEdgesH :: VoronoiVertexHandle mode vertex directed undirected face -> Maybe [DirectedVoronoiEdgeHandle mode vertex directed undirected face] voronoiVertexOutEdgesH (InnerVoronoiVertexHandle face) = Just (map DirectedVoronoiEdgeHandle (faceAdjacentEdges face)) voronoiVertexOutEdgesH (OuterVoronoiVertexHandle _) = Nothing voronoiVertexAsDelaunayFaceH :: VoronoiVertexHandle mode vertex directed undirected face -> Maybe (FaceHandle InnerTag mode vertex directed undirected face) voronoiVertexAsDelaunayFaceH (InnerVoronoiVertexHandle face) = Just face voronoiVertexAsDelaunayFaceH (OuterVoronoiVertexHandle _) = Nothing voronoiVertexAsOuterEdgeH :: VoronoiVertexHandle mode vertex directed undirected face -> Maybe (DirectedVoronoiEdgeHandle mode vertex directed undirected face) voronoiVertexAsOuterEdgeH (InnerVoronoiVertexHandle _) = Nothing voronoiVertexAsOuterEdgeH (OuterVoronoiVertexHandle edge) = Just edge voronoiEdgeDirectionH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> Point voronoiEdgeDirectionH (DirectedVoronoiEdgeHandle primal) = let (Point ax ay, Point bx by) = directedEdgePositions primal in Point (ay - by) (bx - ax) voronoiEdgeGeometryH :: DirectedVoronoiEdgeHandle mode vertex directed undirected face -> Maybe (VoronoiEdgeGeometry) voronoiEdgeGeometryH edge@(DirectedVoronoiEdgeHandle primal) = case (voronoiEdgeFromH edge, voronoiEdgeToH edge) of (InnerVoronoiVertexHandle fromFace, InnerVoronoiVertexHandle toFace) -> VoronoiSegment <$> innerFaceCircumcenter fromFace <*> innerFaceCircumcenter toFace (InnerVoronoiVertexHandle fromFace, OuterVoronoiVertexHandle _) -> do start <- innerFaceCircumcenter fromFace pure (VoronoiRay start (normalizePoint (voronoiEdgeDirectionH edge))) (OuterVoronoiVertexHandle _, InnerVoronoiVertexHandle toFace) -> do end <- innerFaceCircumcenter toFace pure (VoronoiRay end (normalizePoint (negatePoint (voronoiEdgeDirectionH edge)))) (OuterVoronoiVertexHandle _, OuterVoronoiVertexHandle _) -> let (from, to) = directedEdgePositions primal in Just (VoronoiLine (midpoint from to) (normalizePoint (voronoiEdgeDirectionH edge))) normalizePoint :: Point -> Point normalizePoint (Point x y) | scale == 0 = Point 0 0 | otherwise = let !scaledX = x / scale !scaledY = y / scale !length' = sqrt (scaledX * scaledX + scaledY * scaledY) in Point (scaledX / length') (scaledY / length') where !scale = max (abs x) (abs y) negatePoint :: Point -> Point negatePoint (Point x y) = Point (-x) (-y) -- The handle verbs cross the same component boundary as the fixed-index ones -- and carry their unfoldings for the same reason. 'voronoiVertexPositionH' -- reaches its arithmetic through 'innerFaceCircumcenter', whose own worker -- publishes no unfolding, so it stops at that call until the dcel layer says -- otherwise.