mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +00:00
hacky fix to cusp computation timeout
This commit is contained in:
parent
47cf66c5dd
commit
fea6667114
|
@ -611,13 +611,21 @@ outlineFunction rootAlgo mbCuspOptions ptParams toBrushParams
|
||||||
|
|
||||||
( potentialCusps, definiteCusps ) =
|
( potentialCusps, definiteCusps ) =
|
||||||
case mbCuspOptions of
|
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
|
foldMap
|
||||||
( \ ( i, ( _trees, DoneBoxes { doneSolBoxes = defCusps, doneGiveUpBoxes = potCusps } ) ) ->
|
( \ ( i, ( _trees, DoneBoxes { doneSolBoxes = defCusps, doneGiveUpBoxes = potCusps } ) ) ->
|
||||||
( map ( ( i , ) . fst ) potCusps, map ( i , ) defCusps )
|
( map ( ( i , ) . fst ) potCusps, map ( i , ) defCusps )
|
||||||
)
|
)
|
||||||
( IntMap.toList $ findCusps cuspOptions curvesI )
|
( IntMap.toList $ findCusps cuspOptions curvesI )
|
||||||
Nothing ->
|
_ ->
|
||||||
( [], [] )
|
( [], [] )
|
||||||
|
|
||||||
in OutlineInfo
|
in OutlineInfo
|
||||||
|
@ -627,6 +635,13 @@ outlineFunction rootAlgo mbCuspOptions ptParams toBrushParams
|
||||||
}
|
}
|
||||||
{-# INLINEABLE outlineFunction #-}
|
{-# 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
|
pathAndUsedParams :: forall k i (nbUsedParams :: Nat) arr crvData ptData
|
||||||
. ( HasType ( ℝ 2 ) ptData
|
. ( HasType ( ℝ 2 ) ptData
|
||||||
, HasBézier k i
|
, 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 ) )
|
, Cross ( I i Double ) ( T ( I i 2 ) )
|
||||||
, Torsor ( T ( I i 2 ) ) ( I i 2 )
|
, Torsor ( T ( I i 2 ) ) ( I i 2 )
|
||||||
, Show ( ℝ nbBrushParams )
|
, Show ( ℝ nbBrushParams )
|
||||||
|
, Show ( StrokeDatum k i )
|
||||||
, Representable ( I i Double ) ( I i 2 ), RepDim ( I i 2 ) ~ 2
|
, Representable ( I i Double ) ( I i 2 ), RepDim ( I i 2 ) ~ 2
|
||||||
)
|
)
|
||||||
=> ( I i Double -> I i 1 )
|
=> ( I i Double -> I i 1 )
|
||||||
|
|
|
@ -132,6 +132,8 @@ class HasEnvelopeEquation k where
|
||||||
, Transcendental ( I i Double )
|
, Transcendental ( I i Double )
|
||||||
, Representable ( I i Double ) ( I i 2 )
|
, Representable ( I i Double ) ( I i 2 )
|
||||||
, RepDim ( I i 2 ) ~ 2
|
, RepDim ( I i 2 ) ~ 2
|
||||||
|
|
||||||
|
, Show ( StrokeDatum k i )
|
||||||
)
|
)
|
||||||
=> Proxy i
|
=> Proxy i
|
||||||
-> ( I i Double -> I i 1 )
|
-> ( I i Double -> I i 1 )
|
||||||
|
|
|
@ -364,7 +364,7 @@ runApplication application = do
|
||||||
mbCuspOptions <- STM.readTVar cuspFindingOptionsTVar
|
mbCuspOptions <- STM.readTVar cuspFindingOptionsTVar
|
||||||
STM.writeTVar redrawStrokesTVar False
|
STM.writeTVar redrawStrokesTVar False
|
||||||
let
|
let
|
||||||
addRulers :: ( ( Int32, Int32 ) -> Cairo.Render () ) -> ( ( Int32, Int32 ) -> Cairo.Render () )
|
addRulers :: ( ( Int32, Int32 ) -> Cairo.Render () ) -> ( ( Int32, Int32 ) -> Cairo.Render () )
|
||||||
addRulers newRender viewportSize = do
|
addRulers newRender viewportSize = do
|
||||||
newRender viewportSize
|
newRender viewportSize
|
||||||
renderRuler
|
renderRuler
|
||||||
|
|
|
@ -1016,8 +1016,9 @@ updateLayerHierarchy
|
||||||
[] ->
|
[] ->
|
||||||
return ( Nothing, Nothing )
|
return ( Nothing, Nothing )
|
||||||
|
|
||||||
for_ mbNewHist $ \ ( activeDoc, hist ) ->
|
for_ mbNewHist $ \ ( activeDoc, hist ) -> do
|
||||||
STM.modifyTVar' ( openDocumentsTVar vars ) ( Map.insert activeDoc hist )
|
STM.modifyTVar' ( openDocumentsTVar vars ) ( Map.insert activeDoc hist )
|
||||||
|
STM.writeTVar ( redrawStrokesTVar vars ) True
|
||||||
return $ ( , ) <$> ( fst <$> mbNewHist ) <*> mbDiff
|
return $ ( , ) <$> ( fst <$> mbNewHist ) <*> mbDiff
|
||||||
|
|
||||||
for_ mbDiff $ \ ( docUnique, diff ) ->
|
for_ mbDiff $ \ ( docUnique, diff ) ->
|
||||||
|
|
|
@ -265,7 +265,8 @@ doIntersection k =
|
||||||
( Vec [ Fin r1_i1, Fin r1_i2, Fin r1_i3, Fin r1_i4 ] )
|
( 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 ] )
|
( 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.
|
-- Functions for intersection.
|
||||||
|
|
Loading…
Reference in a new issue