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

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

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