metabrush/src/app/MetaBrush/Context.hs

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

-- base
import Data.Int
  ( Int32 )
import Data.Word
  ( Word32 )

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

-- gi-cairo-render
import qualified GI.Cairo.Render as Cairo
  ( Render )

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

-- gi-gio
import qualified GI.Gio as GIO

-- 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.Linear
  ( ℝ(..) )
import {-# SOURCE #-} MetaBrush.Action
  ( ActionName )
import MetaBrush.Asset.Colours
  ( Colours )
import MetaBrush.Document.Draw
  ( DrawAnchor )
import MetaBrush.Document.History
  ( DocumentHistory(..) )
import MetaBrush.Document.Selection
  ( DragMoveSelect )
import {-# SOURCE #-} MetaBrush.UI.FileBar
  ( FileBar, FileBarTab )
import {-# SOURCE #-} MetaBrush.UI.InfoBar
  ( InfoBar )
import {-# SOURCE #-} MetaBrush.UI.ToolBar
  ( Tool, Mode )
import MetaBrush.UI.Viewport
  ( Viewport(..), Ruler(..) )
import MetaBrush.Unique
  ( UniqueSupply, Unique )

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

data UIElements
  = UIElements
  { application :: !GTK.Application
  , window      :: !GTK.ApplicationWindow
  , windowKeys  :: !GTK.EventControllerKey
  , titleBar    :: !GTK.HeaderBar
  , titleLabel  :: !GTK.Label
  , fileBar     :: !FileBar
  , viewport    :: !Viewport
  , infoBar     :: !InfoBar
  , menuBar     :: GTK.PopoverMenuBar -- needs to be lazy for RecursiveDo
  , menuActions :: !( HashMap ActionName GIO.SimpleAction )
  , colours     :: !Colours
  }

data Variables
  = Variables
  { uniqueSupply         :: !UniqueSupply
  , recomputeStrokesTVar :: !( STM.TVar Bool                                    )
  , documentRenderTVar   :: !( STM.TVar ( ( Int32, Int32 ) -> Cairo.Render () ) )
  , activeDocumentTVar   :: !( STM.TVar ( Maybe Unique )                        )
  , openDocumentsTVar    :: !( STM.TVar ( Map Unique DocumentHistory )          )
  , mousePosTVar         :: !( STM.TVar ( Maybe ( ℝ 2 ) )                       )
  , 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 FileBarTab )               )
  , 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 n = case fromIntegral n of
  GDK.KEY_Control_L -> Just ( Control L )
  GDK.KEY_Control_R -> Just ( Control R )
  GDK.KEY_Shift_L   -> Just ( Shift L )
  GDK.KEY_Shift_R   -> Just ( Shift R )
  GDK.KEY_Alt_L     -> Just ( Alt L )
  GDK.KEY_Alt_R     -> Just ( Alt R )
  _                 -> Nothing

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 :: !( ℝ 2 ) }
  | DragMoveHold  { holdStartPos :: !( ℝ 2 )
                  , dragAction   :: !DragMoveSelect
                  }
  | DrawHold      { holdStartPos :: !( ℝ 2 ) }
  | GuideAction   { holdStartPos :: !( ℝ 2 )
                  , guideAction  :: !GuideAction
                  }
  deriving stock Show

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