mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-23 15:34:06 +00:00
closing documents / removing file tabs
This commit is contained in:
parent
5f3bbc891a
commit
341a8ed0ca
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
|
|
@ -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 --
|
||||
|
|
|
@ -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 } )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
||||
|
|
Loading…
Reference in a new issue