metabrush/src/app/MetaBrush/Context.hs

{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DerivingStrategies #-}

module MetaBrush.Context
  ( UIElements(..), Variables(..)
  , LR(..), Modifier(..), modifierKey, modifierType
  , HoldAction(..), GuideAction(..), PartialPath(..)
  )
  where

-- base
import Data.Word
  ( Word32 )

-- containers
import Data.Set
  ( Set )
import Data.Map.Strict
  ( Map )

-- gi-gtk
import qualified GI.Gdk as GDK

-- gi-gtk
import qualified GI.Gtk as GTK

-- stm
import qualified Control.Concurrent.STM.TVar as STM
  ( TVar )

-- unordered-containers
import Data.HashMap.Strict
  ( HashMap )

-- MetaBrush
import Math.Bezier.Cubic.Fit
  ( FitParameters )
import Math.Vector2D
  ( Point2D )
import MetaBrush.Asset.Colours
  ( Colours )
import MetaBrush.Brush
  ( Brush )
import MetaBrush.Document.Draw
  ( DrawAnchor )
import MetaBrush.Document.History
  ( DocumentHistory(..) )
import MetaBrush.Document.Selection
  ( DragMoveSelect )
import {-# SOURCE #-} MetaBrush.UI.FileBar
  ( FileBar )
import {-# SOURCE #-} MetaBrush.UI.InfoBar
  ( InfoBar )
import {-# SOURCE #-} MetaBrush.UI.Menu
  ( Menu, ResourceType(Object) )
import {-# SOURCE #-} MetaBrush.UI.ToolBar
  ( Tool, Mode )
import MetaBrush.UI.Viewport
  ( Viewport(..), Ruler(..) )
import MetaBrush.Unique
  ( UniqueSupply, Unique )

--------------------------------------------------------------------------------

data UIElements
  = UIElements
  { window   :: !GTK.Window
  , title    :: !GTK.Label
  , titleBar :: !GTK.Box
  , fileBar  :: !FileBar
  , viewport :: !Viewport
  , infoBar  :: !InfoBar
  , menu     :: Menu Object -- needs to be lazy for "recursive do"
  , colours  :: !Colours
  }

data Variables
  = Variables
  { uniqueSupply       :: !UniqueSupply
  , activeDocumentTVar :: !( STM.TVar ( Maybe Unique )                            )
  , openDocumentsTVar  :: !( STM.TVar ( Map Unique DocumentHistory )              )
  , brushesTVar        :: !( STM.TVar ( HashMap Brush Unique )                    )
  , mousePosTVar       :: !( STM.TVar ( Maybe ( Point2D Double ) )                )
  , mouseHoldTVar      :: !( STM.TVar ( Maybe HoldAction )                        )
  , modifiersTVar      :: !( STM.TVar ( Set Modifier )                            )
  , toolTVar           :: !( STM.TVar Tool                                        )
  , modeTVar           :: !( STM.TVar Mode                                        )
  , debugTVar          :: !( STM.TVar Bool                                        )
  , partialPathTVar    :: !( STM.TVar ( Maybe PartialPath )                       )
  , fileBarTabsTVar    :: !( STM.TVar ( Map Unique ( GTK.Box, GTK.RadioButton ) ) )
  , showGuidesTVar     :: !( STM.TVar Bool                                        )
  , maxHistorySizeTVar :: !( STM.TVar Int                                         )
  , fitParametersTVar  :: !( STM.TVar FitParameters                               )
  }

--------------------------------------------------------------------------------

data LR = L | R
  deriving stock ( Show, Eq, Ord )

data Modifier
  = Control LR
  | Alt     LR
  | Shift   LR
  deriving stock ( Show, Eq, Ord )

modifierKey :: Word32 -> Maybe Modifier
modifierKey GDK.KEY_Control_L = Just ( Control L )
modifierKey GDK.KEY_Control_R = Just ( Control R )
modifierKey GDK.KEY_Shift_L   = Just ( Shift L )
modifierKey GDK.KEY_Shift_R   = Just ( Shift R )
modifierKey GDK.KEY_Alt_L     = Just ( Alt L )
modifierKey GDK.KEY_Alt_R     = Just ( Alt R )
modifierKey _                 = Nothing

modifierType :: Modifier -> GDK.ModifierType
modifierType ( Control _ ) = GDK.ModifierTypeControlMask
modifierType ( Alt     _ ) = GDK.ModifierTypeMod1Mask
modifierType ( Shift   _ ) = GDK.ModifierTypeShiftMask


data GuideAction
  = CreateGuide !Ruler
  | MoveGuide   !Unique
  deriving stock Show

-- | Keep track of a mouse hold action:
--
--  - start a rectangular selection,
--  - move objects by dragging,
--  - draw a control point,
--  - create/modify a guide.
data HoldAction
  = SelectionHold { holdStartPos :: !( Point2D Double ) }
  | DragMoveHold  { holdStartPos :: !( Point2D Double )
                  , dragAction   :: !DragMoveSelect
                  }
  | DrawHold      { holdStartPos :: !( Point2D Double ) }
  | GuideAction   { holdStartPos :: !( Point2D Double )
                  , guideAction  :: !GuideAction        
                  }
  deriving stock Show

-- | Keep track of a path that is in the middle of being drawn.
data PartialPath
  = PartialPath
  { partialStartPos     :: !( Point2D Double )
  , partialControlPoint :: !( Maybe ( Point2D Double ) )
  , partialPathAnchor   :: !DrawAnchor
  , firstPoint          :: !Bool
  }
  deriving stock Show