mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 23:03:38 +00:00
156 lines
4.5 KiB
Haskell
156 lines
4.5 KiB
Haskell
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
|