mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 23:03:38 +00:00
146 lines
4.1 KiB
Haskell
146 lines
4.1 KiB
Haskell
module MetaBrush.Document where
|
||
|
||
-- base
|
||
import GHC.Generics
|
||
( Generic )
|
||
|
||
-- containers
|
||
import Data.Map.Strict
|
||
( Map )
|
||
import qualified Data.Map.Strict as Map
|
||
import Data.Set
|
||
( Set )
|
||
import qualified Data.Set as Set
|
||
|
||
-- deepseq
|
||
import Control.DeepSeq
|
||
( NFData(..) )
|
||
|
||
-- text
|
||
import Data.Text
|
||
( Text )
|
||
|
||
-- brush-strokes
|
||
import Math.Linear
|
||
( ℝ(..), T(..) )
|
||
|
||
-- MetaBrush
|
||
import MetaBrush.Layer
|
||
( LayerMetadata, emptyHierarchy )
|
||
import MetaBrush.Stroke
|
||
( StrokeHierarchy, PointIndex )
|
||
import MetaBrush.Unique
|
||
( Unique )
|
||
|
||
--------------------------------------------------------------------------------
|
||
|
||
-- | Document, together with some extra metadata.
|
||
data Document
|
||
= Document
|
||
{ documentContent :: !DocumentContent
|
||
-- ^ Main document content, which we keep track throughout history.
|
||
, documentMetadata :: !DocumentMetadata
|
||
-- ^ Metadata about the document, that we don't track throughout history.
|
||
}
|
||
deriving stock ( Show, Generic )
|
||
deriving anyclass NFData
|
||
|
||
newtype Zoom = Zoom { zoomFactor :: Double }
|
||
deriving stock ( Show, Eq, Ord )
|
||
deriving newtype NFData
|
||
|
||
-- | A collection of points, indexed first by the stroke they belong to
|
||
-- and then their position in that stroke.
|
||
newtype StrokePoints = StrokePoints { strokePoints :: Map Unique ( Set PointIndex ) }
|
||
deriving newtype ( Eq, Show, NFData )
|
||
-- Invariant: the sets are never empty.
|
||
|
||
instance Semigroup StrokePoints where
|
||
( StrokePoints pts1 ) <> ( StrokePoints pts2 ) =
|
||
StrokePoints ( Map.unionWith Set.union pts1 pts2 )
|
||
instance Monoid StrokePoints where
|
||
mempty = StrokePoints Map.empty
|
||
|
||
-- | Remove the second set of points from the first.
|
||
differenceStrokePoints :: StrokePoints -> StrokePoints -> StrokePoints
|
||
differenceStrokePoints ( StrokePoints pts1 ) ( StrokePoints pts2 ) =
|
||
StrokePoints $
|
||
Map.differenceWith remove pts1 pts2
|
||
where
|
||
remove :: Set PointIndex -> Set PointIndex -> Maybe ( Set PointIndex )
|
||
remove old new =
|
||
let new' = old Set.\\ new
|
||
in if null new'
|
||
then Nothing
|
||
else Just new'
|
||
|
||
noStrokePoints :: StrokePoints -> Bool
|
||
noStrokePoints ( StrokePoints pts ) = null pts
|
||
|
||
elemStrokePoint :: Unique -> PointIndex -> StrokePoints -> Bool
|
||
elemStrokePoint u i ( StrokePoints pts ) =
|
||
case Map.lookup u pts of
|
||
Nothing -> False
|
||
Just is -> Set.member i is
|
||
|
||
-- | Metadata about a document and its content, that we don't track through
|
||
-- history.
|
||
data DocumentMetadata =
|
||
Metadata
|
||
{ documentName :: !Text
|
||
, documentFilePath :: !( Maybe FilePath )
|
||
, viewportCenter :: !( ℝ 2 )
|
||
, documentZoom :: !Zoom
|
||
, documentGuides :: !( Map Unique Guide )
|
||
, layerMetadata :: !LayerMetadata
|
||
, selectedPoints :: !StrokePoints
|
||
}
|
||
deriving stock ( Show, Generic )
|
||
deriving anyclass NFData
|
||
|
||
-- | Main content of document (data which we keep track of throughout history).
|
||
data DocumentContent
|
||
= Content
|
||
{ unsavedChanges :: !Bool
|
||
-- ^ Whether this current content is unsaved.
|
||
, strokeHierarchy :: !StrokeHierarchy
|
||
-- ^ Hierarchical structure of layers and groups.
|
||
}
|
||
deriving stock ( Show, Generic )
|
||
deriving anyclass NFData
|
||
|
||
-- | A guide, i.e. a horizontal or vertical line used for alignment.
|
||
data Guide
|
||
= Guide
|
||
{ guidePoint :: !( ℝ 2 ) -- ^ point on the guide line
|
||
, guideNormal :: !( T ( ℝ 2 ) ) -- ^ /normalised/ normal vector of the guide
|
||
}
|
||
deriving stock ( Show, Generic )
|
||
deriving anyclass NFData
|
||
|
||
emptyDocument :: Text -> Document
|
||
emptyDocument docName =
|
||
Document
|
||
{ documentContent = emptyDocumentContent
|
||
, documentMetadata = emptyDocumentMetadata docName
|
||
}
|
||
|
||
emptyDocumentContent :: DocumentContent
|
||
emptyDocumentContent =
|
||
Content
|
||
{ strokeHierarchy = emptyHierarchy
|
||
, unsavedChanges = False
|
||
}
|
||
|
||
emptyDocumentMetadata :: Text -> DocumentMetadata
|
||
emptyDocumentMetadata docName =
|
||
Metadata
|
||
{ documentName = docName
|
||
, documentFilePath = Nothing
|
||
, viewportCenter = ℝ2 0 0
|
||
, documentZoom = Zoom { zoomFactor = 1 }
|
||
, documentGuides = Map.empty
|
||
, layerMetadata = mempty
|
||
, selectedPoints = mempty
|
||
}
|