mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-23 15:34:06 +00:00
proper fix for brush widget action applying to all strokes
This commit is contained in:
sheaf
parent
2e05731ffa
commit
61a33e30d2
|
|
@ -112,11 +112,16 @@ import MetaBrush.Document
|
|||
import MetaBrush.Document.Diff
|
||||
import MetaBrush.Hover
|
||||
( inPointClickRange )
|
||||
import MetaBrush.Layer
|
||||
( Parent, WithinParent (..) )
|
||||
import MetaBrush.Records
|
||||
import MetaBrush.Stroke
|
||||
import MetaBrush.Unique
|
||||
( Unique )
|
||||
import MetaBrush.Layer (Parent, WithinParent (..))
|
||||
|
||||
|
||||
import Debug.Utils
|
||||
( trace )
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Subdivision.
|
||||
|
|
@ -935,32 +940,32 @@ data BrushWidgetActionState brushFields
|
|||
deriving stock instance Show ( Record brushFields ) => Show ( BrushWidgetActionState brushFields )
|
||||
deriving stock instance Eq ( Record brushFields ) => Eq ( BrushWidgetActionState brushFields )
|
||||
|
||||
data WidgetFwd act =
|
||||
data WidgetFwd =
|
||||
WidgetFwd
|
||||
{ mbPastAction :: !( Maybe act )
|
||||
{ mbPastAction :: !( Maybe ABrushWidgetActionState )
|
||||
, changeInPrevCurve :: !Bool
|
||||
, pastActionPropagates :: !Bool
|
||||
}
|
||||
|
||||
data WidgetBwd act =
|
||||
data WidgetBwd =
|
||||
WidgetBwd
|
||||
{ mbFuturePropagatingAction :: !( Maybe act ) }
|
||||
{ mbFuturePropagatingAction :: !( Maybe ABrushWidgetActionState ) }
|
||||
|
||||
|
||||
type WidgetM :: Type -> Type -> Type
|
||||
type WidgetM act = Tardis ( WidgetBwd act ) ( WidgetFwd act )
|
||||
type WidgetM :: Type -> Type
|
||||
type WidgetM = Tardis WidgetBwd WidgetFwd
|
||||
|
||||
-- | Apply a brush widget action, e.g. rotating or scaling the brush at a particular stroke point.
|
||||
applyBrushWidgetAction :: Bool -> Bool -> ℝ 2 -> Maybe ABrushWidgetActionState -> Document -> Maybe ( Document, ABrushWidgetActionState )
|
||||
applyBrushWidgetAction pressingCtrl pressingAlt c mbPrevAction doc@( Document { documentContent, documentMetadata } ) =
|
||||
let
|
||||
( newStrokes, mbAct ) =
|
||||
( `State.runState` Nothing ) $
|
||||
( newStrokes, ( _bwd, WidgetFwd { mbPastAction = mbNewAction } ) ) =
|
||||
( `Tardis.runTardis` ( WidgetBwd Nothing, WidgetFwd mbPrevAction False False ) ) $
|
||||
forStrokeHierarchy
|
||||
( layerMetadata documentMetadata )
|
||||
( strokeHierarchy documentContent )
|
||||
updateStroke
|
||||
in mbAct <&> \ act ->
|
||||
in mbNewAction <&> \ act ->
|
||||
( set ( field' @"documentContent" . field' @"strokeHierarchy" ) newStrokes doc
|
||||
, act
|
||||
)
|
||||
|
|
@ -968,7 +973,7 @@ applyBrushWidgetAction pressingCtrl pressingAlt c mbPrevAction doc@( Document {
|
|||
|
||||
zoom = documentZoom $ documentMetadata
|
||||
|
||||
updateStroke :: WithinParent Unique -> Stroke -> StrokeMetadata -> State ( Maybe ABrushWidgetActionState ) UpdateStroke
|
||||
updateStroke :: WithinParent Unique -> Stroke -> StrokeMetadata -> WidgetM UpdateStroke
|
||||
updateStroke ( WithinParent _ u )
|
||||
( Stroke { strokeBrush, strokeSpline = oldSpline :: StrokeSpline clo ( Record pointFields ) } )
|
||||
( StrokeMetadata { strokeVisible, strokeLocked } )
|
||||
|
|
@ -981,8 +986,6 @@ applyBrushWidgetAction pressingCtrl pressingAlt c mbPrevAction doc@( Document {
|
|||
, Union @pointFields' unionWith
|
||||
<- union @pointFields @brushFields
|
||||
= do
|
||||
let ( res, ( _bwd, WidgetFwd { mbPastAction = mbAction } ) ) =
|
||||
( `Tardis.runTardis` ( WidgetBwd Nothing, WidgetFwd Nothing False False ) ) $ do
|
||||
let defaultBrushParams = MkR $ defaultParams $ brushFunction brush
|
||||
embedUsedParams = updateBrushParams defaultBrushParams
|
||||
toBrushParams = embedUsedParams . ptParamsToUsedParams
|
||||
|
|
@ -999,8 +1002,6 @@ applyBrushWidgetAction pressingCtrl pressingAlt c mbPrevAction doc@( Document {
|
|||
case mbAct of
|
||||
Nothing -> return PreserveStroke
|
||||
Just {} -> return $ UpdateStrokeTo $ Stroke { strokeBrush, strokeSpline = spline' }
|
||||
State.put $ ABrushWidgetActionState <$> mbAction
|
||||
return res
|
||||
| otherwise
|
||||
= return PreserveStroke
|
||||
|
||||
|
|
@ -1018,7 +1019,7 @@ applyBrushWidgetAction pressingCtrl pressingAlt c mbPrevAction doc@( Document {
|
|||
-> ( Record brushFields -> pointParams -> pointParams' )
|
||||
-> Unique
|
||||
-> PointData pointParams -> Curve clo' ( CurveData RealWorld ) ( PointData pointParams )
|
||||
-> WidgetM ( BrushWidgetActionState brushFields ) ( Curve clo' ( CurveData RealWorld ) ( PointData pointParams' ) )
|
||||
-> WidgetM ( Curve clo' ( CurveData RealWorld ) ( PointData pointParams' ) )
|
||||
updateSplineCurve _start brush toBrushParams noUpdatePointParams updatePointParams uniq _sp0 curve = do
|
||||
WidgetFwd { changeInPrevCurve } <- Tardis.getPast
|
||||
-- There are two kinds of brush widget updates:
|
||||
|
|
@ -1030,7 +1031,7 @@ applyBrushWidgetAction pressingCtrl pressingAlt c mbPrevAction doc@( Document {
|
|||
-- - we are continuing an operation, and we have the right curve index
|
||||
-- - Synchronising an update on other selected points.
|
||||
let updPt = updateSplinePoint brush toBrushParams noUpdatePointParams updatePointParams uniq
|
||||
updDat :: CurveData RealWorld -> WidgetM ( BrushWidgetActionState brushFields )( CurveData RealWorld )
|
||||
updDat :: CurveData RealWorld -> WidgetM ( CurveData RealWorld )
|
||||
updDat dat = do
|
||||
WidgetFwd { changeInPrevCurve = newChange } <- Tardis.getPast
|
||||
if newChange
|
||||
|
|
@ -1085,7 +1086,7 @@ applyBrushWidgetAction pressingCtrl pressingAlt c mbPrevAction doc@( Document {
|
|||
-> ( Record brushFields -> pointParams -> pointParams' )
|
||||
-> Unique -> PointIndex
|
||||
-> PointData pointParams
|
||||
-> WidgetM ( BrushWidgetActionState brushFields ) ( PointData pointParams' )
|
||||
-> WidgetM ( PointData pointParams' )
|
||||
updateSplinePoint brush toBrushParams noUpdatePointParams updatePointParams uniq j pt = do
|
||||
WidgetFwd
|
||||
{ mbPastAction = mbPastAct
|
||||
|
|
@ -1130,7 +1131,7 @@ applyBrushWidgetAction pressingCtrl pressingAlt c mbPrevAction doc@( Document {
|
|||
}
|
||||
Tardis.sendFuture $
|
||||
WidgetFwd
|
||||
{ mbPastAction = Just newAction
|
||||
{ mbPastAction = Just $ ABrushWidgetActionState newAction
|
||||
, changeInPrevCurve = True
|
||||
, pastActionPropagates = True -- currentPointSelected
|
||||
}
|
||||
|
|
@ -1139,7 +1140,7 @@ applyBrushWidgetAction pressingCtrl pressingAlt c mbPrevAction doc@( Document {
|
|||
{ mbFuturePropagatingAction =
|
||||
--if currentPointSelected
|
||||
--then
|
||||
Just newAction
|
||||
Just $ ABrushWidgetActionState newAction
|
||||
--else Nothing
|
||||
}
|
||||
return $ upd newParams
|
||||
|
|
@ -1150,7 +1151,7 @@ applyBrushWidgetAction pressingCtrl pressingAlt c mbPrevAction doc@( Document {
|
|||
<- Tardis.getFuture
|
||||
return $
|
||||
let
|
||||
propagatingAct :: Maybe ( BrushWidgetActionState brushFields )
|
||||
propagatingAct :: Maybe ABrushWidgetActionState
|
||||
propagatingAct
|
||||
| Just a <- mbPastAct
|
||||
, pastActionPropagates
|
||||
|
|
@ -1159,7 +1160,8 @@ applyBrushWidgetAction pressingCtrl pressingAlt c mbPrevAction doc@( Document {
|
|||
= mbFutureAct
|
||||
in
|
||||
if
|
||||
| Just propAct <- propagatingAct
|
||||
| Just ( ABrushWidgetActionState @brushFields'' propAct ) <- propagatingAct
|
||||
, Just Refl <- eqT @brushFields @brushFields''
|
||||
, BrushWidgetActionState
|
||||
{ brushWidgetAction = action
|
||||
, brushWidgetPrevParams = params0
|
||||
|
|
@ -1200,7 +1202,7 @@ applyBrushWidgetAction pressingCtrl pressingAlt c mbPrevAction doc@( Document {
|
|||
}
|
||||
Tardis.sendFuture $
|
||||
WidgetFwd
|
||||
{ mbPastAction = Just newAction
|
||||
{ mbPastAction = Just $ ABrushWidgetActionState newAction
|
||||
, changeInPrevCurve = False
|
||||
, pastActionPropagates = False
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in a new issue