{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeApplications #-} module MetaBrush.Document ( AABB(..) , Document(..), currentDocument , Stroke(..) , PointData(..), FocusState(..) , selection ) where -- containers import Data.IntMap.Strict ( IntMap ) import qualified Data.IntMap.Strict as IntMap ( lookup ) import Data.Sequence ( Seq ) import GHC.Generics ( Generic ) -- generic-lens import Data.Generics.Product.Fields ( field' ) -- lens import Control.Lens ( Lens' ) -- 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.Bezier.Stroke ( StrokePoint(..) ) 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 PointData ) ) , strokeName :: Text , strokeVisible :: !Bool , strokeUnique :: Unique } deriving stock ( Show, Generic ) data PointData = PointData { pointState :: FocusState , brush :: Seq ( StrokePoint () ) } deriving stock ( Show, Generic ) data FocusState = Normal | Hover | Selected deriving stock ( Show, Eq ) selection :: Lens' ( StrokePoint PointData ) FocusState selection = field' @"pointData" . field' @"pointState" 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 )