hashirama/metabrush
1
0
Fork 0
mirror of https://gitlab.com/sheaf/metabrush.git synced 2024-11-05 14:53:37 +00:00
Code Issues Actions Projects Releases Wiki Activity

UI: use GTK4 FileDialog API

Browse source
This commit is contained in:
sheaf 2024-09-06 18:48:04 +02:00
parent bb9b381cb5
commit fc2f25cfa6
1 changed files with 60 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

91
src/app/MetaBrush/Action.hs
View file

@ -203,38 +203,40 @@ data OpenFile = OpenFile !TabLocation
instance HandleAction OpenFile where
handleAction uiElts@( UIElements {..} ) vars@( Variables {..} ) ( OpenFile tabLoc ) = do
-- GTK 4 TODO: use FileDialog
fileChooser <-
GTK.fileChooserNativeNew ( Just "Open MetaBrush document..." ) ( Just window )
GTK.FileChooserActionOpen
( Just "Open" )
( Just "Cancel" )
GTK.fileChooserSetSelectMultiple fileChooser True
GTK.fileChooserSetAction fileChooser GTK.FileChooserActionOpen
GTK.nativeDialogSetModal fileChooser True
fileDialog <- GTK.fileDialogNew
GTK.fileDialogSetTitle fileDialog "Open MetaBrush document..."
GTK.fileDialogSetModal fileDialog True
GTK.fileDialogSetAcceptLabel fileDialog (Just "Open")
fileFilter <- GTK.fileFilterNew
GTK.fileFilterSetName fileFilter (Just "MetaBrush document")
GTK.fileFilterAddPattern fileFilter "*.mb"
GTK.fileChooserAddFilter fileChooser fileFilter
GTK.nativeDialogShow fileChooser
void $ GTK.afterNativeDialogResponse fileChooser \ response -> do
when ( response == fromIntegral ( fromEnum GTK.ResponseTypeAccept ) ) do
files <- GTK.fileChooserGetFiles fileChooser
GTK.setFileDialogDefaultFilter fileDialog fileFilter
fileFilterType <- GTK.gvalueGType_ @(Maybe GTK.FileFilter)
filterList <- GIO.listStoreNew fileFilterType
void $ GIO.listStoreAppend filterList fileFilter
GTK.fileDialogSetFilters fileDialog (Just filterList)
GTK.fileDialogOpenMultiple fileDialog (Just window) (Nothing :: Maybe GIO.Cancellable) $
Just $ \ _ result -> do
response <- GTK.handleDialogError (\ _ _ -> return Nothing) $
GTK.fileDialogOpenMultipleFinish fileDialog result
case response of
Just files -> do
nbFiles <- GIO.listModelGetNItems files
fileNames <- catMaybes <$>
for [ ( 0 :: Int ) .. fromIntegral nbFiles - 1 ] \ i ->
GIO.listModelGetItem files ( fromIntegral i ) >>?=
( GI.castTo GIO.File >=?=> GIO.fileGetPath )
for_ fileNames \ filePath -> do
for_ fileNames $ \ filePath -> do
mbDoc <- loadDocument uniqueSupply filePath
case mbDoc of
Left errMessage -> warningDialog window filePath errMessage
Right doc -> do
let
newDocHist :: DocumentHistory
newDocHist = newHistory doc
let newDocHist = newHistory doc
newFileTab uiElts vars (Just newDocHist) tabLoc
updateHistoryState uiElts (Just newDocHist)
Nothing -> return ()
warningDialog
:: ( Show errMess, GTK.IsWindow window )
@ -265,18 +267,16 @@ data OpenFolder = OpenFolder !TabLocation
instance HandleAction OpenFolder where
handleAction uiElts@( UIElements {..} ) vars@( Variables {..} ) ( OpenFolder tabLoc ) = do
-- GTK 4 TODO: use FileDialog
fileChooser <-
GTK.fileChooserNativeNew ( Just "Select folder..." ) ( Just window )
GTK.FileChooserActionSelectFolder
( Just "Select Folder" )
( Just "Cancel" )
GTK.fileChooserSetAction fileChooser GTK.FileChooserActionSelectFolder
GTK.nativeDialogSetModal fileChooser True
GTK.nativeDialogShow fileChooser
void $ GTK.afterNativeDialogResponse fileChooser \ response -> do
when ( response == fromIntegral ( fromEnum GTK.ResponseTypeAccept ) ) do
mbFolder <- GTK.fileChooserGetFile fileChooser
fileDialog <- GTK.fileDialogNew
GTK.fileDialogSetTitle fileDialog "Select folder..."
GTK.fileDialogSetModal fileDialog True
GTK.fileDialogSetAcceptLabel fileDialog (Just "Open")
GTK.fileDialogSelectFolder fileDialog (Just window) (Nothing :: Maybe GIO.Cancellable) $
Just $ \ _ result -> do
mbFolder <- GTK.handleDialogError (\ _ _ -> return Nothing) $
GTK.fileDialogSelectFolderFinish fileDialog result
for_ mbFolder \ folder -> do
mbFolderPath <- GIO.fileGetPath folder
for_ mbFolderPath \ folderPath -> do
@ -364,23 +364,26 @@ export uiElts vars@( Variables { .. } ) = do
withSavePath :: UIElements -> SaveFormat -> ( FilePath -> IO () ) -> IO ()
withSavePath ( UIElements {..} ) saveFormat action = do
-- GTK 4 TODO: use FileDialog
fileChooser <-
GTK.fileChooserNativeNew ( Just saveText ) ( Just window )
GTK.FileChooserActionSave
( Just saveOrExport )
( Just "Cancel" )
GTK.nativeDialogSetModal fileChooser True
GTK.fileChooserSetAction fileChooser GTK.FileChooserActionSave
fileDialog <- GTK.fileDialogNew
GTK.fileDialogSetTitle fileDialog saveText
GTK.fileDialogSetModal fileDialog True
GTK.fileDialogSetAcceptLabel fileDialog (Just "Open")
fileFilter <- GTK.fileFilterNew
GTK.fileFilterSetName fileFilter (Just $ Text.pack $ show saveFormat <> " document")
GTK.fileFilterAddPattern fileFilter ( "*." <> extension )
GTK.fileChooserAddFilter fileChooser fileFilter
GTK.nativeDialogShow fileChooser
void $ GTK.afterNativeDialogResponse fileChooser \ response -> do
when ( response == fromIntegral ( fromEnum GTK.ResponseTypeAccept ) ) do
mbSaveFile <- GTK.fileChooserGetFile fileChooser
for_ mbSaveFile \ saveFile -> do
GTK.setFileDialogDefaultFilter fileDialog fileFilter
fileFilterType <- GTK.gvalueGType_ @(Maybe GTK.FileFilter)
filterList <- GIO.listStoreNew fileFilterType
void $ GIO.listStoreAppend filterList fileFilter
GTK.fileDialogSetFilters fileDialog (Just filterList)
GTK.fileDialogSave fileDialog (Just window) (Nothing :: Maybe GIO.Cancellable) $
Just $ \ _ result -> do
mbSaveFile <- GTK.handleDialogError (\ _ _ -> return Nothing) $
GTK.fileDialogSaveFinish fileDialog result
for_ mbSaveFile $ \ saveFile -> do
mbSavePath <- fmap fullFilePath <$> GIO.fileGetPath saveFile
for_ mbSavePath action
where