UI tweaks

This commit is contained in:
sheaf 2024-04-25 21:53:53 +02:00
parent c89fba7fd2
commit 63b9703faf
3 changed files with 70 additions and 8 deletions

View file

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

View file

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

View file

@ -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" )
]
--------------------------------------------------------------------------------