mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-06 07:13:37 +00:00
87 lines
1.9 KiB
Haskell
87 lines
1.9 KiB
Haskell
{-# 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
|
|
|
|
data Overlay
|
|
= SelectionRectangle !( Point2D Double ) !( Point2D Double )
|
|
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 )
|