From e2e4ae6bfee7e30546c6987cb1732b563e710e8b Mon Sep 17 00:00:00 2001 From: sheaf Date: Sat, 7 Sep 2024 11:28:07 +0200 Subject: [PATCH] UI: use GTK Window instead of MessageDialog --- src/app/MetaBrush/Action.hs | 129 ++++++++++++++++++++++-------------- 1 file changed, 80 insertions(+), 49 deletions(-) diff --git a/src/app/MetaBrush/Action.hs b/src/app/MetaBrush/Action.hs index 87d6b80..52b644b 100644 --- a/src/app/MetaBrush/Action.hs +++ b/src/app/MetaBrush/Action.hs @@ -1,5 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + module MetaBrush.Action where -- base @@ -9,8 +11,6 @@ import Control.Monad.ST ( RealWorld ) import Data.Foldable ( for_ ) -import Data.Int - ( Int32 ) import Data.List ( uncons ) import Data.Maybe @@ -231,32 +231,47 @@ instance HandleAction OpenFile where for_ fileNames $ \ filePath -> do mbDoc <- loadDocument uniqueSupply filePath case mbDoc of - Left errMessage -> warningDialog window filePath errMessage + Left errMessage -> openFileWarningDialog window filePath errMessage Right doc -> do let newDocHist = newHistory doc newFileTab uiElts vars (Just newDocHist) tabLoc updateHistoryState uiElts (Just newDocHist) Nothing -> return () -warningDialog - :: ( Show errMess, GTK.IsWindow window ) - => window -> FilePath -> errMess -> IO () -warningDialog window filePath errMess = do - -- GTK 4 TODO: use Window - dialog <- GTK.new GTK.MessageDialog [] - GTK.setMessageDialogText dialog - ( "Could not load file at " <> Text.pack filePath <> ":\n" <> Text.pack ( show errMess ) ) - GTK.setMessageDialogMessageType dialog GTK.MessageTypeWarning - GTK.setWindowResizable dialog True - GTK.setWindowDecorated dialog False - GTK.windowSetTransientFor dialog ( Just window ) - GTK.windowSetModal dialog True - widgetAddClasses dialog [ "metabrush", "bg", "plain", "text", "dialog" ] - closeButton <- GTK.dialogAddButton dialog "OK" 1 +openFileWarningDialog + :: GTK.IsWindow window + => window -> FilePath -> String -> IO () +openFileWarningDialog window filePath errMess = do + + dialogWindow <- GTK.windowNew + GTK.setWindowDecorated dialogWindow False + GTK.windowSetTransientFor dialogWindow (Just window) + + contentBox <- GTK.boxNew GTK.OrientationVertical 30 + GTK.widgetSetMarginStart contentBox 20 + GTK.widgetSetMarginEnd contentBox 20 + GTK.widgetSetMarginTop contentBox 20 + GTK.widgetSetMarginBottom contentBox 20 + + label <- GTK.labelNew $ Just $ "Could not load file at " <> Text.pack filePath <> ":\n" <> Text.pack errMess + GTK.boxAppend contentBox label + + closeButton <- GTK.buttonNew + GTK.buttonSetLabel closeButton "OK" + GTK.boxAppend contentBox closeButton + + GTK.windowSetChild dialogWindow (Just contentBox) + + widgetAddClasses dialogWindow ["metabrush", "bg", "plain", "text", "dialog"] widgetAddClass closeButton "dialogButton" - widgetShow dialog - void $ GTK.afterDialogResponse dialog \ _ -> do - GTK.windowDestroy dialog + + void $ GTK.onButtonClicked closeButton $ do + GTK.windowDestroy dialogWindow + + GTK.widgetSetVisible dialogWindow True + + -- TODO: make the dialog draggable. + -- See https://discourse.gnome.org/t/enabling-window-dragging-on-specific-elements-in-gtk-4/5731/4 ----------------- -- Open folder -- @@ -286,7 +301,7 @@ instance HandleAction OpenFolder where for_ filePaths \ filePath -> when ( takeExtension filePath == ".mb" ) do mbDoc <- loadDocument uniqueSupply ( folderPath filePath ) case mbDoc of - Left errMessage -> warningDialog window filePath errMessage + Left errMessage -> openFileWarningDialog window filePath errMessage Right doc -> do let newDocHist :: DocumentHistory @@ -414,11 +429,6 @@ data Close { docToClose :: !Unique } deriving stock Show -pattern JustClose, SaveAndClose, CancelClose :: Int32 -pattern JustClose = 1 -pattern SaveAndClose = 2 -pattern CancelClose = 3 - instance HandleAction Close where handleAction uiElts@( UIElements {..} ) @@ -436,28 +446,49 @@ instance HandleAction Close where Just ( Document { displayName, documentUnique, documentContent }, isActiveDoc ) | unsavedChanges documentContent -> do - -- GTK 4 TODO: use Window - 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.windowSetTransientFor dialog ( Just window ) - GTK.windowSetModal dialog True - widgetAddClasses dialog [ "metabrush", "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 JustClose - for_ [ closeButton, saveButton, cancelButton ] - ( `widgetAddClass` "dialogButton" ) - widgetShow dialog - void $ GTK.onDialogResponse dialog \ choice -> do - case choice of - JustClose -> closeDocument isActiveDoc documentUnique - SaveAndClose -> save uiElts vars False - _ -> pure () - GTK.windowDestroy dialog + dialogWindow <- GTK.windowNew + GTK.setWindowDecorated dialogWindow False + GTK.windowSetTransientFor dialogWindow (Just window) + + contentBox <- GTK.boxNew GTK.OrientationVertical 30 + GTK.widgetSetMarginStart contentBox 20 + GTK.widgetSetMarginEnd contentBox 20 + GTK.widgetSetMarginTop contentBox 20 + GTK.widgetSetMarginBottom contentBox 20 + GTK.windowSetChild dialogWindow (Just contentBox) + + label <- GTK.labelNew $ Just $ "\n\"" <> displayName <> "\" contains unsaved changes.\nClose anyway?" + GTK.boxAppend contentBox label + + buttonBox <- GTK.boxNew GTK.OrientationHorizontal 0 + + GTK.boxAppend contentBox buttonBox + + closeButton <- GTK.buttonNew + GTK.buttonSetLabel closeButton "Close" + GTK.boxAppend buttonBox closeButton + saveCloseButton <- GTK.buttonNew + GTK.buttonSetLabel saveCloseButton "Save and close" + GTK.boxAppend buttonBox saveCloseButton + cancelButton <- GTK.buttonNew + GTK.buttonSetLabel cancelButton "Cancel" + GTK.boxAppend buttonBox cancelButton + + widgetAddClasses dialogWindow ["metabrush", "bg", "plain", "text", "dialog"] + for_ [closeButton, saveCloseButton, cancelButton] \ button -> + widgetAddClass button "dialogButton" + + void $ GTK.onButtonClicked closeButton $ do + closeDocument isActiveDoc documentUnique + GTK.windowDestroy dialogWindow + void $ GTK.onButtonClicked saveCloseButton $ do + save uiElts vars False + GTK.windowDestroy dialogWindow + void $ GTK.onButtonClicked cancelButton $ do + GTK.windowDestroy dialogWindow + + GTK.widgetSetVisible dialogWindow True + | otherwise -> closeDocument isActiveDoc documentUnique