diff --git a/src/app/MetaBrush/Action.hs b/src/app/MetaBrush/Action.hs index d951267..89f2b11 100644 --- a/src/app/MetaBrush/Action.hs +++ b/src/app/MetaBrush/Action.hs @@ -11,8 +11,12 @@ import Data.Foldable ( for_, sequenceA_ ) import Data.Int ( Int32 ) +import Data.List + ( uncons ) import Data.Maybe ( catMaybes, fromMaybe ) +import Data.String + ( IsString ) import Data.Traversable ( for ) import Data.Word @@ -46,6 +50,9 @@ import System.FilePath import Data.Generics.Product.Fields ( field' ) +-- gi-cairo-render +import qualified GI.Cairo.Render as Cairo + -- gi-gdk import qualified GI.Gdk as GDK @@ -270,22 +277,29 @@ instance HandleAction OpenFolder where newFileTab uiElts vars ( Just newDocHist ) tabLoc updateHistoryState uiElts ( Just newDocHist ) --------------------- --- Save & Save as -- --------------------- +--------------------------- +-- Save, Save as, Export -- +--------------------------- data Save = Save deriving stock Show +data SaveAs = SaveAs + deriving stock Show +data Export = Export + deriving stock Show instance HandleAction Save where handleAction uiElts vars _ = save uiElts vars True - -data SaveAs = SaveAs - deriving stock Show - instance HandleAction SaveAs where handleAction uiElts vars _ = saveAs uiElts vars True +instance HandleAction Export where + handleAction uiElts vars _ = export uiElts vars + +data SaveFormat + = MetaBrush + | SVG + deriving stock Show save :: UIElements -> Variables -> Bool -> IO () save uiElts vars keepOpen = do @@ -305,25 +319,44 @@ save uiElts vars keepOpen = do saveAs :: UIElements -> Variables -> Bool -> IO () saveAs uiElts vars keepOpen = - withSavePath uiElts \ savePath -> + withSavePath uiElts MetaBrush \ savePath -> modifyingCurrentDocument uiElts vars \ doc -> do let modif :: DocumentUpdate modif = if keepOpen then SaveDocument ( Just savePath ) else CloseDocument pure $ UpdateDocAndThen modif ( saveDocument savePath doc ) -withSavePath :: UIElements -> ( FilePath -> IO () ) -> IO () -withSavePath ( UIElements {..} ) action = do +export :: UIElements -> Variables -> IO () +export uiElts vars@( Variables { .. } ) = do + mbRender <- STM.atomically $ do + mbDoc <- fmap present <$> activeDocument vars + case mbDoc of + Nothing -> return Nothing + Just _ -> Just <$> STM.readTVar documentRenderTVar + for_ mbRender \ renderDoc -> do + withSavePath uiElts SVG \ savePath -> do + -- TODO: hard-coding the width & height. + -- Should instead add these as document properties. + let width, height :: Double + width = 1024 + height = 768 + Cairo.withSVGSurface savePath width height \ svgSurface -> + Cairo.renderWith svgSurface ( renderDoc ( 1024, 768 ) ) + -- TODO: this renders the document as it appears on screen. + -- It would be good to decouple this from the GTK canvas. + +withSavePath :: UIElements -> SaveFormat -> ( FilePath -> IO () ) -> IO () +withSavePath ( UIElements {..} ) saveFormat action = do fileChooser <- - GTK.fileChooserNativeNew ( Just "Save MetaBrush document..." ) ( Just window ) + GTK.fileChooserNativeNew ( Just saveText ) ( Just window ) GTK.FileChooserActionSave - ( Just "Save" ) + ( Just saveOrExport ) ( Just "Cancel" ) GTK.nativeDialogSetModal fileChooser True GTK.fileChooserSetAction fileChooser GTK.FileChooserActionSave fileFilter <- GTK.fileFilterNew - GTK.fileFilterSetName fileFilter ( Just "MetaBrush document" ) - GTK.fileFilterAddPattern fileFilter "*.mb" + 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 @@ -333,12 +366,22 @@ withSavePath ( UIElements {..} ) action = do mbSavePath <- fmap fullFilePath <$> GIO.fileGetPath saveFile for_ mbSavePath action where + saveText, saveOrExport :: Text + saveText = saveOrExport <> " " <> Text.pack (show saveFormat) <> " document..." + saveOrExport = case saveFormat of + MetaBrush -> "Save" + SVG -> "Export" + extension :: IsString s => s + extension = case saveFormat of + MetaBrush -> "mb" + SVG -> "svg" fullFilePath :: FilePath -> FilePath fullFilePath fp - | ".mb" <- takeExtension fp + | Just ('.', ext) <- uncons $ takeExtension fp + , ext == extension = fp | otherwise - = fp <.> "mb" + = fp <.> extension ----------- -- Close -- diff --git a/src/app/MetaBrush/UI/Menu.hs b/src/app/MetaBrush/UI/Menu.hs index fe75f99..6e632cd 100644 --- a/src/app/MetaBrush/UI/Menu.hs +++ b/src/app/MetaBrush/UI/Menu.hs @@ -78,6 +78,7 @@ menuActionNames = HashSet.fromList , WinAction "openFolder" , WinAction "save" , WinAction "saveAs" + , WinAction "export" , WinAction "closeActive" , WinAction "quit" -- edit menu @@ -118,6 +119,7 @@ fileMenuDescription = , MenuItemDescription "Open folder" ( Just $ WinAction "openFolder" , ( OpenFolder AfterCurrentTab ) ) ( Just "o" ) , MenuItemDescription "Save" ( Just $ WinAction "save" , Save ) ( Just "s" ) , MenuItemDescription "Save as" ( Just $ WinAction "saveAs" , SaveAs ) ( Just "s" ) + , MenuItemDescription "Export" ( Just $ WinAction "export" , Export ) ( Just "e" ) , MenuItemDescription "Close" ( Just $ WinAction "closeActive", CloseActive ) ( Just "w" ) , MenuItemDescription "Quit" ( Just $ WinAction "quit" , Quit ) ( Just "q" ) ]