metabrush/src/app/MetaBrush/Document.hs

{-# LANGUAGE BlockArguments        #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module MetaBrush.Document where

-- containers
import Data.IntMap.Strict
  ( IntMap )
import qualified Data.IntMap.Strict as IntMap
  ( lookup )

-- text
import Data.Text
  ( Text )

-- stm
import qualified Control.Concurrent.STM      as STM
  ( atomically )
import qualified Control.Concurrent.STM.TVar as STM
  ( TVar, readTVar )

-- MetaBrush
import Math.Vector2D
  ( Point2D )

--------------------------------------------------------------------------------

data AABB
  = AABB
  { topLeft  :: !( Point2D Double )
  , botRight :: !( Point2D Double )
  }
  deriving stock Show

data Document
  = Document
    { displayName    :: !Text
    , filePath       :: !( Maybe FilePath )
    , unsavedChanges :: !Bool
    , strokes        :: ![ Stroke ]
    , bounds         :: !AABB
    , viewportCenter :: !( Point2D Double )
    , zoomFactor     :: !Double
    }
  deriving stock Show

data Stroke
  = Stroke
  { strokePoints  :: ![ StrokePoint ]
  , strokeName    :: !Text
  , strokeVisible :: !Bool
  }
  deriving stock Show

data StrokePoint
  = StrokePoint
  { strokePoint :: !( Point2D Double )
  , pointType   :: !PointType
  , pointState  :: !FocusState
  }
  deriving stock Show

data PointType
  = PathPoint
  | ControlPoint
  deriving stock Show

data FocusState
  = Normal
  | Hover
  | Selected
  deriving stock Show

currentDocument :: STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document ) -> IO ( Maybe Document )
currentDocument activeDocumentTVar openDocumentsTVar = STM.atomically do
  mbActive <- STM.readTVar activeDocumentTVar
  case mbActive of
    Nothing -> pure Nothing
    Just i  -> do
      docs <- STM.readTVar openDocumentsTVar
      pure ( IntMap.lookup i docs )