2020-08-10 22:07:09 +00:00
|
|
|
{-# LANGUAGE BlockArguments #-}
|
|
|
|
{-# LANGUAGE DerivingStrategies #-}
|
2020-08-10 14:38:27 +00:00
|
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
|
|
|
2020-08-04 06:15:06 +00:00
|
|
|
module MetaBrush.Document where
|
|
|
|
|
2020-08-10 22:07:09 +00:00
|
|
|
-- containers
|
|
|
|
import Data.IntMap.Strict
|
|
|
|
( IntMap )
|
|
|
|
import qualified Data.IntMap.Strict as IntMap
|
|
|
|
( lookup )
|
|
|
|
|
2020-08-10 14:38:27 +00:00
|
|
|
-- text
|
|
|
|
import Data.Text
|
|
|
|
( Text )
|
|
|
|
|
2020-08-10 22:07:09 +00:00
|
|
|
-- stm
|
|
|
|
import qualified Control.Concurrent.STM as STM
|
|
|
|
( atomically )
|
|
|
|
import qualified Control.Concurrent.STM.TVar as STM
|
|
|
|
( TVar, readTVar )
|
|
|
|
|
2020-08-10 14:38:27 +00:00
|
|
|
-- MetaBrush
|
|
|
|
import Math.Vector2D
|
|
|
|
( Point2D )
|
|
|
|
|
2020-08-04 06:15:06 +00:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
2020-08-10 14:38:27 +00:00
|
|
|
data AABB
|
|
|
|
= AABB
|
|
|
|
{ topLeft :: !( Point2D Double )
|
|
|
|
, botRight :: !( Point2D Double )
|
|
|
|
}
|
|
|
|
deriving stock Show
|
|
|
|
|
2020-08-04 06:15:06 +00:00
|
|
|
data Document
|
|
|
|
= Document
|
|
|
|
{ displayName :: !Text
|
2020-08-10 14:38:27 +00:00
|
|
|
, filePath :: !( Maybe FilePath )
|
2020-08-04 06:15:06 +00:00
|
|
|
, unsavedChanges :: !Bool
|
2020-08-10 14:38:27 +00:00
|
|
|
, strokes :: ![ Stroke ]
|
|
|
|
, bounds :: !AABB
|
|
|
|
, viewportCenter :: !( Point2D Double )
|
|
|
|
, zoomFactor :: !Double
|
2020-08-04 06:15:06 +00:00
|
|
|
}
|
2020-08-10 14:38:27 +00:00
|
|
|
deriving stock Show
|
|
|
|
|
|
|
|
data Stroke
|
|
|
|
= Stroke
|
|
|
|
{ strokePoints :: ![ Point2D Double ] }
|
|
|
|
deriving stock Show
|
2020-08-10 22:07:09 +00:00
|
|
|
|
|
|
|
|
|
|
|
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 )
|