{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeApplications #-} module MetaBrush.Document ( AABB(..) , Document(..), currentDocument , Stroke(..) , PointData(..), BrushPointData(..) , FocusState(..) , _selection, _brush ) 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' ) import Data.Generics.Product.Typed ( HasType(typed) ) -- 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 , brushShape :: Seq ( StrokePoint BrushPointData ) } deriving stock ( Show, Generic ) data BrushPointData = BrushPointData { brushPointState :: FocusState } deriving stock ( Show, Generic ) data FocusState = Normal | Hover | Selected deriving stock ( Show, Eq ) _selection :: HasType FocusState pt => Lens' ( StrokePoint pt ) FocusState _selection = field' @"pointData" . typed @FocusState _brush :: Lens' ( StrokePoint PointData ) ( Seq ( StrokePoint BrushPointData ) ) _brush = field' @"pointData" . field' @"brushShape" 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 )