closing documents / removing file tabs

This commit is contained in:
sheaf 2020-09-03 05:57:08 +02:00
parent 5f3bbc891a
commit 341a8ed0ca
10 changed files with 162 additions and 40 deletions

View file

@ -146,6 +146,8 @@ executable MetaBrush
>= 2.0.27 && < 2.1
, gi-glib
>= 2.0.23 && < 2.1
, gi-gobject
^>= 2.0.24
, gi-gtk
>= 3.0.35 && < 3.1
, gi-cairo-render

View file

@ -116,15 +116,15 @@ testDocuments = uniqueMapFromList
, strokes = [ Stroke
{ strokeName = "Ellipse"
, strokeVisible = True
, strokeUnique = unsafeUnique 10
, strokePoints = ellipse 150 100 ( PointData Normal ( rect 30 6 $ BrushPointData Normal ) )
, strokeUnique = unsafeUnique 10
, strokePoints = ellipse 150 100 ( PointData Normal ( rect 30 6 $ BrushPointData Normal ) )
}
]
}
, Document
{ displayName = "Line"
, mbFilePath = Nothing
, unsavedChanges = True
, unsavedChanges = False
, viewportCenter = Point2D 0 0
, zoomFactor = 1
, documentUnique = unsafeUnique 1

View file

@ -95,7 +95,7 @@ tooltip {
border: 1px solid rgb(28,25,25);
}
.window {
.window, .dialog {
-GtkWidget-window-dragging: true;
}
@ -179,6 +179,30 @@ tooltip {
border-top: 2px solid rgb(41, 40, 40);
}
.dialog {
border: 1px solid black;
border-radius: 6px;
}
.dialogButton {
background-color: rgb(72,70,61);
border: 1px solid black;
border-radius: 4px;
margin: 6px;
padding: 2px 10px 2px 10px;
}
.dialogButton:hover {
border-color:rgb(212, 190, 152);
}
.dialogButton:active, .dialogButton:checked {
color: rgb(72,70,61);
border-color: black;
background-color: #eadfcc;
}
.menuBar {
padding-left: 4px;
}

View file

@ -7,6 +7,7 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
@ -18,8 +19,10 @@ import Control.Monad
( guard, when, unless, void )
import Data.Foldable
( for_ )
import Data.Int
( Int32 )
import Data.Maybe
( catMaybes, listToMaybe)
( catMaybes, listToMaybe )
import Data.Word
( Word32 )
@ -33,7 +36,7 @@ import Data.Act
-- containers
import qualified Data.Map as Map
( insert )
( lookup, insert, delete )
import Data.Sequence
( Seq(..) )
import qualified Data.Sequence as Seq
@ -93,10 +96,14 @@ import MetaBrush.UI.Coordinates
( toViewportCoordinates )
import MetaBrush.UI.InfoBar
( updateInfoBar )
import MetaBrush.UI.FileBar
( TabLocation(..), newFileTab )
import {-# SOURCE #-} MetaBrush.UI.FileBar
( TabLocation(..), newFileTab, removeFileTab )
import MetaBrush.UI.ToolBar
( Tool(..) )
import MetaBrush.Unique
( Unique )
import MetaBrush.Util
( widgetAddClass, widgetAddClasses )
--------------------------------------------------------------------------------
@ -193,7 +200,7 @@ instance HandleAction Save where
Nothing -> pure () -- could show a warning message
Just doc@( Document { mbFilePath, unsavedChanges } )
| Nothing <- mbFilePath
-> saveAs uiElts vars doc
-> saveAs uiElts vars True doc
| False <- unsavedChanges
-> pure ()
| Just filePath <- mbFilePath
@ -217,10 +224,10 @@ instance HandleAction SaveAs where
mbDoc <- STM.atomically $ currentDocument vars
case mbDoc of
Nothing -> pure () -- could show a warning message
Just doc -> saveAs uiElts vars doc
Just doc -> saveAs uiElts vars True doc
saveAs :: UIElements -> Variables -> Document -> IO ()
saveAs ( UIElements { window } ) ( Variables { openDocumentsTVar } ) doc = do
saveAs :: UIElements -> Variables -> Bool -> Document -> IO ()
saveAs ( UIElements { window, fileBar } ) vars@( Variables { openDocumentsTVar } ) keepOpen doc = do
fileChooser <-
GTK.fileChooserNativeNew ( Just "Save MetaBrush document..." ) ( Just window )
GTK.FileChooserActionSave
@ -244,22 +251,68 @@ saveAs ( UIElements { window } ) ( Variables { openDocumentsTVar } ) doc = do
| otherwise
= filePath <.> "mb"
saveDocument fullFilePath doc
STM.atomically $
STM.modifyTVar' openDocumentsTVar
( Map.insert ( documentUnique doc )
( doc { mbFilePath = Just fullFilePath, unsavedChanges = False } )
)
if keepOpen
then
STM.atomically $
STM.modifyTVar' openDocumentsTVar
( Map.insert ( documentUnique doc )
( doc { mbFilePath = Just fullFilePath, unsavedChanges = False } )
)
else removeFileTab fileBar vars ( documentUnique doc )
-----------
-- Close --
-----------
data Close = Close
deriving stock Show
data Close
= CloseActive -- ^ Close active document.
| CloseThis -- ^ Close a specific tab (action to destroy tab is directly given).
{ docToClose :: Unique
, destroyTabAction :: IO ()
}
instance Show Close where
show CloseActive = "CloseActive"
show ( CloseThis docToClose _ ) = "CloseThis " <> show docToClose
pattern JustClose, SaveAndClose, CancelClose :: Int32
pattern JustClose = 1
pattern SaveAndClose = 2
pattern CancelClose = 3
-- TODO
instance HandleAction Close where
handleAction _ _ _ = pure ()
handleAction uiElts@( UIElements { window, fileBar } ) vars@( Variables { .. } ) close = do
mbDoc <- case close of
CloseActive -> STM.atomically $ currentDocument vars
CloseThis unique _ -> Map.lookup unique <$> STM.readTVarIO openDocumentsTVar
case mbDoc of
Nothing -> pure () -- could show a warning message
Just doc@( Document { displayName, documentUnique } ) -> do
dialog <- GTK.new GTK.MessageDialog []
GTK.setMessageDialogText dialog ( " \n\"" <> displayName <> "\" contains unsaved changes.\nClose anyway?" )
GTK.setMessageDialogMessageType dialog GTK.MessageTypeQuestion
GTK.setWindowResizable dialog False
GTK.setWindowDecorated dialog False
GTK.widgetAddEvents dialog
[ GDK.EventMaskKeyPressMask, GDK.EventMaskKeyReleaseMask ]
GTK.windowSetTransientFor dialog ( Just window )
GTK.windowSetModal dialog True
widgetAddClasses dialog [ "bg", "plain", "text", "dialog" ]
closeButton <- GTK.dialogAddButton dialog "Close" JustClose
saveButton <- GTK.dialogAddButton dialog "Save and close" SaveAndClose
cancelButton <- GTK.dialogAddButton dialog "Cancel" CancelClose
GTK.dialogSetDefaultResponse dialog 1
for_ [ closeButton, saveButton, cancelButton ] \ button -> widgetAddClass button "dialogButton"
choice <- GTK.dialogRun dialog
GTK.widgetDestroy dialog
case choice of
JustClose -> case close of
CloseActive -> removeFileTab fileBar vars documentUnique
CloseThis _ destroyTab -> do
destroyTab
STM.atomically $ STM.modifyTVar' openDocumentsTVar ( Map.delete documentUnique )
SaveAndClose -> saveAs uiElts vars False doc
_ -> pure ()
--------------
-- Quitting --

View file

@ -91,7 +91,7 @@ getOrCreateDrawAnchor uniqueSupply c doc@( Document { zoomFactor } ) =
}
: )
newDoc
pure ( newDoc', AnchorAtEnd uniq, c )
pure ( newDoc' { unsavedChanges = True }, AnchorAtEnd uniq, c )
where
-- Deselect all points, and try to find a valid anchor for drawing
-- (a path start/end point at mouse click point).
@ -128,7 +128,7 @@ getOrCreateDrawAnchor uniqueSupply c doc@( Document { zoomFactor } ) =
squaredNorm ( c --> p :: Vector2D Double ) < 16 / ( zoomFactor * zoomFactor )
addToAnchor :: DrawAnchor -> Seq ( StrokePoint PointData ) -> Document -> Document
addToAnchor anchor newPts = over ( field' @"strokes" . mapped ) addToStroke
addToAnchor anchor newPts = set ( field' @"unsavedChanges" ) True . over ( field' @"strokes" . mapped ) addToStroke
where
addToStroke :: Stroke -> Stroke
addToStroke stroke@( Stroke { strokeUnique, strokePoints = pts } )

View file

@ -271,9 +271,11 @@ translateSelection mode t
| Brush <- mode
= over ( field' @"strokes" . mapped . field' @"strokePoints" . mapped . field' @"pointData" . field' @"brushShape" . mapped )
updateStrokePoint
. set ( field' @"unsavedChanges" ) True
| otherwise
= over ( field' @"strokes" . mapped . field' @"strokePoints" . mapped )
updateStrokePoint
. set ( field' @"unsavedChanges" ) True
where
updateStrokePoint :: HasType FocusState pt => StrokePoint pt -> StrokePoint pt
updateStrokePoint pt
@ -288,12 +290,14 @@ deleteSelected mode doc = fst . runIdentity . ( `Tardis.runTardisT` ( False, Fal
Brush ->
( field' @"strokes" . traverse . field' @"strokePoints" . traverse . field' @"pointData" . field' @"brushShape" )
updateStroke
doc
doc'
_ ->
( field' @"strokes" . traverse . field' @"strokePoints" )
updateStroke
doc
doc'
where
doc' :: Document
doc' = doc { unsavedChanges = True }
updateStroke
:: forall pt
. HasType FocusState pt

View file

@ -136,6 +136,7 @@ renderDocument
modifiedStrokes
| Just ( DragMoveHold p0 ) <- mbHoldEvent
, Just p1 <- mbMousePos
, p0 /= p1
= strokes $ translateSelection mode ( p0 --> p1 ) doc
| Just ( PartialPath p0 cp0 _ _ ) <- mbPartialPath
, let

View file

@ -6,22 +6,32 @@
{-# LANGUAGE TypeApplications #-}
module MetaBrush.UI.FileBar
( FileBar(..), createFileBar, newFileTab
( FileBar(..)
, createFileBar, newFileTab, removeFileTab
, TabLocation(..)
)
where
-- base
import Control.Monad
( void )
( unless, void, when )
import Data.Maybe
( listToMaybe )
import Data.Foldable
( for_ )
import qualified Foreign.Marshal.Alloc as Foreign
( malloc, free )
import qualified Foreign.Ptr as Foreign
( castPtr, nullPtr )
import qualified Foreign.Storable as Foreign
( peek, poke )
-- containers
import qualified Data.Map.Strict as Map
( lookup, insert )
( lookup, insert, delete )
-- gi-gobject
import qualified GI.GObject as GObject
-- gi-gtk
import qualified GI.Gtk as GTK
@ -37,6 +47,8 @@ import Data.Text
( Text )
-- MetaBrush
import MetaBrush.Action
( Close(..), handleAction )
import MetaBrush.Context
( UIElements(..), Variables(..) )
import MetaBrush.Document
@ -72,7 +84,7 @@ newFileTab
-> IO ()
newFileTab
vars@( Variables { uniqueSupply, activeDocumentTVar, openDocumentsTVar } )
( UIElements { fileBar = FileBar {..}, .. } )
uiElts@( UIElements { fileBar = FileBar {..}, .. } )
mbDoc
newTabLoc
= do
@ -99,9 +111,18 @@ newFileTab
GTK.boxPackStart tab closeFileButton False False 0
widgetAddClasses pgButton [ "fileBarTabButton" ]
widgetAddClasses closeFileButton [ "fileBarCloseButton" ]
GTK.widgetShowAll tab
-- Associate each tab with the corresponding document unique,
-- so we can know which document corresponds to each file tab
-- by only looking at the tab.
let
newUnique :: Unique
newUnique = documentUnique newDoc
uniquePtr <- Foreign.malloc @Unique
Foreign.poke uniquePtr newUnique
GObject.objectSetData tab "unique" ( Foreign.castPtr @Unique @() uniquePtr )
-- We've placed the new tab at the end. Now rearrange it if needed.
case newTabLoc of
LastTab -> pure ()
@ -134,9 +155,7 @@ newFileTab
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 )
@ -171,14 +190,14 @@ newFileTab
GTK.labelSetText title "MetaBrush"
GTK.setWindowTitle window "MetaBrush"
--void $ GTK.onButtonClicked closeFileButton
-- ( STM.atomically $ signalAction actionTQueue Close )
--void $ GTK.onButtonClicked closeFileButton ... ... ...
void $ GTK.onButtonClicked closeFileButton
( handleAction uiElts vars
( CloseThis newUnique ( Foreign.free uniquePtr *> GTK.widgetDestroy tab ) )
)
GTK.toggleButtonSetActive pgButton True
-- | Add the file bar: tabs allowing selection of the active document.
-- | Create a file bar: tabs allowing selection of the active document.
--
-- Updates the active document when buttons are clicked.
createFileBar
@ -233,3 +252,17 @@ createFileBar
LastTab
pure fileBar
-- | Close a document: remove the corresponding file tab from the file bar.
removeFileTab :: FileBar -> Variables -> Unique -> IO ()
removeFileTab ( FileBar { fileTabsBox } ) ( Variables { openDocumentsTVar } ) docUnique = do
GTK.containerForeach fileTabsBox \ tab -> do
uniquePtr <- Foreign.castPtr @() @Unique <$> GObject.objectGetData tab "unique"
unless ( uniquePtr == Foreign.nullPtr ) do
tabUnique <- Foreign.peek uniquePtr
when ( docUnique == tabUnique ) do
Foreign.free uniquePtr
GTK.widgetDestroy tab
STM.atomically $ STM.modifyTVar' openDocumentsTVar ( Map.delete docUnique )

View file

@ -1,5 +1,6 @@
module MetaBrush.UI.FileBar
( FileBar(..), createFileBar, newFileTab
( FileBar(..)
, createFileBar, newFileTab, removeFileTab
, TabLocation(..)
)
where
@ -14,6 +15,8 @@ import MetaBrush.Document
( Document )
import {-# SOURCE #-} MetaBrush.UI.InfoBar
( InfoBar )
import MetaBrush.Unique
( Unique )
--------------------------------------------------------------------------------
@ -36,3 +39,5 @@ createFileBar
-> IO FileBar
newFileTab :: Variables -> UIElements -> Maybe Document -> TabLocation -> IO ()
removeFileTab :: FileBar -> Variables -> Unique -> IO ()

View file

@ -184,7 +184,7 @@ fileMenuDescription
, openFolder = MenuItemDescription "Open folder" [ "submenuItem" ] ( OpenFolder AfterCurrentTab ) ( Just ( GDK.KEY_O, [ Control L, Shift L ] ) ) NoSubresource
, save = MenuItemDescription "Save" [ "submenuItem" ] Save ( Just ( GDK.KEY_S, [ Control L ] ) ) NoSubresource
, saveAs = MenuItemDescription "Save as" [ "submenuItem" ] SaveAs ( Just ( GDK.KEY_S, [ Control L, Shift L ] ) ) NoSubresource
, close = MenuItemDescription "Close" [ "submenuItem" ] Close ( Just ( GDK.KEY_W, [ Control L ] ) ) NoSubresource
, close = MenuItemDescription "Close" [ "submenuItem" ] CloseActive ( Just ( GDK.KEY_W, [ Control L ] ) ) NoSubresource
, quit = MenuItemDescription "Quit" [ "submenuItem" ] Quit ( Just ( GDK.KEY_Q, [ Control L ] ) ) NoSubresource
}