hashirama/metabrush
1
0
Fork 0
mirror of https://gitlab.com/sheaf/metabrush.git synced 2024-11-23 15:34:06 +00:00
Code Issues Actions Projects Releases Wiki Activity

update file tabs dynamically

Browse source
This commit is contained in:
sheaf 2020-09-01 21:56:59 +02:00
parent 8a6b4f5391
commit 101d9515c0
23 changed files with 397 additions and 309 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
MetaBrush.cabal
View file

@ -109,9 +109,7 @@ executable MetaBrush
, MetaBrush.Document.Selection
, MetaBrush.Document.Serialise
, MetaBrush.Event
, MetaBrush.Event.KeyCodes
, MetaBrush.Render.Document
, MetaBrush.Render.Util
, MetaBrush.Time
, MetaBrush.UI.Coordinates
, MetaBrush.UI.FileBar
@ -121,6 +119,7 @@ executable MetaBrush
, MetaBrush.UI.ToolBar
, MetaBrush.UI.Viewport
, MetaBrush.Unique
, MetaBrush.Util
, Paths_MetaBrush
autogen-modules:

49
app/Main.hs
View file

@ -22,10 +22,8 @@ import System.Exit
( exitSuccess )
-- containers
import Data.IntMap.Strict
( IntMap )
import qualified Data.IntMap.Strict as IntMap
( fromList )
import Data.Map.Strict
( Map )
import Data.Sequence
( Seq(..) )
import qualified Data.Sequence as Seq
@ -65,7 +63,7 @@ import MetaBrush.Asset.Colours
import MetaBrush.Asset.Logo
( drawLogo )
import MetaBrush.Document
( Document(..), AABB(..), Stroke(..)
( Document(..), Stroke(..)
, FocusState(..)
, PointData(..), BrushPointData(..)
, currentDocument
@ -76,8 +74,6 @@ import MetaBrush.Event
)
import MetaBrush.Render.Document
( renderDocument )
import MetaBrush.Render.Util
( widgetAddClass, widgetAddClasses )
import MetaBrush.UI.FileBar
( createFileBar )
import MetaBrush.UI.InfoBar
@ -91,20 +87,23 @@ import MetaBrush.UI.ToolBar
import MetaBrush.UI.Viewport
( Viewport(..), createViewport )
import MetaBrush.Unique
( newUniqueSupply, unsafeUnique )
( newUniqueSupply
, Unique, unsafeUnique
, uniqueMapFromList
)
import MetaBrush.Util
( widgetAddClass, widgetAddClasses )
import qualified Paths_MetaBrush as Cabal
( getDataFileName )
--------------------------------------------------------------------------------
testDocuments :: IntMap Document
testDocuments = IntMap.fromList
$ zip [0..]
testDocuments :: Map Unique Document
testDocuments = uniqueMapFromList
[ Document
{ displayName = "Closed"
, mbFilePath = Nothing
, unsavedChanges = False
, bounds = AABB ( Point2D 0 0 ) ( Point2D 100 100 )
, viewportCenter = Point2D 50 50
, zoomFactor = 1
, documentUnique = unsafeUnique 0
@ -120,7 +119,6 @@ testDocuments = IntMap.fromList
{ displayName = "Line"
, mbFilePath = Nothing
, unsavedChanges = True
, bounds = AABB ( Point2D 0 0 ) ( Point2D 50 50 )
, viewportCenter = Point2D 0 0
, zoomFactor = 1
, documentUnique = unsafeUnique 1
@ -136,7 +134,6 @@ testDocuments = IntMap.fromList
{ displayName = "Short line"
, mbFilePath = Nothing
, unsavedChanges = False
, bounds = AABB ( Point2D 0 0 ) ( Point2D 50 50 )
, viewportCenter = Point2D 0 0
, zoomFactor = 1
, documentUnique = unsafeUnique 2
@ -176,8 +173,8 @@ main = do
-- Initialise state
uniqueSupply <- newUniqueSupply
activeDocumentTVar <- STM.newTVarIO @( Maybe Int ) Nothing
openDocumentsTVar <- STM.newTVarIO @( IntMap Document ) testDocuments
activeDocumentTVar <- STM.newTVarIO @( Maybe Unique ) Nothing
openDocumentsTVar <- STM.newTVarIO @( Map Unique Document ) testDocuments
mousePosTVar <- STM.newTVarIO @( Maybe ( Point2D Double ) ) Nothing
mouseHoldTVar <- STM.newTVarIO @( Maybe HoldEvent ) Nothing
pressedKeysTVar <- STM.newTVarIO @[ Word32 ] []
@ -248,14 +245,9 @@ main = do
GTK.panedPack1 mainPane mainView True False
GTK.panedPack2 mainPane panelBox False False
fileBar <- GTK.scrolledWindowNew ( Nothing @GTK.Adjustment ) ( Nothing @GTK.Adjustment )
viewportGrid <- GTK.gridNew
infoBar <- GTK.boxNew GTK.OrientationHorizontal 0
GTK.boxPackStart mainView fileBar False False 0
GTK.boxPackStart mainView viewportGrid True True 0
GTK.boxPackStart mainView infoBar False False 0
---------------------------------------------------------
-- Background
@ -327,15 +319,14 @@ main = do
---------------------------------------------------------
-- File bar
_ <-
fileBar <-
createFileBar
activeDocumentTVar
openDocumentsTVar
window
title
viewportDrawingArea
infoBarElements
fileBar
uniqueSupply activeDocumentTVar openDocumentsTVar
window title viewportDrawingArea infoBarElements
GTK.boxPackStart mainView fileBar False False 0
GTK.boxPackStart mainView viewportGrid True True 0
GTK.boxPackStart mainView infoBar False False 0
---------------------------------------------------------
-- Panels

21
assets/theme.css
View file

@ -320,7 +320,7 @@ tooltip {
}
.fileBarCloseButton {
padding-left: 5px;
padding-left: 1px;
padding-right: 5px;
margin: 0px;
color: rgba(212, 190, 152,0.2);
@ -330,6 +330,25 @@ tooltip {
color: rgba(213,19,36,0.9);
}
.newFileButton {
color: rgb(72,70,61);
font-size: 16px;
font-weight: bold;
font-family: "Sans";
padding: 0px 5px 0px 4px;
margin: 3px 0px 3px 0px;
border-left: 1px solid rgb(41, 40, 40);
}
.newFileButton:hover, .newFileButton:active, .newFileButton:checked {
color: rgb(160,225,54);
}
.newFileButton:active, .newFileButton:checked {
border-color: rgb(160,225,54);
}
/* Panels */
.panels {
min-width: 120px;

2
src/app/MetaBrush/Asset/Cursor.hs
View file

@ -10,7 +10,7 @@ import qualified GI.Cairo.Render as Cairo
-- MetaBrush
import MetaBrush.Asset.Colours
( ColourRecord(..), Colours )
import MetaBrush.Render.Util
import MetaBrush.Util
( withRGBA )
--------------------------------------------------------------------------------

2
src/app/MetaBrush/Asset/InfoBar.hs
View file

@ -11,7 +11,7 @@ import qualified GI.Cairo.Render as Cairo
-- MetaBrush
import MetaBrush.Asset.Colours
( ColourRecord(..), Colours )
import MetaBrush.Render.Util
import MetaBrush.Util
( withRGBA )
--------------------------------------------------------------------------------

2
src/app/MetaBrush/Asset/Logo.hs
View file

@ -10,7 +10,7 @@ import qualified GI.Cairo.Render as Cairo
-- MetaBrush
import MetaBrush.Asset.Colours
( ColourRecord(..), Colours )
import MetaBrush.Render.Util
import MetaBrush.Util
( withRGBA )
--------------------------------------------------------------------------------

2
src/app/MetaBrush/Asset/TickBox.hs
View file

@ -11,7 +11,7 @@ import qualified GI.Cairo.Render as Cairo
-- MetaBrush
import MetaBrush.Asset.Colours
( ColourRecord(..), Colours )
import MetaBrush.Render.Util
import MetaBrush.Util
( withRGBA )
--------------------------------------------------------------------------------

2
src/app/MetaBrush/Asset/Tools.hs
View file

@ -11,7 +11,7 @@ import qualified GI.Cairo.Render as Cairo
-- MetaBrush
import MetaBrush.Asset.Colours
( ColourRecord(..), Colours )
import MetaBrush.Render.Util
import MetaBrush.Util
( withRGBA )
--------------------------------------------------------------------------------

2
src/app/MetaBrush/Asset/WindowIcons.hs
View file

@ -10,7 +10,7 @@ import qualified GI.Cairo.Render as Cairo
-- MetaBrush
import MetaBrush.Asset.Colours
( ColourRecord(..), Colours )
import MetaBrush.Render.Util
import MetaBrush.Util
( withRGBA )
--------------------------------------------------------------------------------

35
src/app/MetaBrush/Document.hs
View file

@ -8,7 +8,7 @@
module MetaBrush.Document
( AABB(..)
, Document(..), currentDocument
, Document(..), emptyDocument, currentDocument
, Stroke(..)
, PointData(..), BrushPointData(..)
, FocusState(..)
@ -16,15 +16,17 @@ module MetaBrush.Document
)
where
-- base
import GHC.Generics
( Generic )
-- containers
import Data.IntMap.Strict
( IntMap )
import qualified Data.IntMap.Strict as IntMap
import Data.Map.Strict
( Map )
import qualified Data.Map.Strict as Map
( lookup )
import Data.Sequence
( Seq )
import GHC.Generics
( Generic )
-- generic-lens
import Data.Generics.Product.Fields
@ -50,7 +52,7 @@ import qualified Control.Concurrent.STM.TVar as STM
import Math.Bezier.Stroke
( StrokePoint(..) )
import Math.Vector2D
( Point2D )
( Point2D(..) )
import MetaBrush.Unique
( Unique )
@ -66,7 +68,6 @@ data Document
{ displayName :: !Text
, mbFilePath :: !( Maybe FilePath )
, unsavedChanges :: !Bool
, bounds :: !AABB
, viewportCenter :: !( Point2D Double )
, zoomFactor :: !Double
, documentUnique :: Unique
@ -107,11 +108,23 @@ _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 :: STM.TVar ( Maybe Unique ) -> STM.TVar ( Map Unique Document ) -> IO ( Maybe Document )
currentDocument activeDocumentTVar openDocumentsTVar = STM.atomically do
mbActive <- STM.readTVar activeDocumentTVar
case mbActive of
Nothing -> pure Nothing
Just i -> do
Just unique -> do
docs <- STM.readTVar openDocumentsTVar
pure ( IntMap.lookup i docs )
pure ( Map.lookup unique docs )
emptyDocument :: Text -> Unique -> Document
emptyDocument docName unique =
Document
{ displayName = docName
, mbFilePath = Nothing
, unsavedChanges = False
, viewportCenter = Point2D 0 0
, zoomFactor = 1
, documentUnique = unique
, strokes = []
}

15
src/app/MetaBrush/Document/Selection.hs
View file

@ -42,6 +42,9 @@ import Data.Generics.Product.Fields
import Data.Generics.Product.Typed
( HasType )
-- gi-gdk
import qualified GI.Gdk.Constants as GDK
-- lens
import Control.Lens
( view, set, over, mapped )
@ -69,10 +72,6 @@ import MetaBrush.Document
( Document(..), Stroke(..)
, FocusState(..), _selection
)
import MetaBrush.Event.KeyCodes
( pattern Alt_L , pattern Alt_R
, pattern Shift_L, pattern Shift_R
)
import MetaBrush.UI.ToolBar
( Mode(..) )
@ -96,10 +95,10 @@ instance Monoid SelectionMode where
selectionMode :: [ Word32 ] -> SelectionMode
selectionMode = foldMap \case
Alt_L -> Subtract
Alt_R -> Subtract
Shift_L -> Add
Shift_R -> Add
GDK.KEY_Alt_L -> Subtract
GDK.KEY_Alt_R -> Subtract
GDK.KEY_Shift_L -> Add
GDK.KEY_Shift_R -> Add
_ -> New
-- | Updates the selected objects on a single click selection event.

47
src/app/MetaBrush/Document/Serialise.hs
View file

@ -15,12 +15,18 @@ import Data.Foldable
( toList )
import Data.Functor.Contravariant
( contramap )
import Data.Functor.Identity
( Identity(..) )
import Unsafe.Coerce
( unsafeCoerce ) -- Tony Morris special
-- bytestring
import qualified Data.ByteString as Strict
( ByteString )
import qualified Data.ByteString.Lazy as Lazy
( ByteString )
import qualified Data.ByteString.Lazy.Builder as Lazy.ByteString.Builder
( toLazyByteString )
-- containers
import Data.Sequence
@ -58,18 +64,29 @@ import qualified Waargonaut.Decode as JSON.Decoder
import qualified Waargonaut.Encode as JSON
( Encoder, Encoder' )
import qualified Waargonaut.Encode as JSON.Encoder
( simplePureEncodeByteString
( runEncoder
, atKey', bool, list, mapLikeObj, scientific, text
)
import qualified Waargonaut.Encode.Builder as JSON.Builder
( waargonautBuilder, bsBuilder )
import qualified Waargonaut.Encode.Builder.Whitespace as JSON.Builder
( wsBuilder )
import Waargonaut.Prettier
( NumSpaces(..), IndentStep(..) )
import qualified Waargonaut.Prettier as Inline
( InlineOption(..) )
import qualified Waargonaut.Prettier as JSON
( prettyJson )
import qualified Waargonaut.Prettier as TonyMorris
( Natural )
-- MetaBrush
import Math.Bezier.Stroke
( StrokePoint(..) )
import Math.Vector2D
( Point2D(..) ) --, Vector2D(..), Mat22(..) )
( Point2D(..) )
import MetaBrush.Document
( Document(..)
, AABB(..)
, Stroke(..)
, PointData(..)
, BrushPointData(..)
@ -80,9 +97,21 @@ import MetaBrush.Unique
--------------------------------------------------------------------------------
-- | Serialise a document to JSON (in the form of a lazy bytestring).
documentToJSON :: Document -> Lazy.ByteString
documentToJSON = JSON.Encoder.simplePureEncodeByteString encodeDocument
documentToJSON
= runIdentity
. fmap
( Lazy.ByteString.Builder.toLazyByteString
. JSON.Builder.waargonautBuilder JSON.Builder.wsBuilder JSON.Builder.bsBuilder
. JSON.prettyJson Inline.Neither ( IndentStep four ) ( NumSpaces four )
)
. JSON.Encoder.runEncoder encodeDocument
where
four :: TonyMorris.Natural
four = unsafeCoerce ( 4 :: Integer )
-- | Parse a document from JSON (given by a strict bytestring).
documentFromJSON :: UniqueSupply -> Maybe FilePath -> Strict.ByteString -> IO ( Either JSON.DecodeError Document )
documentFromJSON uniqueSupply mfp
= fmap ( Bifunctor.first fst )
@ -130,7 +159,7 @@ decodeMat22 dec =
<*> JSON.Decoder.atKey "m01" dec
<*> JSON.Decoder.atKey "m10" dec
<*> JSON.Decoder.atKey "m11" dec
-}
encodeAABB :: Applicative f => JSON.Encoder f AABB
@ -149,7 +178,7 @@ decodeAABB = do
where
dec :: JSON.Decoder m ( Point2D Double )
dec = decodePoint2D decodeDouble
-}
encodeStrokePoint :: Applicative f => JSON.Encoder' d -> JSON.Encoder f ( StrokePoint d )
@ -242,9 +271,8 @@ decodeStroke uniqueSupply = do
encodeDocument :: Applicative f => JSON.Encoder f Document
encodeDocument = JSON.Encoder.mapLikeObj \ ( Document { displayName, bounds, viewportCenter, zoomFactor, strokes } ) ->
encodeDocument = JSON.Encoder.mapLikeObj \ ( Document { displayName, viewportCenter, zoomFactor, strokes } ) ->
JSON.Encoder.atKey' "name" JSON.Encoder.text displayName
. JSON.Encoder.atKey' "bounds" encodeAABB bounds
. JSON.Encoder.atKey' "center" ( encodePoint2D encodeDouble ) viewportCenter
. JSON.Encoder.atKey' "zoom" encodeDouble zoomFactor
. JSON.Encoder.atKey' "strokes" ( JSON.Encoder.list encodeStroke ) strokes
@ -255,9 +283,8 @@ decodeDocument uniqueSupply mbFilePath = do
let
unsavedChanges :: Bool
unsavedChanges = False
bounds <- JSON.Decoder.atKey "bounds" decodeAABB
viewportCenter <- JSON.Decoder.atKey "center" ( decodePoint2D decodeDouble )
zoomFactor <- JSON.Decoder.atKey "zoom" decodeDouble
documentUnique <- lift ( liftIO . STM.atomically $ freshUnique uniqueSupply )
strokes <- JSON.Decoder.atKey "strokes" ( JSON.Decoder.list ( decodeStroke uniqueSupply ) )
pure ( Document { displayName, mbFilePath, unsavedChanges, bounds, viewportCenter, zoomFactor, documentUnique, strokes } )
pure ( Document { displayName, mbFilePath, unsavedChanges, viewportCenter, zoomFactor, documentUnique, strokes } )

74
src/app/MetaBrush/Event.hs
View file

@ -30,9 +30,9 @@ import Data.Act
)
-- containers
import Data.IntMap.Strict
( IntMap )
import qualified Data.IntMap.Strict as IntMap
import Data.Map.Strict
( Map )
import qualified Data.Map.Strict as Map
( insert, lookup )
import Data.Sequence
( Seq(..) )
@ -68,12 +68,6 @@ import MetaBrush.Document.Selection
, dragMoveSelect, translateSelection
, deleteSelected
)
import MetaBrush.Event.KeyCodes
( pattern Escape, pattern Return, pattern Delete
, pattern Control_L, pattern Control_R
, pattern Shift_L , pattern Shift_R
, pattern F1
)
import MetaBrush.UI.Coordinates
( toViewportCoordinates )
import MetaBrush.UI.InfoBar
@ -81,13 +75,13 @@ import MetaBrush.UI.InfoBar
import MetaBrush.UI.ToolBar
( Tool(..), Mode )
import MetaBrush.Unique
( UniqueSupply )
( UniqueSupply, Unique )
--------------------------------------------------------------------------------
handleEvents
:: UniqueSupply
-> STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document )
-> STM.TVar ( Maybe Unique ) -> STM.TVar ( Map Unique Document )
-> STM.TVar ( Maybe ( Point2D Double ) ) -> STM.TVar ( Maybe HoldEvent ) -> STM.TVar [ Word32 ]
-> STM.TVar Tool -> STM.TVar Mode -> STM.TVar ( Maybe PartialPath )
-> GTK.Window -> GTK.DrawingArea -> InfoBar
@ -143,7 +137,7 @@ data PartialPath
-- Mouse events.
handleMotionEvent
:: STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document )
:: STM.TVar ( Maybe Unique ) -> STM.TVar ( Map Unique Document )
-> STM.TVar ( Maybe ( Point2D Double ) ) -> STM.TVar [ Word32 ]
-> STM.TVar Tool
-> STM.TVar ( Maybe PartialPath )
@ -162,7 +156,7 @@ handleMotionEvent
mbActiveDoc <- STM.readTVarIO activeDocumentTVar
for_ mbActiveDoc \ i -> do
docs <- STM.readTVarIO openDocumentsTVar
for_ ( IntMap.lookup i docs ) \ ( Document { .. } ) -> do
for_ ( Map.lookup i docs ) \ ( Document { .. } ) -> do
----------------------------------------------------------
-- Update mouse position in info bar on mouse move event.
@ -195,7 +189,7 @@ handleMotionEvent
mbPartialPath <- STM.readTVar partialPathTVar
case tool of
Pen
| any ( \ key -> key == Control_L || key == Control_R ) pressedKeys
| any ( \ key -> key == GDK.KEY_Control_L || key == GDK.KEY_Control_R ) pressedKeys
, Just pp <- mbPartialPath
-> STM.writeTVar partialPathTVar ( Just $ pp { partialControlPoint = Just pos } )
_ -> pure ()
@ -204,7 +198,7 @@ handleMotionEvent
pure True
handleScrollEvent
:: STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document )
:: STM.TVar ( Maybe Unique ) -> STM.TVar ( Map Unique Document )
-> STM.TVar ( Maybe ( Point2D Double ) ) -> STM.TVar ( Maybe HoldEvent ) -> STM.TVar [ Word32 ]
-> STM.TVar Tool
-> GTK.DrawingArea -> InfoBar
@ -229,7 +223,7 @@ handleScrollEvent
mbActiveDoc <- STM.readTVarIO activeDocumentTVar
for_ mbActiveDoc \ i -> do
docs <- STM.readTVarIO openDocumentsTVar
for_ ( IntMap.lookup i docs ) \ ( doc@( Document { viewportCenter = oldCenter, zoomFactor = oldZoomFactor } ) ) -> do
for_ ( Map.lookup i docs ) \ ( doc@( Document { viewportCenter = oldCenter, zoomFactor = oldZoomFactor } ) ) -> do
pressedKeys <- STM.readTVarIO pressedKeysTVar
let
toViewport :: Point2D Double -> Point2D Double
@ -240,7 +234,7 @@ handleScrollEvent
newDoc :: Document
newDoc
-- Zooming using 'Control'.
| any ( \ key -> key == Control_L || key == Control_R ) pressedKeys
| any ( \ key -> key == GDK.KEY_Control_L || key == GDK.KEY_Control_R ) pressedKeys
= let
newZoomFactor :: Double
newZoomFactor
@ -254,7 +248,7 @@ handleScrollEvent
• oldCenter
in doc { zoomFactor = newZoomFactor, viewportCenter = newCenter }
-- Vertical scrolling turned into horizontal scrolling using 'Shift'.
| dx == 0 && any ( \ key -> key == Shift_L || key == Shift_R ) pressedKeys
| dx == 0 && any ( \ key -> key == GDK.KEY_Shift_L || key == GDK.KEY_Shift_R ) pressedKeys
= let
newCenter :: Point2D Double
newCenter = ( ( 25 / oldZoomFactor ) *^ Vector2D dy 0 ) • oldCenter
@ -265,8 +259,8 @@ handleScrollEvent
newCenter :: Point2D Double
newCenter = ( ( 25 / oldZoomFactor ) *^ Vector2D dx dy ) • oldCenter
in doc { viewportCenter = newCenter }
docs' :: IntMap Document
docs' = IntMap.insert i newDoc docs
docs' :: Map Unique Document
docs' = Map.insert i newDoc docs
finalZoomFactor :: Double
finalZoomFactor = zoomFactor newDoc
finalCenter :: Point2D Double
@ -292,7 +286,7 @@ handleScrollEvent
handleMouseButtonEvent
:: UniqueSupply
-> STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document )
-> STM.TVar ( Maybe Unique ) -> STM.TVar ( Map Unique Document )
-> STM.TVar ( Maybe ( Point2D Double ) ) -> STM.TVar ( Maybe HoldEvent ) -> STM.TVar [ Word32 ]
-> STM.TVar Tool -> STM.TVar Mode -> STM.TVar ( Maybe PartialPath )
-> GTK.DrawingArea
@ -315,7 +309,7 @@ handleMouseButtonEvent
mbActiveDoc <- STM.readTVarIO activeDocumentTVar
for_ mbActiveDoc \ i -> do
docs <- STM.readTVarIO openDocumentsTVar
for_ ( IntMap.lookup i docs ) \ doc@( Document { zoomFactor, viewportCenter } ) -> do
for_ ( Map.lookup i docs ) \ doc@( Document { zoomFactor, viewportCenter } ) -> do
x <- GDK.getEventButtonX mouseClickEvent
y <- GDK.getEventButtonY mouseClickEvent
viewportWidth <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedWidth viewportDrawingArea
@ -346,8 +340,8 @@ handleMouseButtonEvent
| Just newDoc <- dragMoveSelect mode pos doc
-> do
let
newDocs :: IntMap Document
newDocs = IntMap.insert i newDoc docs
newDocs :: Map Unique Document
newDocs = Map.insert i newDoc docs
STM.writeTVar openDocumentsTVar newDocs
STM.writeTVar mouseHoldTVar ( Just $ DragMoveHold pos )
-- Rectangular selection.
@ -370,8 +364,8 @@ handleMouseButtonEvent
}
)
let
newDocs :: IntMap Document
newDocs = IntMap.insert i newDoc docs
newDocs :: Map Unique Document
newDocs = Map.insert i newDoc docs
STM.writeTVar openDocumentsTVar newDocs
-- Path already started: indicate that we are continuing a path.
Just pp ->
@ -391,7 +385,7 @@ handleMouseButtonEvent
handleMouseButtonRelease
:: UniqueSupply
-> STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document )
-> STM.TVar ( Maybe Unique ) -> STM.TVar ( Map Unique Document )
-> STM.TVar ( Maybe ( Point2D Double ) ) -> STM.TVar ( Maybe HoldEvent ) -> STM.TVar [ Word32 ]
-> STM.TVar Tool -> STM.TVar Mode -> STM.TVar ( Maybe PartialPath )
-> GTK.DrawingArea
@ -414,7 +408,7 @@ handleMouseButtonRelease
mbActiveDoc <- STM.readTVarIO activeDocumentTVar
for_ mbActiveDoc \ i -> do
docs <- STM.readTVarIO openDocumentsTVar
for_ ( IntMap.lookup i docs ) \ doc@( Document { zoomFactor, viewportCenter } ) -> do
for_ ( Map.lookup i docs ) \ doc@( Document { zoomFactor, viewportCenter } ) -> do
x <- GDK.getEventButtonX mouseReleaseEvent
y <- GDK.getEventButtonY mouseReleaseEvent
viewportWidth <- fromIntegral @_ @Double <$> GTK.widgetGetAllocatedWidth viewportDrawingArea
@ -524,8 +518,8 @@ handleMouseButtonRelease
pure ( addToAnchor anchor newSegment doc )
let
newDocs :: IntMap Document
newDocs = IntMap.insert i newDoc docs
newDocs :: Map Unique Document
newDocs = Map.insert i newDoc docs
STM.writeTVar openDocumentsTVar newDocs
GTK.widgetQueueDraw viewportDrawingArea
@ -538,7 +532,7 @@ handleMouseButtonRelease
-- Keyboard events.
handleKeyboardPressEvent
:: STM.TVar ( Maybe Int ) -> STM.TVar ( IntMap Document )
:: STM.TVar ( Maybe Unique ) -> STM.TVar ( Map Unique Document )
-> STM.TVar ( Maybe ( Point2D Double ) ) -> STM.TVar [ Word32 ]
-> STM.TVar Tool -> STM.TVar Mode -> STM.TVar ( Maybe PartialPath )
-> GTK.DrawingArea
@ -555,8 +549,8 @@ handleKeyboardPressEvent
pressedKeys <- STM.readTVar pressedKeysTVar
STM.writeTVar pressedKeysTVar ( keyCode : pressedKeys )
case keyCode of
Escape -> GTK.mainQuit
Return -> do
GDK.KEY_Escape -> GTK.mainQuit
GDK.KEY_Return -> do
tool <- STM.readTVarIO toolTVar
case tool of
-- End ongoing drawing on pressing enter key.
@ -564,7 +558,7 @@ handleKeyboardPressEvent
STM.atomically $ STM.writeTVar partialPathTVar Nothing
GTK.widgetQueueDraw viewportDrawingArea
_ -> pure ()
Delete -> do
GDK.KEY_Delete -> do
tool <- STM.readTVarIO toolTVar
mode <- STM.readTVarIO modeTVar
case tool of
@ -573,17 +567,17 @@ handleKeyboardPressEvent
mbActiveDoc <- STM.readTVarIO activeDocumentTVar
for_ mbActiveDoc \ i -> do
docs <- STM.readTVarIO openDocumentsTVar
for_ ( IntMap.lookup i docs ) \ doc -> do
for_ ( Map.lookup i docs ) \ doc -> do
let
newDoc :: Document
newDoc = deleteSelected mode doc
newDocs :: IntMap Document
newDocs = IntMap.insert i newDoc docs
newDocs :: Map Unique Document
newDocs = Map.insert i newDoc docs
STM.atomically $ STM.writeTVar openDocumentsTVar newDocs
GTK.widgetQueueDraw viewportDrawingArea
_ -> pure ()
ctrl
| ctrl == Control_L || ctrl == Control_R
| ctrl == GDK.KEY_Control_L || ctrl == GDK.KEY_Control_R
-> do
----------------------------------------------------------
-- With the pen tool, pressing control moves
@ -599,11 +593,11 @@ handleKeyboardPressEvent
STM.atomically $ STM.writeTVar partialPathTVar ( Just $ pp { partialControlPoint = Just mp } )
GTK.widgetQueueDraw viewportDrawingArea
_ -> pure ()
F1 -> do
GDK.KEY_F1 -> do
mbActiveDoc <- STM.readTVarIO activeDocumentTVar
for_ mbActiveDoc \ i -> do
docs <- STM.readTVarIO openDocumentsTVar
for_ ( IntMap.lookup i docs ) \ doc -> do
for_ ( Map.lookup i docs ) \ doc -> do
writeFile "log.txt" ( show doc <> "\n\n" )
_ -> pure ()
pure True

75
src/app/MetaBrush/Event/KeyCodes.hs
View file

@ -1,75 +0,0 @@
{-# LANGUAGE PatternSynonyms #-}
module MetaBrush.Event.KeyCodes where
-- base
import Data.Word
( Word32 )
--------------------------------------------------------------------------------
-- GDK keycodes.
pattern Escape :: Word32
pattern Escape = 0xff1b
pattern Delete :: Word32
pattern Delete = 0xffff
pattern BackSpace :: Word32
pattern BackSpace = 0xff08
pattern Tab :: Word32
pattern Tab = 0xff09
pattern Return :: Word32
pattern Return = 0xff0d
pattern Pause :: Word32
pattern Pause = 0xff13
pattern Left :: Word32
pattern Left = 0xff51
pattern Up :: Word32
pattern Up = 0xff52
pattern Right :: Word32
pattern Right = 0xff53
pattern Down :: Word32
pattern Down = 0xff54
pattern PageUp :: Word32
pattern PageUp = 0xff55
pattern Next :: Word32
pattern Next = 0xff56
pattern PageDown :: Word32
pattern PageDown = 0xff56
pattern End :: Word32
pattern End = 0xff57
pattern Shift_L :: Word32
pattern Shift_L = 0xffe1
pattern Shift_R :: Word32
pattern Shift_R = 0xffe2
pattern Control_L :: Word32
pattern Control_L = 0xffe3
pattern Control_R :: Word32
pattern Control_R = 0xffe4
pattern Alt_L :: Word32
pattern Alt_L = 0xffe9
pattern Alt_R :: Word32
pattern Alt_R = 0xffea
pattern F1 :: Word32
pattern F1 = 0xffbe
pattern F2 :: Word32
pattern F2 = 0xffbf
pattern F3 :: Word32
pattern F3 = 0xffc0
pattern F4 :: Word32
pattern F4 = 0xffc1
pattern F5 :: Word32
pattern F5 = 0xffc2
pattern F6 :: Word32
pattern F6 = 0xffc3
pattern F7 :: Word32
pattern F7 = 0xffc4
pattern F8 :: Word32
pattern F8 = 0xffc5
pattern F9 :: Word32
pattern F9 = 0xffc6
pattern F10 :: Word32
pattern F10 = 0xffc7
pattern F11 :: Word32
pattern F11 = 0xffc8
pattern F12 :: Word32
pattern F12 = 0xffc9

4
src/app/MetaBrush/Render/Document.hs
View file

@ -77,10 +77,10 @@ import MetaBrush.Document.Selection
( translateSelection )
import MetaBrush.Event
( HoldEvent(..), PartialPath(..) )
import MetaBrush.Render.Util
( withRGBA )
import MetaBrush.UI.ToolBar
( Mode(..) )
import MetaBrush.Util
( withRGBA )
--------------------------------------------------------------------------------

195
src/app/MetaBrush/UI/FileBar.hs
View file

@ -1,6 +1,5 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
@ -12,14 +11,16 @@ module MetaBrush.UI.FileBar
-- base
import Control.Monad
( void )
import Data.Maybe
( listToMaybe )
import Data.Foldable
( for_ )
-- containers
import Data.IntMap.Strict
( IntMap )
import qualified Data.IntMap.Strict as IntMap
( lookup, traverseWithKey )
import Data.Map.Strict
( Map )
import qualified Data.Map.Strict as Map
( lookup, insert )
-- gi-gtk
import qualified GI.Gtk as GTK
@ -28,7 +29,7 @@ import qualified GI.Gtk as GTK
import qualified Control.Concurrent.STM as STM
( atomically )
import qualified Control.Concurrent.STM.TVar as STM
( TVar, writeTVar, readTVarIO )
( TVar, writeTVar, readTVarIO, modifyTVar' )
-- text
import Data.Text
@ -38,68 +39,111 @@ import Data.Text
import Math.Vector2D
( Point2D(..) )
import MetaBrush.Document
( Document(..) )
import MetaBrush.Render.Util
( widgetAddClass, widgetAddClasses )
( Document(..), emptyDocument )
import MetaBrush.UI.Coordinates
( toViewportCoordinates )
import MetaBrush.UI.InfoBar
( InfoBar, InfoData(..), updateInfoBar )
import MetaBrush.Unique
( UniqueSupply, Unique, freshUnique, uniqueText )
import MetaBrush.Util
( widgetAddClass, widgetAddClasses
, (>>?=), Exists(..)
)
--------------------------------------------------------------------------------
-- | Add the file bar: tabs allowing selection of the active document.
--
-- Updates the active document when buttons are clicked.
createFileBar
:: STM.TVar ( Maybe Int )
-> STM.TVar ( IntMap Document )
-> GTK.Window
-> GTK.Label
-> GTK.DrawingArea
-> InfoBar
-> GTK.ScrolledWindow
-> IO ( IntMap GTK.RadioButton )
createFileBar activeDocumentTVar openDocumentsTVar window title viewportArea infoBar fileBar = do
data TabLocation
= AfterCurrentTab
| LastTab
deriving stock Show
widgetAddClass fileBar "fileBar"
newFileTab
:: UniqueSupply -> STM.TVar ( Maybe Unique ) -> STM.TVar ( Map Unique Document )
-> GTK.Window -> GTK.Label -> GTK.DrawingArea -> GTK.Box -> GTK.RadioButton -> InfoBar
-> Maybe Document
-> TabLocation
-> IO ()
newFileTab
uniqueSupply activeDocumentTVar openDocumentsTVar
window title viewportArea fileTabsBox fileBarPhantomRadioButton infoBar
mbDoc
newTabLoc
= do
fileTabs <- GTK.boxNew GTK.OrientationHorizontal 0
GTK.containerAdd fileBar fileTabs
widgetAddClasses fileTabs [ "fileBar", "plain", "text" ]
newDoc <- case mbDoc of
-- Use the provided document (e.g. document read from a file).
Just doc -> do
pure doc
-- Create a new empty document.
Nothing -> do
newDocUniq <- STM.atomically $ freshUnique uniqueSupply
pure ( emptyDocument ( "Untitled " <> uniqueText newDocUniq ) newDocUniq )
fileBarPhantomRadioButton <- GTK.radioButtonNew ( [] @GTK.RadioButton )
-- TODO: currently using static list of documents.
-- Need to dynamically update this widget as the user opens/closes documents.
documents <- STM.readTVarIO openDocumentsTVar
fileButtons <- ( `IntMap.traverseWithKey` documents ) \ i ( Document { displayName = currDisplayName } ) -> do
-- File tab elements.
pgButton <- GTK.radioButtonNewWithLabelFromWidget ( Just fileBarPhantomRadioButton ) currDisplayName
pgButton <- GTK.radioButtonNewWithLabelFromWidget ( Just fileBarPhantomRadioButton ) ( displayName newDoc )
GTK.toggleButtonSetMode pgButton False -- don't display radio indicator
closeFileButton <- GTK.buttonNewWithLabel "x"
-- Create box for file tab elements.
tab <- GTK.boxNew GTK.OrientationHorizontal 0
widgetAddClasses tab [ "fileBarTab" ]
GTK.boxPackStart fileTabs tab False False 0
GTK.boxPackStart fileTabsBox tab False False 0
GTK.boxPackStart tab pgButton True True 0
GTK.boxPackStart tab closeFileButton False False 0
widgetAddClasses pgButton [ "fileBarTabButton" ]
widgetAddClasses closeFileButton [ "fileBarCloseButton" ]
-- Make both file tab elements activate styling on the whole tab
-- (e.g. hovering over the close file button should highlight the whole tab).
GTK.widgetShowAll tab
-- We've placed the new tab at the end. Now rearrange it if needed.
case newTabLoc of
LastTab -> pure ()
AfterCurrentTab -> do
children <- GTK.containerGetChildren fileTabsBox
for_ ( zip children [0..] ) \ ( childWidget, activeTabIndex ) -> do
mbBox <- GTK.castTo GTK.Box childWidget
for_ mbBox \ box -> do
mbButton
<- ( listToMaybe <$> GTK.containerGetChildren box )
>>?= GTK.castTo GTK.RadioButton
for_ mbButton \ button -> do
isActive <- GTK.toggleButtonGetActive button
if isActive
then
GTK.boxReorderChild fileTabsBox tab ( activeTabIndex + 1 )
else
pure ()
-- Ensure consistency of hover/selection state between the two elements in the tab.
for_ @_ @_ @_ @() [ Exists @GTK.IsWidget pgButton, Exists @GTK.IsWidget closeFileButton ] \ ( Exists button ) -> do
void $ GTK.onWidgetEnterNotifyEvent button \ _ -> do
flags <- GTK.widgetGetStateFlags tab
GTK.widgetSetStateFlags tab ( GTK.StateFlagsPrelight : flags ) True
pure False
void $ GTK.onWidgetLeaveNotifyEvent button \ _ -> do
flags <- GTK.widgetGetStateFlags tab
GTK.widgetSetStateFlags tab ( filter ( /= GTK.StateFlagsPrelight ) flags ) True
pure False
-- Update the state: switch to this new document.
let
newUnique :: Unique
newUnique = documentUnique newDoc
STM.atomically do
STM.modifyTVar' openDocumentsTVar ( Map.insert newUnique newDoc )
STM.writeTVar activeDocumentTVar ( Just newUnique )
GTK.widgetQueueDraw viewportArea
void $ GTK.onButtonClicked pgButton do
isActive <- GTK.toggleButtonGetActive pgButton
flags <- GTK.widgetGetStateFlags tab
if isActive
then do
GTK.widgetSetStateFlags tab ( GTK.StateFlagsActive : flags ) True
STM.atomically ( STM.writeTVar activeDocumentTVar ( Just i ) )
GTK.widgetQueueDraw viewportArea
mbActiveDoc <- IntMap.lookup i <$> STM.readTVarIO openDocumentsTVar
STM.atomically ( STM.writeTVar activeDocumentTVar ( Just newUnique ) )
mbActiveDoc <- Map.lookup newUnique <$> STM.readTVarIO openDocumentsTVar
case mbActiveDoc of
Nothing -> do
GTK.labelSetText title "MetaBrush"
@ -128,35 +172,62 @@ createFileBar activeDocumentTVar openDocumentsTVar window title viewportArea inf
, botRightPos = toViewport ( Point2D viewportWidth viewportHeight )
}
updateInfoBar infoBar infoData
GTK.widgetQueueDraw viewportArea
else do
GTK.widgetSetStateFlags tab ( filter ( /= GTK.StateFlagsActive ) flags ) True
GTK.labelSetText title "MetaBrush"
GTK.setWindowTitle window "MetaBrush"
{-
void $ GTK.onButtonClicked closeFileButton do
closeFileDialog ...
-}
--void $ GTK.onButtonClicked closeFileButton ... ... ...
for_ @_ @_ @_ @() [ Exists @GTK.IsWidget pgButton, Exists @GTK.IsWidget closeFileButton ] \ ( Exists button ) -> do
void $ GTK.onWidgetEnterNotifyEvent button \ _ -> do
flags <- GTK.widgetGetStateFlags tab
GTK.widgetSetStateFlags tab ( GTK.StateFlagsPrelight : flags ) True
pure False
void $ GTK.onWidgetLeaveNotifyEvent button \ _ -> do
flags <- GTK.widgetGetStateFlags tab
GTK.widgetSetStateFlags tab ( filter ( /= GTK.StateFlagsPrelight ) flags ) True
pure False
GTK.toggleButtonSetActive pgButton True
pure pgButton
-- | Add the file bar: tabs allowing selection of the active document.
--
-- Updates the active document when buttons are clicked.
createFileBar
:: UniqueSupply -> STM.TVar ( Maybe Unique ) -> STM.TVar ( Map Unique Document )
-> GTK.Window -> GTK.Label -> GTK.DrawingArea -> InfoBar
-> IO GTK.Box
createFileBar
uniqueSupply activeDocumentTVar openDocumentsTVar
window title viewportArea infoBar
= do
GTK.scrolledWindowSetPolicy fileBar GTK.PolicyTypeAutomatic GTK.PolicyTypeNever
GTK.scrolledWindowSetOverlayScrolling fileBar True
-- Create file bar: box containing scrollable tabs, and a "+" button after it.
fileBar <- GTK.boxNew GTK.OrientationHorizontal 0
widgetAddClass fileBar "fileBar"
pure fileButtons
fileTabsScroll <- GTK.scrolledWindowNew ( Nothing @GTK.Adjustment ) ( Nothing @GTK.Adjustment )
GTK.scrolledWindowSetPolicy fileTabsScroll GTK.PolicyTypeAutomatic GTK.PolicyTypeNever
GTK.scrolledWindowSetOverlayScrolling fileTabsScroll True
---------------------------------------------------------
-- Util.
newFileButton <- GTK.buttonNewWithLabel "+"
widgetAddClasses newFileButton [ "newFileButton" ]
data Exists c where
Exists :: c a => a -> Exists c
GTK.boxPackStart fileBar fileTabsScroll True True 0
GTK.boxPackStart fileBar newFileButton False False 0
fileTabsBox <- GTK.boxNew GTK.OrientationHorizontal 0
GTK.containerAdd fileTabsScroll fileTabsBox
widgetAddClasses fileTabsBox [ "fileBar", "plain", "text" ]
-- Phantom radio button for when no page is selected (e.g. no documents opened yet).
fileBarPhantomRadioButton <- GTK.radioButtonNew ( [] @GTK.RadioButton )
documents <- STM.readTVarIO openDocumentsTVar
for_ documents \ doc ->
newFileTab
uniqueSupply activeDocumentTVar openDocumentsTVar
window title viewportArea fileTabsBox fileBarPhantomRadioButton infoBar
( Just doc )
LastTab
void $ GTK.onButtonClicked newFileButton do
newFileTab
uniqueSupply activeDocumentTVar openDocumentsTVar
window title viewportArea fileTabsBox fileBarPhantomRadioButton infoBar
Nothing
LastTab
pure fileBar

2
src/app/MetaBrush/UI/InfoBar.hs
View file

@ -44,7 +44,7 @@ import MetaBrush.Asset.Cursor
( drawCursorIcon )
import MetaBrush.Asset.InfoBar
( drawMagnifier, drawTopLeftCornerRect )
import MetaBrush.Render.Util
import MetaBrush.Util
( widgetAddClass, widgetAddClasses )
--------------------------------------------------------------------------------

2
src/app/MetaBrush/UI/Menu.hs
View file

@ -60,7 +60,7 @@ import MetaBrush.Asset.Colours
( Colours )
import MetaBrush.Asset.WindowIcons
( drawMinimise, drawRestoreDown, drawMaximise, drawClose )
import MetaBrush.Render.Util
import MetaBrush.Util
( widgetAddClass, widgetAddClasses )
--------------------------------------------------------------------------------

2
src/app/MetaBrush/UI/Panels.hs
View file

@ -15,7 +15,7 @@ import Data.Foldable
import qualified GI.Gtk as GTK
-- MetaBrush
import MetaBrush.Render.Util
import MetaBrush.Util
( widgetAddClass, widgetAddClasses )
--------------------------------------------------------------------------------

2
src/app/MetaBrush/UI/ToolBar.hs
View file

@ -36,7 +36,7 @@ import MetaBrush.Asset.Cursor
( drawCursorIcon )
import MetaBrush.Asset.Tools
( drawBrush, drawMeta, drawPath, drawPen )
import MetaBrush.Render.Util
import MetaBrush.Util
( widgetAddClass )
--------------------------------------------------------------------------------

2
src/app/MetaBrush/UI/Viewport.hs
View file

@ -13,7 +13,7 @@ import qualified GI.Gdk as GDK
import qualified GI.Gtk as GTK
-- MetaBrush
import MetaBrush.Render.Util
import MetaBrush.Util
( widgetAddClass )
--------------------------------------------------------------------------------

25
src/app/MetaBrush/Unique.hs
View file

@ -1,4 +1,5 @@
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
@ -7,14 +8,33 @@ module MetaBrush.Unique
( Unique, unsafeUnique
, freshUnique, uniqueText
, UniqueSupply, newUniqueSupply
, uniqueMapFromList
)
where
-- base
import Control.Arrow
( (&&&) )
import Data.Int
( Int64 )
import Data.Word
( Word32 )
import Foreign.Storable
( Storable )
-- containers
import Data.Map.Strict
( Map )
import qualified Data.Map.Strict as Map
( fromList )
-- generic-lens
import Data.Generics.Product.Typed
( HasType(typed) )
-- lens
import Control.Lens
( view )
-- stm
import Control.Concurrent.STM
@ -32,7 +52,7 @@ import qualified Data.Text as Text
newtype Unique = Unique { unique :: Int64 }
deriving stock Show
deriving newtype ( Eq, Ord )
deriving newtype ( Eq, Ord, Storable )
unsafeUnique :: Word32 -> Unique
unsafeUnique i = Unique ( - fromIntegral i - 1 )
@ -54,3 +74,6 @@ freshUnique ( UniqueSupply { uniqueSupplyTVar } ) = do
newUniqueSupply :: IO UniqueSupply
newUniqueSupply = UniqueSupply <$> STM.newTVarIO ( Unique 1 )
uniqueMapFromList :: HasType Unique a => [ a ] -> Map Unique a
uniqueMapFromList = Map.fromList . map ( view typed &&& id )

29
src/app/MetaBrush/Render/Util.hs → src/app/MetaBrush/Util.hs
View file

@ -1,13 +1,23 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module MetaBrush.Render.Util
module MetaBrush.Util
( withRGBA, showRGBA
, widgetAddClasses, widgetAddClass
, (>=?=>), (>>?=)
, Exists(..)
)
where
-- base
import Control.Monad
( (>=>) )
import Data.Coerce
( coerce )
import Data.Foldable
( for_ )
import GHC.Stack
@ -26,6 +36,8 @@ import Data.Text
-- transformers
import Control.Monad.IO.Class
( MonadIO )
import Control.Monad.Trans.Maybe
( MaybeT(..) )
--------------------------------------------------------------------------------
@ -48,3 +60,18 @@ widgetAddClasses widget classNames = do
widgetAddClass :: ( HasCallStack, GTK.IsWidget widget, MonadIO m ) => widget -> Text -> m ()
widgetAddClass widget className = GTK.widgetGetStyleContext widget >>= ( `GTK.styleContextAddClass` className )
--------------------------------------------------------------------------------
infixr 1 >=?=>
(>=?=>) :: forall m a b c. Monad m => ( a -> m ( Maybe b ) ) -> ( b -> m ( Maybe c ) ) -> ( a -> m ( Maybe c ) )
(>=?=>) = coerce ( (>=>) @( MaybeT m ) @a @b @c )
infixl 1 >>?=
(>>?=) :: forall m a b. Monad m => m ( Maybe a ) -> ( a -> m ( Maybe b ) ) -> m ( Maybe b )
(>>?=) = coerce ( (>>=) @( MaybeT m ) @a @b )
--------------------------------------------------------------------------------
data Exists c where
Exists :: c a => a -> Exists c