mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-23 15:34:06 +00:00
UI tweaks
This commit is contained in:
parent
c89fba7fd2
commit
63b9703faf
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
---------------------------------------------------------
|
||||
|
|
|
@ -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" )
|
||||
]
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
Loading…
Reference in a new issue