From 63b9703faff990aad78ec1468f9d4c2b7299f54a Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Thu, 25 Apr 2024 21:53:53 +0200
Subject: [PATCH] UI tweaks

---
 src/app/MetaBrush/Action.hs      | 61 +++++++++++++++++++++++++++++++-
 src/app/MetaBrush/Application.hs |  9 ++---
 src/app/MetaBrush/UI/Menu.hs     |  8 +++--
 3 files changed, 70 insertions(+), 8 deletions(-)

diff --git a/src/app/MetaBrush/Action.hs b/src/app/MetaBrush/Action.hs
index 89f2b11..3b114db 100644
--- a/src/app/MetaBrush/Action.hs
+++ b/src/app/MetaBrush/Action.hs
@@ -50,6 +50,10 @@ import System.FilePath
 import Data.Generics.Product.Fields
   ( field' )
 
+-- gi-cairo-connector
+import qualified GI.Cairo.Render.Connector as Cairo
+  ( renderWithContext )
+
 -- gi-cairo-render
 import qualified GI.Cairo.Render as Cairo
 
@@ -87,7 +91,7 @@ import Data.Text
 import qualified Data.Text as Text
   ( intercalate, pack )
 
--- MetaBrush
+-- brush-strokes
 import Math.Bezier.Spline
   ( Spline(..), SplineType(Open)
   , catMaybesSpline
@@ -98,6 +102,10 @@ import Math.Module
   ( Module((*^)), quadrance )
 import Math.Linear
   ( ℝ(..), T(..) )
+
+-- MetaBrush
+import MetaBrush.Asset.WindowIcons
+  ( drawClose )
 import MetaBrush.Context
   ( UIElements(..), Variables(..)
   , Modifier(..), modifierKey
@@ -694,6 +702,57 @@ data About = About
 instance HandleAction About where
   handleAction _ _ _ = pure ()
 
+------------------------
+-- Preferences dialog --
+-----------------------
+
+data OpenPrefs = OpenPrefs
+  deriving stock Show
+
+-- TODO
+instance HandleAction OpenPrefs where
+  handleAction ( UIElements { colours, window } ) _ _ = do --( Variables {..} ) _ = do
+    prefsWin <- GTK.windowNew
+    GTK.setWindowResizable prefsWin True
+    GTK.setWindowDecorated prefsWin True
+    GTK.setWindowTitle prefsWin "Preferences"
+    GTK.windowSetTransientFor prefsWin ( Just window )
+    GTK.windowSetModal prefsWin False
+    widgetAddClasses prefsWin [ "metabrush", "bg", "plain", "text", "dialog" ]
+
+    -- Add custom close button... TODO: factor this out.
+    prefsTitleBar <- GTK.headerBarNew
+    GTK.headerBarSetShowTitleButtons prefsTitleBar False
+    GTK.headerBarSetDecorationLayout prefsTitleBar ( Just "close" )
+    widgetAddClass prefsTitleBar "titleBar"
+    windowIcons <- GTK.boxNew GTK.OrientationHorizontal 0
+    widgetAddClasses windowIcons [ "windowIcons" ]
+    GTK.headerBarPackEnd prefsTitleBar windowIcons
+    closeButton <- GTK.buttonNew
+    GTK.boxAppend windowIcons    closeButton
+    closeArea   <- GTK.drawingAreaNew
+    GTK.buttonSetChild    closeButton ( Just    closeArea )
+    GTK.drawingAreaSetDrawFunc closeArea $ Just \ _ cairoContext _ _ ->
+      void $ Cairo.renderWithContext ( drawClose colours ) cairoContext
+    widgetAddClass closeButton "windowIcon"
+    widgetAddClass closeButton "closeWindowIcon"
+    _ <- GTK.onButtonClicked closeButton $ GTK.windowClose prefsWin
+    GTK.windowSetTitlebar prefsWin ( Just prefsTitleBar )
+
+{-
+    -- TODO: actually implement the preferences chooser...
+    prefsNotebook <- GTK.notebookNew
+    algoPrefs <- GTK.boxNew GTK.OrientationVertical 20
+    algoLabel <- GTK.labelNew $ Just "Algorithms"
+    _ <- GTK.notebookAppendPage prefsNotebook algoPrefs (Just algoLabel)
+    otherPrefs <- GTK.boxNew GTK.OrientationVertical 20
+    otherLabel <- GTK.labelNew $ Just "Other"
+    _ <- GTK.notebookAppendPage prefsNotebook otherPrefs (Just otherLabel)
+    GTK.windowSetChild prefsWin ( Just prefsNotebook )
+-}
+
+    GTK.widgetShow prefsWin
+
 --------------------------------------------------------------------------------
 -- Input actions
 
diff --git a/src/app/MetaBrush/Application.hs b/src/app/MetaBrush/Application.hs
index 58d5e77..8a5004e 100644
--- a/src/app/MetaBrush/Application.hs
+++ b/src/app/MetaBrush/Application.hs
@@ -240,16 +240,17 @@ runApplication application = do
 
   GTK.eventControllerSetPropagationPhase windowKeys GTK.PropagationPhaseBubble
 
+  iconTheme <- GTK.iconThemeGetForDisplay display
+  let iconSearchPath = dataPath </> "icons"
+  GTK.iconThemeAddSearchPath iconTheme iconSearchPath
+  GTK.windowSetIconName window ( Just "MetaBrush" )
+
   widgetAddClasses window [ "metabrush", "window" ]
   GTK.setWindowResizable window True
   GTK.setWindowDecorated window True
   GTK.setWindowTitle window "MetaBrush"
   GTK.windowSetDefaultSize window 1024 768
 
-  GTK.windowSetIconName window ( Just "MetaBrush" )
-  iconTheme <- GTK.iconThemeGetForDisplay display
-  GTK.iconThemeAddSearchPath iconTheme ( dataPath </> "icons" )
-
   colours <- getColours cssProvider
 
   ---------------------------------------------------------
diff --git a/src/app/MetaBrush/UI/Menu.hs b/src/app/MetaBrush/UI/Menu.hs
index 6e632cd..cb31ad8 100644
--- a/src/app/MetaBrush/UI/Menu.hs
+++ b/src/app/MetaBrush/UI/Menu.hs
@@ -92,7 +92,9 @@ menuActionNames = HashSet.fromList
   -- view menu
   , WinAction "toggleGuides"
   -- about menu
-  , AppAction "about"
+  , WinAction "about"
+  -- preferences
+  , WinAction "prefs"
   ]
 
 createMenuActions :: IO ( HashMap ActionName GIO.SimpleAction )
@@ -138,7 +140,7 @@ editMenuDescription =
     , MenuItemDescription "Delete"      ( Just $ WinAction "delete"   , Delete    ) ( Just "Delete"  )
     ]
   , Section Nothing
-    [ MenuItemDescription "Preferences" ( Nothing, () ) ( Just "<Control><Shift>p" )
+    [ MenuItemDescription "Preferences" ( Just $ WinAction "prefs", OpenPrefs ) ( Just "<Control><Shift>p" )
     ]
   ]
 
@@ -163,7 +165,7 @@ viewMenuDescription =
 
 helpMenuDescription :: [ MenuItem ]
 helpMenuDescription =
-  [ MenuItemDescription "About MetaBrush" ( Just $ AppAction "about", About ) ( Just "<Ctrl>question" )
+  [ MenuItemDescription "About MetaBrush" ( Just $ WinAction "about", About ) ( Just "<Ctrl>question" )
   ]
 
 --------------------------------------------------------------------------------