mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +00:00
92 lines
2.6 KiB
Haskell
92 lines
2.6 KiB
Haskell
|
module Main
|
||
|
|
( main )
|
||
|
|
where
|
||
|
|
|
||
|
|
-- gi-cairo-connector
|
||
|
|
import qualified GI.Cairo.Render.Connector as Cairo
|
||
|
|
( renderWithContext )
|
||
|
|
|
||
|
|
-- gi-gdk
|
||
|
|
import qualified GI.Gdk as GDK
|
||
|
|
|
||
|
|
-- gi-gtk
|
||
|
|
import qualified GI.Gtk as GTK
|
||
|
|
|
||
|
|
-- MetaBrush
|
||
|
|
import Paths_MetaBrush
|
||
|
|
( getDataFileName )
|
||
|
|
|
||
|
|
--------------------------------------------------------------------------------
|
||
|
|
|
||
|
|
main :: IO ()
|
||
|
|
main = do
|
||
|
|
|
||
|
|
---------------------------------------------------------
|
||
|
|
-- Initialise GTK
|
||
|
|
|
||
|
|
_ <- GTK.init Nothing
|
||
|
|
Just screen <- GDK.screenGetDefault
|
||
|
|
|
||
|
|
themePath <- getDataFileName "theme.css"
|
||
|
|
cssProvider <- GTK.cssProviderNew
|
||
|
|
GTK.cssProviderLoadFromPath cssProvider themePath
|
||
|
|
GTK.styleContextAddProviderForScreen screen cssProvider 1000
|
||
|
|
|
||
|
|
window <- GTK.windowNew GTK.WindowTypeToplevel
|
||
|
|
windowWidgetPath <- GTK.widgetGetPath window
|
||
|
|
widgetAddClass window "window"
|
||
|
|
GTK.setWindowResizable window True
|
||
|
|
GTK.setWindowDecorated window False
|
||
|
|
GTK.setWindowTitle window "MetaBrush"
|
||
|
|
GTK.windowSetDefaultSize window 800 600
|
||
|
|
|
||
|
|
let
|
||
|
|
baseMinWidth, baseMinHeight :: Int32
|
||
|
|
baseMinWidth = 320
|
||
|
|
baseMinHeight = 240
|
||
|
|
|
||
|
|
windowGeometry <- GDK.newZeroGeometry
|
||
|
|
GDK.setGeometryMinWidth windowGeometry baseMinWidth
|
||
|
|
GDK.setGeometryMinHeight windowGeometry baseMinHeight
|
||
|
|
GTK.windowSetGeometryHints window ( Nothing @GTK.Widget )
|
||
|
|
( Just windowGeometry )
|
||
|
|
[ GDK.WindowHintsMinSize ]
|
||
|
|
|
||
|
|
---------------------------------------------------------
|
||
|
|
-- Create base UI elements
|
||
|
|
|
||
|
|
baseOverlay <- GTK.overlayNew
|
||
|
|
GT.setContainerChild window baseOverlay
|
||
|
|
|
||
|
|
uiGrid <- GTK.gridNew
|
||
|
|
GTK.overlaySetChild baseOverlay uiGrid
|
||
|
|
|
||
|
|
logo <- GTK.boxNew GTK.OrientationVertical 0
|
||
|
|
titleBar <- GTK.boxNew GTK.OrientationHorizontal 0
|
||
|
|
toolBar <- GTK.boxNew GTK.OrientationVertical 0
|
||
|
|
fileBar <- GTK.boxNew GTK.OrientationHorizontal 0
|
||
|
|
mainView <- GTK.gridNew
|
||
|
|
panelGrid <- GTK.gridNew
|
||
|
|
infoBar <- GTK.boxNew GTK.OrientationHorizontal 0
|
||
|
|
|
||
|
|
GTK.gridAttach uiGrid logo 0 0 1 2
|
||
|
|
GTK.gridAttach uiGrid titleBar 1 0 3 1
|
||
|
|
GTK.gridAttach uiGrid toolBar 0 2 2 2
|
||
|
|
GTK.gridAttach uiGrid fileBar 2 1 1 1
|
||
|
|
GTK.gridAttach uiGrid mainView 2 2 1 1
|
||
|
|
GTK.gridAttach uiGrid panelGrid 3 2 1 2
|
||
|
|
GTK.gridAttach uiGrid infoBar 2 3 1 1
|
||
|
|
|
||
|
|
--------------------------------------
|
||
|
|
-- Actions
|
||
|
|
|
||
|
|
GTK.widgetAddEvents window [GDK.EventMaskKeyPressMask, GDK.EventMaskKeyReleaseMask]
|
||
|
|
_ <- GTK.onWidgetKeyPressEvent window ( handleKeyboardPressEvent )
|
||
|
|
_ <- GTK.onWidgetKeyReleaseEvent window ( handleKeyboardReleaseEvent )
|
||
|
|
|
||
|
|
_ <- GTK.onWidgetDestroy window ( quitAll actionTVar )
|
||
|
|
_ <- GTK.onButtonClicked quitIconButton ( quitAll actionTVar )
|
||
|
|
|
||
|
|
GTK.widgetShowAll window
|
||
|
|
GTK.main
|