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 ) =
|
||||
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 )
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ) ->
|
||||
|
|
|
@ -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.
|
||||
|
|
Loading…
Reference in a new issue