metabrush/src/app/MetaBrush/Document.hs

126 lines
2.8 KiB
Haskell
Raw Normal View History

{-# LANGUAGE BlockArguments #-}
2020-08-19 21:34:43 +00:00
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DeriveGeneric #-}
2020-08-20 01:57:26 +00:00
{-# LANGUAGE FlexibleContexts #-}
2020-08-10 14:38:27 +00:00
{-# LANGUAGE MultiParamTypeClasses #-}
2020-08-19 21:34:43 +00:00
{-# LANGUAGE TypeApplications #-}
2020-08-10 14:38:27 +00:00
module MetaBrush.Document
( AABB(..)
, Document(..), emptyDocument
, Stroke(..), Guide(..)
2020-08-20 01:57:26 +00:00
, PointData(..), BrushPointData(..)
, FocusState(..)
, _selection, _brush
)
where
2020-08-04 06:15:06 +00:00
2020-09-01 19:56:59 +00:00
-- base
import GHC.Generics
( Generic )
-- containers
import Data.Map.Strict
( Map )
import qualified Data.Map.Strict as Map
( empty )
2020-08-16 22:09:16 +00:00
import Data.Sequence
( Seq )
2020-08-19 21:34:43 +00:00
-- generic-lens
import Data.Generics.Product.Fields
( field' )
2020-08-20 01:57:26 +00:00
import Data.Generics.Product.Typed
( HasType(typed) )
2020-08-19 21:34:43 +00:00
-- lens
import Control.Lens
( Lens' )
2020-08-10 14:38:27 +00:00
-- text
import Data.Text
( Text )
-- MetaBrush
2020-08-19 21:34:43 +00:00
import Math.Bezier.Stroke
( StrokePoint(..) )
2020-08-10 14:38:27 +00:00
import Math.Vector2D
( Point2D(..), Vector2D(..) )
2020-08-16 22:09:16 +00:00
import MetaBrush.Unique
( Unique )
2020-08-10 14:38:27 +00:00
2020-08-04 06:15:06 +00:00
--------------------------------------------------------------------------------
2020-08-10 14:38:27 +00:00
data AABB
= AABB
{ topLeft, botRight :: !( Point2D Double ) }
2020-08-10 14:38:27 +00:00
deriving stock Show
2020-08-04 06:15:06 +00:00
data Document
= Document
{ displayName :: !Text
, mbFilePath :: !( Maybe FilePath )
2020-08-04 06:15:06 +00:00
, unsavedChanges :: !Bool
2020-08-10 14:38:27 +00:00
, viewportCenter :: !( Point2D Double )
, zoomFactor :: !Double
, documentUnique :: Unique
, strokes :: ![ Stroke ]
, guides :: !( Map Unique Guide )
2020-08-04 06:15:06 +00:00
}
deriving stock ( Show, Generic )
2020-08-10 14:38:27 +00:00
data Stroke
= Stroke
{ strokeName :: Text
2020-08-13 17:05:19 +00:00
, strokeVisible :: !Bool
2020-08-16 22:09:16 +00:00
, strokeUnique :: Unique
, strokePoints :: !( Seq ( StrokePoint PointData ) )
2020-08-13 17:05:19 +00:00
}
deriving stock ( Show, Generic )
2020-08-13 17:05:19 +00:00
data Guide
= Guide
{ guidePoint :: !( Point2D Double ) -- ^ point on the guide line
, guideNormal :: !( Vector2D Double ) -- ^ /normalised/ normal vector of the guide
, guideUnique :: Unique
}
deriving stock ( Show, Generic )
2020-08-19 21:34:43 +00:00
data PointData
= PointData
{ pointState :: FocusState
2020-08-20 01:57:26 +00:00
, brushShape :: Seq ( StrokePoint BrushPointData )
2020-08-13 17:05:19 +00:00
}
deriving stock ( Show, Generic )
2020-08-20 01:57:26 +00:00
data BrushPointData
= BrushPointData
{ brushPointState :: FocusState }
deriving stock ( Show, Generic )
2020-08-13 17:05:19 +00:00
data FocusState
= Normal
| Hover
| Selected
2020-08-19 03:28:47 +00:00
deriving stock ( Show, Eq )
2020-08-20 01:57:26 +00:00
_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"
2020-08-19 21:34:43 +00:00
2020-09-01 19:56:59 +00:00
emptyDocument :: Text -> Unique -> Document
emptyDocument docName unique =
Document
{ displayName = docName
, mbFilePath = Nothing
, unsavedChanges = False
, viewportCenter = Point2D 0 0
, zoomFactor = 1
, documentUnique = unique
, strokes = []
, guides = Map.empty
2020-09-01 19:56:59 +00:00
}