add export to SVG functionality

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 --

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 "<Control><Shift>o" )
   , MenuItemDescription "Save"        ( Just $ WinAction "save"       , Save                           ) ( Just "<Control>s"        )
   , MenuItemDescription "Save as"     ( Just $ WinAction "saveAs"     , SaveAs                         ) ( Just "<Control><Shift>s" )
+  , MenuItemDescription "Export"      ( Just $ WinAction "export"     , Export                         ) ( Just "<Control>e"        )
   , MenuItemDescription "Close"       ( Just $ WinAction "closeActive", CloseActive                    ) ( Just "<Control>w"        )
   , MenuItemDescription "Quit"        ( Just $ WinAction "quit"       , Quit                           ) ( Just "<Control>q"        )
   ]