stroke hierarchy

src/app/MetaBrush/Application.hs

@@ -116,7 +116,7 @@ import MetaBrush.Context
   )
 import MetaBrush.Document
   ( emptyDocument
-  , Stroke(..), FocusState(..)
+  , Stroke(..), StrokeHierarchy(..), FocusState(..)
   , PointData(..)
   )
 import MetaBrush.Document.History
@@ -175,7 +175,7 @@ runApplication application = do
       [ emptyDocument "Test" docUnique
       & ( field' @"documentContent" . field' @"strokes" ) .~
         ( Seq.fromList
-          [ Stroke
+          [ StrokeLeaf $ Stroke
             { strokeName    = "Stroke 1"
             , strokeVisible = True
             , strokeUnique  = strokeUnique

src/app/MetaBrush/Document.hs

@@ -26,7 +26,8 @@ module MetaBrush.Document
   ( AABB(..), mkAABB
   , Document(..), DocumentContent(..)
   , emptyDocument
-  , Stroke(..), StrokeSpline, _strokeSpline, overStrokeSpline
+  , Stroke(..), StrokeHierarchy(..), visibleStrokes
+  , StrokeSpline, _strokeSpline, overStrokeSpline
   , PointData(..), BrushPointData(..), DiffPointData(..)
   , FocusState(..), Hoverable(..), HoverContext(..)
   , Guide(..)
@@ -57,9 +58,9 @@ import Data.Map.Strict
 import qualified Data.Map.Strict as Map
   ( empty, insert )
 import Data.Sequence
-  ( Seq )
+  ( Seq(..) )
 import qualified Data.Sequence as Seq
-  ( empty )
+  ( empty, singleton )
 
 -- deepseq
 import Control.DeepSeq
@@ -158,11 +159,35 @@ data DocumentContent
   { unsavedChanges :: !Bool
   , latestChange   :: !Text
   , guides         :: !( Map Unique Guide )
-  , strokes        :: !( Seq Stroke )
+  , strokes        :: !( Seq StrokeHierarchy )
   }
   deriving stock    ( Show, Generic )
   deriving anyclass NFData
 
+-- | Hierarchy for groups of strokes.
+data StrokeHierarchy
+  = StrokeGroup 
+    { groupName     :: !Text
+    , groupVisible  :: !Bool
+    , groupContents :: !( Seq StrokeHierarchy )
+    }
+  | StrokeLeaf
+    { strokeLeaf :: !Stroke }
+  deriving stock    ( Show, Generic )
+  deriving anyclass NFData
+
+visibleStrokes :: StrokeHierarchy -> Seq Stroke
+visibleStrokes ( StrokeGroup { groupVisible, groupContents } )
+  | groupVisible
+  = foldMap visibleStrokes groupContents
+  | otherwise
+  = Empty
+visibleStrokes ( StrokeLeaf { strokeLeaf } )
+  | strokeVisible strokeLeaf
+  = Seq.singleton strokeLeaf
+  | otherwise
+  = Empty
+
 type StrokeSpline clo brushParams =
   Spline clo ( CachedStroke RealWorld ) ( PointData brushParams )
 

src/app/MetaBrush/Document/Draw.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE NamedFieldPuns        #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeApplications      #-}
 
@@ -16,8 +17,12 @@ module MetaBrush.Document.Draw
   where
 
 -- base
+import Data.Coerce
+  ( coerce )
 import Data.Functor
   ( ($>) )
+import Data.Semigroup
+  ( First(..) ) 
 
 -- acts
 import Data.Act
@@ -26,8 +31,6 @@ import Data.Act
 -- containers
 import Data.Sequence
   ( Seq(..) )
-import qualified Data.Sequence as Seq
-  ( filter, lookup )
 
 -- deepseq
 import Control.DeepSeq
@@ -78,7 +81,8 @@ import MetaBrush.Assert
 import MetaBrush.Brush
   ( BrushAdaptedTo )
 import MetaBrush.Document
-  ( Document(..), DocumentContent(..), Stroke(..), StrokeSpline
+  ( Document(..), DocumentContent(..)
+  , Stroke(..), StrokeHierarchy(..), StrokeSpline
   , FocusState(..), PointData(..)
   , _selection, _strokeSpline
   , coords, overStrokeSpline
@@ -118,7 +122,8 @@ getOrCreateDrawAnchor uniqueSupply c doc@( Document { zoomFactor } ) =
   case
       ( `runState` Nothing )
     $ ( field' @"documentContent" . field' @"strokes" . traverse )
-    updateStroke doc
+        updateStrokeHierarchy
+        doc
   of
     -- Anchor found: use it.
     ( newDoc, Just ( ( anchor, anchorPt ), anchorName ) ) ->
@@ -144,12 +149,19 @@ getOrCreateDrawAnchor uniqueSupply c doc@( Document { zoomFactor } ) =
         newDoc' :: Document
         newDoc'
           = over ( field' @"documentContent" . field' @"strokes" )
-              ( newStroke :<| )
+              ( StrokeLeaf newStroke :<| )
               newDoc
       pure ( newDoc', AnchorAtEnd uniq, c, Nothing )
   where
     -- Deselect all points, and try to find a valid anchor for drawing
     -- (a path start/end point at mouse click point).
+
+    updateStrokeHierarchy :: StrokeHierarchy -> State ( Maybe ( ( DrawAnchor, Point2D Double ), Text ) ) StrokeHierarchy
+    updateStrokeHierarchy ( StrokeGroup { .. } ) = do
+      newContents <- traverse updateStrokeHierarchy groupContents
+      pure ( StrokeGroup { groupContents = newContents, .. } )
+    updateStrokeHierarchy ( StrokeLeaf { strokeLeaf } ) = StrokeLeaf <$> updateStroke strokeLeaf
+
     updateStroke :: Stroke -> State ( Maybe ( ( DrawAnchor, Point2D Double ), Text ) ) Stroke
     updateStroke stroke@( Stroke { strokeName, strokeVisible, strokeUnique } ) = _strokeSpline updateStrokeSpline stroke
 
@@ -196,10 +208,19 @@ getOrCreateDrawAnchor uniqueSupply c doc@( Document { zoomFactor } ) =
               squaredNorm ( c --> p :: Vector2D Double ) < 16 / ( zoomFactor * zoomFactor )
 
 addToAnchor :: DrawAnchor -> StrokeSpline Open () -> Document -> Document
-addToAnchor anchor newSpline = over ( field' @"documentContent" . field' @"strokes" . mapped ) addToStroke
+addToAnchor anchor newSpline = over ( field' @"documentContent" . field' @"strokes" . mapped ) updateStrokeHierarchy
   where
-    addToStroke :: Stroke -> Stroke
+
-    addToStroke stroke@( Stroke { strokeUnique } )
+    updateStrokeHierarchy :: StrokeHierarchy -> StrokeHierarchy
+    updateStrokeHierarchy ( StrokeGroup { .. } ) =
+      let
+        newContents = fmap updateStrokeHierarchy groupContents
+      in
+        StrokeGroup { groupContents = newContents, .. }
+    updateStrokeHierarchy ( StrokeLeaf { strokeLeaf } ) = StrokeLeaf $ updateStroke strokeLeaf
+
+    updateStroke :: Stroke -> Stroke
+    updateStroke stroke@( Stroke { strokeUnique } )
       | strokeUnique == anchorStrokeUnique anchor
       = 
         let
@@ -244,8 +265,18 @@ withAnchorBrushData
      )
   -> r
 withAnchorBrushData anchor ( Document { documentContent = Content { strokes } } ) f =
-  splineAnchor . Seq.lookup 0 $ Seq.filter ( \ Stroke { strokeUnique } -> strokeUnique == anchorStrokeUnique anchor ) strokes
+  splineAnchor . coerce $ foldMap getFirstRelevantStroke strokes
   where
+
+    getFirstRelevantStroke :: StrokeHierarchy -> Maybe ( First Stroke )
+    getFirstRelevantStroke ( StrokeGroup { groupContents } ) =
+      foldMap getFirstRelevantStroke groupContents
+    getFirstRelevantStroke ( StrokeLeaf { strokeLeaf } )
+      | strokeUnique strokeLeaf == anchorStrokeUnique anchor
+      = Just ( First strokeLeaf )
+      | otherwise
+      = Nothing
+
     splineAnchor :: Maybe Stroke -> r
     splineAnchor ( Just ( Stroke { strokeSpline = strokeSpline :: StrokeSpline clo pointData, strokeBrush } ) )
       | SOpen <- ssplineType @clo

src/app/MetaBrush/Document/Selection.hs

@@ -10,6 +10,7 @@
 {-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE PatternSynonyms     #-}
+{-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
 {-# LANGUAGE ViewPatterns        #-}
@@ -116,7 +117,7 @@ import Math.Vector2D
 import {-# SOURCE #-} MetaBrush.Context
   ( Modifier(..) )
 import MetaBrush.Document
-  ( Document(..), Stroke(..)
+  ( Document(..), Stroke(..), StrokeHierarchy(..)
   , PointData(..), DiffPointData
   , FocusState(..), _selection
   , StrokeSpline, _strokeSpline, overStrokeSpline
@@ -158,8 +159,15 @@ selectionMode = foldMap \case
 -- | Updates the selected objects on a single click selection event.
 selectAt :: SelectionMode -> Point2D Double -> Document -> Document
 selectAt selMode c doc@( Document { zoomFactor } ) =
-  ( `evalState` False ) $ ( field' @"documentContent" . field' @"strokes" . traverse ) updateStroke doc
+  ( `evalState` False ) $ ( field' @"documentContent" . field' @"strokes" . traverse ) updateStrokeHierarchy doc
     where
+
+      updateStrokeHierarchy :: StrokeHierarchy -> State Bool StrokeHierarchy
+      updateStrokeHierarchy ( StrokeGroup { .. } ) = do
+        newContents <- traverse updateStrokeHierarchy groupContents
+        pure ( StrokeGroup { groupContents = newContents, .. } )
+      updateStrokeHierarchy ( StrokeLeaf { strokeLeaf } ) = StrokeLeaf <$> updateStroke strokeLeaf
+
       updateStroke :: Stroke -> State Bool Stroke
       updateStroke stroke@( Stroke { strokeVisible } ) = _strokeSpline updateSpline stroke
         where
@@ -222,7 +230,7 @@ dragMoveSelect c doc@( Document { zoomFactor } ) =
   let
     res :: WriterT ( Maybe DragMoveSelect ) ( Tardis ( Maybe DragMoveSelect ) ( Maybe DragMoveSelect ) ) Document
     res = do
-      newDoc <- ( field' @"documentContent" . field' @"strokes" . traverse ) updateStroke doc
+      newDoc <- ( field' @"documentContent" . field' @"strokes" . traverse ) updateStrokeHierarchy doc
       lift $ Tardis.getPast >>= Tardis.sendPast
       pure newDoc
   in case runIdentity . ( `Tardis.runTardisT` ( Nothing, Nothing ) ) . runWriterT $ res of
@@ -231,6 +239,12 @@ dragMoveSelect c doc@( Document { zoomFactor } ) =
     _ -> Nothing
 
   where
+    updateStrokeHierarchy :: StrokeHierarchy -> WriterT ( Maybe DragMoveSelect ) ( Tardis ( Maybe DragMoveSelect ) ( Maybe DragMoveSelect ) ) StrokeHierarchy
+    updateStrokeHierarchy ( StrokeGroup { .. } ) = do
+      newContents <- traverse updateStrokeHierarchy groupContents
+      pure ( StrokeGroup { groupContents = newContents, .. } )
+    updateStrokeHierarchy ( StrokeLeaf { strokeLeaf } ) = StrokeLeaf <$> updateStroke strokeLeaf
+
     updateStroke :: Stroke -> WriterT ( Maybe DragMoveSelect ) ( Tardis ( Maybe DragMoveSelect ) ( Maybe DragMoveSelect ) ) Stroke
     updateStroke stroke@( Stroke { strokeVisible, strokeUnique } ) = _strokeSpline updateSpline stroke
       where
@@ -374,11 +388,20 @@ dragMoveSelect c doc@( Document { zoomFactor } ) =
 selectRectangle :: SelectionMode -> Point2D Double -> Point2D Double -> Document -> Document
 selectRectangle selMode ( Point2D x0 y0 ) ( Point2D x1 y1 )
   = over ( field' @"documentContent" . field' @"strokes" . mapped )
-      updateStroke
+      updateStrokeHierarchy
     where
       xMin, xMax, yMin, yMax :: Double
       ( xMin, xMax ) = if x0 <= x1 then ( x0, x1 ) else ( x1, x0 )
       ( yMin, yMax ) = if y0 <= y1 then ( y0, y1 ) else ( y1, y0 )
+
+      updateStrokeHierarchy :: StrokeHierarchy -> StrokeHierarchy
+      updateStrokeHierarchy ( StrokeGroup { .. } ) =
+        let
+          newContents = fmap updateStrokeHierarchy groupContents
+        in
+          StrokeGroup { groupContents = newContents, .. }
+      updateStrokeHierarchy ( StrokeLeaf { strokeLeaf } ) = StrokeLeaf $ updateStroke strokeLeaf
+
       updateStroke :: Stroke -> Stroke
       updateStroke stroke@( Stroke { strokeVisible } ) =
           overStrokeSpline
@@ -415,8 +438,15 @@ data UpdateInfo
 -- Returns the updated document, together with info about how many points were translated.
 translateSelection :: Vector2D Double -> Document -> ( Document, UpdateInfo )
 translateSelection t doc =
-  ( `runState` mempty ) . ( `evalStateT` False ) $ ( field' @"documentContent" . field' @"strokes" . traverse ) updateStroke doc
+  ( `runState` mempty ) . ( `evalStateT` False ) $ ( field' @"documentContent" . field' @"strokes" . traverse ) updateStrokeHierarchy doc
   where
+
+    updateStrokeHierarchy :: StrokeHierarchy -> StateT Bool ( State UpdateInfo ) StrokeHierarchy
+    updateStrokeHierarchy ( StrokeGroup { .. } ) = do
+      newContents <- traverse updateStrokeHierarchy groupContents
+      pure ( StrokeGroup { groupContents = newContents, .. } )
+    updateStrokeHierarchy ( StrokeLeaf { strokeLeaf } ) = StrokeLeaf <$> updateStroke strokeLeaf
+
     updateStroke :: Stroke -> StateT Bool ( State UpdateInfo ) Stroke
     updateStroke stroke@( Stroke { strokeVisible, strokeUnique } ) = _strokeSpline updateSpline stroke
       where
@@ -506,10 +536,17 @@ deleteSelected :: Document -> ( Document, UpdateInfo )
 deleteSelected doc =
   ( `runState` mempty ) $
     ( field' @"documentContent" . field' @"strokes" )
-      ( traverseMaybe updateStroke )
+      ( traverseMaybe updateStrokeHierarchy )
       doc
 
   where
+
+    updateStrokeHierarchy :: StrokeHierarchy -> State UpdateInfo ( Maybe StrokeHierarchy )
+    updateStrokeHierarchy ( StrokeGroup { .. } ) = do
+      newContents <- traverseMaybe updateStrokeHierarchy groupContents
+      pure ( Just $ StrokeGroup { groupContents = newContents, .. } )
+    updateStrokeHierarchy ( StrokeLeaf { strokeLeaf } ) = fmap StrokeLeaf <$> updateStroke strokeLeaf
+
     updateStroke :: Stroke -> State UpdateInfo ( Maybe Stroke )
     updateStroke stroke@( Stroke { strokeVisible, strokeUnique } ) = runMaybeT $ _strokeSpline updateSpline stroke
       where
@@ -664,7 +701,7 @@ dragUpdate _ p ( ClickedOnCurve { dragStrokeUnique, dragSegmentIndex, dragSegmen
   let
     ( newDocument, mbStrokeName ) =
      ( `runState` Nothing ) $
-       ( field' @"documentContent" . field' @"strokes" . traverse ) updateStroke doc
+       ( field' @"documentContent" . field' @"strokes" . traverse ) updateStrokeHierarchy doc
   in case mbStrokeName of
     Just name -> do
       let
@@ -673,6 +710,13 @@ dragUpdate _ p ( ClickedOnCurve { dragStrokeUnique, dragSegmentIndex, dragSegmen
       Just ( HistoryChange { newDocument, changeText } )
     _ -> Nothing
   where
+
+    updateStrokeHierarchy :: StrokeHierarchy -> State ( Maybe Text ) StrokeHierarchy
+    updateStrokeHierarchy ( StrokeGroup { .. } ) = do
+      newContents <- traverse updateStrokeHierarchy groupContents
+      pure ( StrokeGroup { groupContents = newContents, .. } )
+    updateStrokeHierarchy ( StrokeLeaf { strokeLeaf } ) = StrokeLeaf <$> updateStroke strokeLeaf
+    
     updateStroke :: Stroke -> State ( Maybe Text ) Stroke
     updateStroke stroke@( Stroke { strokeUnique, strokeName } )
       | strokeUnique /= dragStrokeUnique

src/app/MetaBrush/Document/Serialise.hs

@@ -181,7 +181,7 @@ import MetaBrush.Brush
   )
 import MetaBrush.Document
   ( Document(..), DocumentContent(..), Guide(..)
-  , Stroke(..), StrokeSpline
+  , Stroke(..), StrokeHierarchy(..), StrokeSpline
   , PointData(..), FocusState(..)
   )
 import MetaBrush.MetaParameter.AST
@@ -694,6 +694,33 @@ decodeStroke uniqueSupply = do
 
 
 
+encodeStrokeHierarchy :: Monad f => JSON.Encoder f StrokeHierarchy
+encodeStrokeHierarchy = JSON.Encoder.mapLikeObj \case
+  StrokeGroup { groupName, groupVisible, groupContents } ->
+      JSON.Encoder.atKey' "tag"      JSON.Encoder.text                        "group"
+    . JSON.Encoder.atKey' "name"     JSON.Encoder.text                        groupName
+    . JSON.Encoder.atKey' "visible"  JSON.Encoder.bool                        groupVisible
+    . JSON.Encoder.atKey' "contents" ( encodeSequence encodeStrokeHierarchy ) groupContents
+  StrokeLeaf { strokeLeaf } ->
+      JSON.Encoder.atKey' "tag"      JSON.Encoder.text                        "leaf"
+    . JSON.Encoder.atKey' "stroke"   encodeStroke                             strokeLeaf
+
+decodeStrokeHierarchy :: MonadIO m => UniqueSupply -> JSON.Decoder m StrokeHierarchy
+decodeStrokeHierarchy uniqueSupply = do
+  tag <- JSON.Decoder.atKey "tag" JSON.Decoder.text
+  case tag of
+    "group" -> do
+      groupName     <- JSON.Decoder.atKey "name"     JSON.Decoder.text
+      groupVisible  <- JSON.Decoder.atKey "visible"  JSON.Decoder.bool
+      groupContents <- JSON.Decoder.atKey "contents" ( decodeSequence $ decodeStrokeHierarchy uniqueSupply )
+      pure ( StrokeGroup { groupName, groupVisible, groupContents } )
+    "leaf"  -> do
+      strokeLeaf    <- JSON.Decoder.atKey "leaf"     ( decodeStroke uniqueSupply )
+      pure ( StrokeLeaf { strokeLeaf } )
+    _ -> throwError ( JSON.ParseFailed $ "Unsupported stroke hierarchy type with tag " <> tag )
+
+
+
 encodeGuide :: Applicative f => JSON.Encoder f Guide
 encodeGuide = JSON.Encoder.mapLikeObj \ ( Guide { guidePoint, guideNormal } ) ->
     JSON.Encoder.atKey' "point"  ( encoder @( Point2D  Double ) ) guidePoint
@@ -713,8 +740,8 @@ decodeGuide uniqueSupply = do
 
 encodeDocumentContent :: Applicative f => JSON.Encoder f DocumentContent
 encodeDocumentContent  = JSON.Encoder.mapLikeObj \ ( Content { guides, strokes } ) ->
-    JSON.Encoder.atKey' "guides"  ( encodeUniqueMap encodeGuide  ) guides
+    JSON.Encoder.atKey' "guides"  ( encodeUniqueMap encodeGuide           ) guides
-  . JSON.Encoder.atKey' "strokes" ( encodeSequence  encodeStroke ) strokes
+  . JSON.Encoder.atKey' "strokes" ( encodeSequence  encodeStrokeHierarchy ) strokes
 
 decodeDocumentContent :: MonadIO m => UniqueSupply -> JSON.Decoder m DocumentContent
 decodeDocumentContent uniqueSupply = do
@@ -723,8 +750,8 @@ decodeDocumentContent uniqueSupply = do
     unsavedChanges = False
     latestChange :: Text
     latestChange = "Load document"
-  strokes <- JSON.Decoder.atKey "strokes" ( decodeSequence  ( decodeStroke uniqueSupply ) )
+  strokes <- JSON.Decoder.atKey "strokes" ( decodeSequence  ( decodeStrokeHierarchy uniqueSupply ) )
-  guides  <- JSON.Decoder.atKey "guides"  ( decodeUniqueMap ( decodeGuide  uniqueSupply ) )
+  guides  <- JSON.Decoder.atKey "guides"  ( decodeUniqueMap ( decodeGuide           uniqueSupply ) )
   pure ( Content { unsavedChanges, latestChange, strokes, guides } )
 
 

src/app/MetaBrush/Document/SubdivideStroke.hs

@@ -60,7 +60,7 @@ import Math.Module
 import Math.Vector2D
   ( Point2D(..), Vector2D(..), Segment(..) )
 import MetaBrush.Document
-  ( Document(..), Stroke(..), StrokeSpline
+  ( Document(..), Stroke(..), StrokeHierarchy(..), StrokeSpline
   , PointData(..), DiffPointData(..)
   , coords, _strokeSpline
   )
@@ -78,10 +78,16 @@ subdivide c doc@( Document { zoomFactor } ) =
     ( updatedDoc, mbSubdivLoc ) =
       ( `runState` Nothing )
         $ ( field' @"documentContent" . field' @"strokes" . traverse )
-            updateStroke
+            updateStrokeHierarchy
             doc
   in ( updatedDoc , ) <$> mbSubdivLoc
   where
+    updateStrokeHierarchy :: StrokeHierarchy -> State ( Maybe Text ) StrokeHierarchy
+    updateStrokeHierarchy ( StrokeGroup { .. } ) = do
+      newContents <- traverse updateStrokeHierarchy groupContents
+      pure ( StrokeGroup { groupContents = newContents, .. } )
+    updateStrokeHierarchy ( StrokeLeaf { strokeLeaf } ) = StrokeLeaf <$> updateStroke strokeLeaf
+
     updateStroke :: Stroke -> State ( Maybe Text ) Stroke
     updateStroke stroke@( Stroke { strokeVisible, strokeName } ) = _strokeSpline updateSpline stroke
 

src/app/MetaBrush/Render/Document.hs

@@ -35,8 +35,6 @@ import Data.Functor.Compose
   ( Compose(..) )
 import Data.Int
   ( Int32 )
-import Data.Maybe
-  ( mapMaybe )
 import GHC.Exts
   ( Proxy#, proxy# )
 import GHC.Generics
@@ -114,7 +112,8 @@ import MetaBrush.Context
 import MetaBrush.Document
   ( Document(..), DocumentContent(..)
   , mkAABB
-  , Stroke(..), StrokeSpline
+  , Stroke(..), visibleStrokes
+  , StrokeSpline
   , FocusState(..)
   , HoverContext(..), Hoverable(..)
   , PointData(..)
@@ -190,8 +189,8 @@ getDocumentRender
                 afterDrag :: Maybe DocChange
                 afterDrag = dragUpdate p0 p1 dragAction alternateMode doc
             -> case afterDrag of
-                Just docUpdate -> strokes . documentContent $ newDocument docUpdate
+                Just docUpdate -> foldMap visibleStrokes . strokes . documentContent $ newDocument docUpdate
-                _              -> strokes content
+                _              -> foldMap visibleStrokes . strokes $ content
             | Just ( PartialPath p0 cp0 anchor firstPoint ) <- mbPartialPath
             , let
                 mbFinalPoint :: Maybe ( Point2D Double )
@@ -230,8 +229,8 @@ getDocumentRender
                       , strokeName     = "Preview stroke (temporary)"
                       , strokeBrush    = mbBrush
                       }
-              -> previewStroke :<| strokes content
+              -> previewStroke :<| foldMap visibleStrokes ( strokes content )
-          _ -> strokes content
+          _ -> foldMap visibleStrokes ( strokes content )
 
       strokesRenderData <- traverseMaybe ( sequenceA . strokeRenderData fitParams ) modifiedStrokes