metabrush/src/metabrushes/MetaBrush/Document.hs

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
    }