{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-} module MetaBrush.Document ( AABB(..) , Document(..), currentDocument , Stroke(..), StrokePoint(..), PointType(..) , FocusState(..) ) where -- containers import Data.IntMap.Strict ( IntMap ) import qualified Data.IntMap.Strict as IntMap ( lookup ) import Data.Sequence ( Seq ) import GHC.Generics ( Generic ) -- 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 ) import MetaBrush.Unique ( Unique ) -------------------------------------------------------------------------------- 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, Generic ) data Stroke = Stroke { strokePoints :: !( Seq StrokePoint ) , strokeName :: Text , strokeVisible :: !Bool , strokeUnique :: Unique } deriving stock ( Show, Generic ) data StrokePoint = StrokePoint { strokePoint :: !( Point2D Double ) , pointType :: !PointType , pointState :: FocusState -- needs to be lazy for drag selection code } deriving stock ( Show, Generic ) data PointType = PathPoint | ControlPoint deriving stock ( Show, Eq ) data FocusState = Normal | Hover | Selected deriving stock ( Show, Eq ) 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 )