Legalize.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | The seeding entry points that drive one legalization epoch.
module Moonlight.Triangulation.Internal.DcelOperations.Legalize
  ( legalizeScratch
  , legalizeEdges
  , legalizeCavityFanScratch
  ) where

import Control.Monad (when)
import Control.Monad.ST (ST)
import Data.Foldable (traverse_)
import qualified Data.Vector.Unboxed.Mutable as MUV
import Moonlight.Triangulation.Internal.DcelOperations.CandidateArena
  ( genericCandidate
  , growLegalizationArena
  , noStarVertex
  , seedGenericEdges
  , seedStarScratch
  )
import Moonlight.Triangulation.Internal.DcelOperations.FlipRule (LegalizationLaw (..))
import Moonlight.Triangulation.Internal.DcelOperations.Normalize (drainLegalization)
import Moonlight.Triangulation.Internal.Mutable (MutableDcel)
import Moonlight.Triangulation.Internal.OperationState
  ( Counter (..)
  , OperationState
  , addCounter
  , legalizationArena
  , maxCounter
  , readScratch
  , storeLegalizationArena
  )
import Moonlight.Triangulation.Internal.PackedIndex (packIndex)
import Moonlight.Triangulation.Internal.Probe (KnownProbe, Probe (..))

legalizeEdges :: MutableDcel s vertex directed undirected face -> OperationState s -> [Int] -> ST s ()
legalizeEdges mutable operation initial = do
  top <- seedGenericEdges operation 0 initial
  (flips, maxDepth) <- drainLegalization @'ProbeOff mutable operation top noStarVertex ValidMesh
  addCounter operation CounterEdgeFlips flips
  maxCounter operation CounterLegalizationMaxStack maxDepth

-- | Repair the fan that fills a removed vertex's hole, draining cavity
-- candidates already written into the operation-owned scratch section. The
-- fan is a valid combinatorial filling but not yet a triangulation — a link
-- polygon that is non-convex at the fan origin yields an inverted triangle —
-- so this drain carries 'CavityRepair' rather than the insertion law: it
-- flips on the incircle determinant alone, and only the fan's own edges may
-- flip. Removal discovers and constructs the cavity inside that same
-- transaction; materializing a list merely to seed the legalization arena
-- would duplicate the local program.
legalizeCavityFanScratch
  :: MutableDcel s vertex directed undirected face
  -> OperationState s
  -> Int
  -> Int
  -> Int
  -> ST s ()
legalizeCavityFanScratch mutable operation cavityFloor scratchOffset candidateCount = do
  initialArena <- legalizationArena operation
  arena <- growLegalizationArena initialArena candidateCount
  when (MUV.length arena /= MUV.length initialArena) (storeLegalizationArena operation arena)
  traverse_
    (\index -> do
       edge <- readScratch operation (scratchOffset + index)
       MUV.unsafeWrite arena index (packIndex (genericCandidate edge))
    )
    [0 .. candidateCount - 1]
  (flips, maxDepth) <-
    drainLegalization
      @'ProbeOff
      mutable
      operation
      candidateCount
      noStarVertex
      (CavityRepair cavityFloor)
  addCounter operation CounterEdgeFlips flips
  maxCounter operation CounterLegalizationMaxStack maxDepth

legalizeScratch :: forall p s vertex directed undirected face. KnownProbe p => MutableDcel s vertex directed undirected face -> OperationState s -> Int -> Int -> ST s ()
legalizeScratch mutable operation vertex candidateCount = do
  top <- seedStarScratch operation 0 candidateCount
  (flips, maxDepth) <- drainLegalization @p mutable operation top vertex ValidMesh
  addCounter operation CounterEdgeFlips flips
  maxCounter operation CounterLegalizationMaxStack maxDepth