hacky fix to cusp computation timeout

This commit is contained in:
sheaf 2024-10-12 16:48:48 +02:00
parent 47cf66c5dd
commit fea6667114
5 changed files with 25 additions and 5 deletions

View file

@ -611,13 +611,21 @@ outlineFunction rootAlgo mbCuspOptions ptParams toBrushParams
( potentialCusps, definiteCusps ) =
case mbCuspOptions of
Just cuspOptions ->
Just cuspOptions
-- Don't try to compute cusps for a trivial curve
-- (e.g. a line segment with identical start- and end-points),
-- as the root isolation code chokes on this.
| not ( trivialCurve sp0 crv )
-- TODO: introduce a maximum time budget for the cusp computation,
-- and bail out if the computation exceeds the budget.
-- (Record such bailing out and warn the user if this happens often.)
->
foldMap
( \ ( i, ( _trees, DoneBoxes { doneSolBoxes = defCusps, doneGiveUpBoxes = potCusps } ) ) ->
( map ( ( i , ) . fst ) potCusps, map ( i , ) defCusps )
)
( IntMap.toList $ findCusps cuspOptions curvesI )
Nothing ->
_ ->
( [], [] )
in OutlineInfo
@ -627,6 +635,13 @@ outlineFunction rootAlgo mbCuspOptions ptParams toBrushParams
}
{-# INLINEABLE outlineFunction #-}
-- TODO: move this out
trivialCurve :: HasType ( 2 ) ptData => ptData -> Curve Open crvData ptData -> Bool
trivialCurve p0 = \case
LineTo ( NextPoint p1 ) _ -> coords p0 == coords p1
Bezier2To cp1 ( NextPoint p2 ) _ -> all ( ( == coords p0 ) . coords ) [ cp1, p2 ]
Bezier3To cp1 cp2 ( NextPoint p3 ) _ -> all ( ( == coords p0 ) . coords ) [ cp1, cp2, p3 ]
pathAndUsedParams :: forall k i (nbUsedParams :: Nat) arr crvData ptData
. ( HasType ( 2 ) ptData
, HasBézier k i
@ -1007,6 +1022,7 @@ brushStrokeData :: forall {kd} (k :: Nat) (nbBrushParams :: Nat) (i :: kd) arr
, Cross ( I i Double ) ( T ( I i 2 ) )
, Torsor ( T ( I i 2 ) ) ( I i 2 )
, Show ( nbBrushParams )
, Show ( StrokeDatum k i )
, Representable ( I i Double ) ( I i 2 ), RepDim ( I i 2 ) ~ 2
)
=> ( I i Double -> I i 1 )

View file

@ -132,6 +132,8 @@ class HasEnvelopeEquation k where
, Transcendental ( I i Double )
, Representable ( I i Double ) ( I i 2 )
, RepDim ( I i 2 ) ~ 2
, Show ( StrokeDatum k i )
)
=> Proxy i
-> ( I i Double -> I i 1 )

View file

@ -364,7 +364,7 @@ runApplication application = do
mbCuspOptions <- STM.readTVar cuspFindingOptionsTVar
STM.writeTVar redrawStrokesTVar False
let
addRulers :: ( ( Int32, Int32 ) -> Cairo.Render () ) -> ( ( Int32, Int32 ) -> Cairo.Render () )
addRulers :: ( ( Int32, Int32 ) -> Cairo.Render () ) -> ( ( Int32, Int32 ) -> Cairo.Render () )
addRulers newRender viewportSize = do
newRender viewportSize
renderRuler

View file

@ -1016,8 +1016,9 @@ updateLayerHierarchy
[] ->
return ( Nothing, Nothing )
for_ mbNewHist $ \ ( activeDoc, hist ) ->
for_ mbNewHist $ \ ( activeDoc, hist ) -> do
STM.modifyTVar' ( openDocumentsTVar vars ) ( Map.insert activeDoc hist )
STM.writeTVar ( redrawStrokesTVar vars ) True
return $ ( , ) <$> ( fst <$> mbNewHist ) <*> mbDiff
for_ mbDiff $ \ ( docUnique, diff ) ->

View file

@ -265,7 +265,8 @@ doIntersection k =
( Vec [ Fin r1_i1, Fin r1_i2, Fin r1_i3, Fin r1_i4 ] )
( Vec [ Fin r2_i1, Fin r2_i2, Fin r2_i3, Fin r2_i4 ] )
other -> error $ "Intersection not defined in dimension " ++ show ( length other )
other ->
error $ "Intersection not defined in dimension " ++ show ( length other )
------
-- Functions for intersection.