{-# LANGUAGE BlockArguments #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} module Main ( main ) where -- base import Data.Foldable ( for_ ) import Data.Int ( Int32 ) import System.Exit ( exitSuccess ) -- directory import qualified System.Directory as Directory ( canonicalizePath ) -- 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 -- text import qualified Data.Text as Text ( pack ) -- MetaBrush import MetaBrush.Asset.Colours ( ColourRecord(..), colours ) import MetaBrush.Asset.Logo ( drawLogo ) import MetaBrush.Event ( handleKeyboardPressEvent, handleKeyboardReleaseEvent ) import MetaBrush.Render.Util ( widgetAddClass, widgetAddClasses ) import MetaBrush.UI.Menu ( newMenuBar ) import qualified Paths_MetaBrush as Cabal ( getDataFileName ) -------------------------------------------------------------------------------- main :: IO () main = do --------------------------------------------------------- -- Initialise GTK _ <- GTK.init Nothing Just screen <- GDK.screenGetDefault themePath <- Text.pack <$> ( Directory.canonicalizePath =<< Cabal.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 True GTK.setWindowTitle window "MetaBrush" GTK.windowSetDefaultSize window 800 600 let baseMinWidth, baseMinHeight :: Int32 baseMinWidth = 480 baseMinHeight = 240 windowGeometry <- GDK.newZeroGeometry GDK.setGeometryMinWidth windowGeometry baseMinWidth GDK.setGeometryMinHeight windowGeometry baseMinHeight GTK.windowSetGeometryHints window ( Nothing @GTK.Widget ) ( Just windowGeometry ) [ GDK.WindowHintsMinSize ] Colours { .. } <- colours windowWidgetPath --------------------------------------------------------- -- Create base UI elements baseOverlay <- GTK.overlayNew GTK.setContainerChild window baseOverlay uiGrid <- GTK.gridNew GTK.setContainerChild baseOverlay uiGrid logo <- GTK.boxNew GTK.OrientationVertical 0 titleBar <- GTK.boxNew GTK.OrientationHorizontal 0 toolBar <- GTK.boxNew GTK.OrientationVertical 0 mainPane <- GTK.panedNew GTK.OrientationHorizontal panelGrid <- GTK.gridNew 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 mainPane 2 1 2 4 mainView <- GTK.boxNew GTK.OrientationVertical 0 GTK.panedPack1 mainPane mainView True False GTK.panedPack2 mainPane panelGrid False False fileBar <- GTK.scrolledWindowNew ( Nothing @GTK.Adjustment ) ( Nothing @GTK.Adjustment ) viewportGrid <- GTK.gridNew infoBar <- GTK.boxNew GTK.OrientationHorizontal 0 GTK.boxPackStart mainView fileBar False False 0 GTK.boxPackStart mainView viewportGrid True True 0 GTK.boxPackStart mainView infoBar False False 0 --------------------------------------------------------- -- Background widgetAddClass uiGrid "bg" --------------------------------------------------------- -- Logo widgetAddClass logo "logo" logoArea <- GTK.drawingAreaNew GTK.boxPackStart logo logoArea True True 0 _ <- GTK.onWidgetDraw logoArea $ Cairo.renderWithContext ( drawLogo logo_base logo_highlight logo_base ) --------------------------------------------------------- -- Title bar widgetAddClass titleBar "titleBar" ( menuBar, _menu ) <- newMenuBar widgetAddClasses menuBar [ "menuBar", "text", "plain" ] GTK.boxPackStart titleBar menuBar False False 0 windowIcons <- GTK.boxNew GTK.OrientationHorizontal 0 widgetAddClasses windowIcons [ "windowIcon" ] GTK.boxPackEnd titleBar windowIcons False False 0 title <- GTK.labelNew ( Just "● New Document (1) – MetaBrush" ) widgetAddClasses title [ "text", "title", "plain" ] GTK.boxSetCenterWidget titleBar ( Just title ) --------------------------------------------------------- -- Tool bar widgetAddClass toolBar "toolBar" --------------------------------------------------------- -- File bar widgetAddClass fileBar "fileBar" --------------------------------------------------------- -- Main viewport fileTabs <- GTK.boxNew GTK.OrientationHorizontal 0 GTK.containerAdd fileBar fileTabs widgetAddClasses fileTabs [ "fileBar", "plain", "text" ] phantomRadioButton <- GTK.radioButtonNew ( [] @GTK.RadioButton ) for_ [ 1 .. 12 ] \ i -> do pgButton <- GTK.radioButtonNewWithLabelFromWidget ( Just phantomRadioButton ) ( "● New Document (" <> Text.pack ( show i ) <> ")" ) GTK.toggleButtonSetMode pgButton False -- don't display radio indicator widgetAddClasses pgButton [ "fileBarTab" ] GTK.boxPackStart fileTabs pgButton False False 0 GTK.scrolledWindowSetPolicy fileBar GTK.PolicyTypeAutomatic GTK.PolicyTypeNever GTK.scrolledWindowSetOverlayScrolling fileBar True widgetAddClass viewportGrid "viewport_bg" rvRulerCorner <- GTK.revealerNew rvLeftRuler <- GTK.revealerNew rvTopRuler <- GTK.revealerNew viewport <- GTK.drawingAreaNew GTK.gridAttach viewportGrid rvRulerCorner 0 0 1 1 GTK.gridAttach viewportGrid rvLeftRuler 0 1 1 1 GTK.gridAttach viewportGrid rvTopRuler 1 0 1 1 GTK.gridAttach viewportGrid viewport 1 1 1 1 rulerCorner <- GTK.boxNew GTK.OrientationVertical 0 leftRuler <- GTK.boxNew GTK.OrientationVertical 0 topRuler <- GTK.boxNew GTK.OrientationHorizontal 0 GTK.containerAdd rvRulerCorner rulerCorner GTK.containerAdd rvLeftRuler leftRuler GTK.containerAdd rvTopRuler topRuler widgetAddClass rulerCorner "ruler" widgetAddClass leftRuler "ruler" widgetAddClass topRuler "ruler" GTK.revealerSetRevealChild rvRulerCorner True GTK.revealerSetRevealChild rvLeftRuler True GTK.revealerSetRevealChild rvTopRuler True GTK.revealerSetTransitionType rvRulerCorner GTK.RevealerTransitionTypeSlideLeft GTK.revealerSetTransitionType rvLeftRuler GTK.RevealerTransitionTypeSlideLeft GTK.revealerSetTransitionType rvTopRuler GTK.RevealerTransitionTypeSlideUp rulerCornerArea <- GTK.drawingAreaNew GTK.boxPackStart rulerCorner rulerCornerArea True True 0 leftRulerArea <- GTK.drawingAreaNew GTK.boxPackStart leftRuler leftRulerArea True True 0 topRulerArea <- GTK.drawingAreaNew GTK.boxPackStart topRuler topRulerArea True True 0 GTK.widgetSetHexpand rulerCorner False GTK.widgetSetVexpand rulerCorner False GTK.widgetSetHexpand leftRuler False GTK.widgetSetVexpand leftRuler True GTK.widgetSetHexpand topRuler True GTK.widgetSetVexpand topRuler False GTK.widgetSetHexpand viewport True GTK.widgetSetVexpand viewport True --------------------------------------------------------- -- Panels widgetAddClass panelGrid "panels" --------------------------------------------------------- -- Info bar widgetAddClass infoBar "infoBar" --------------------------------------------------------- -- Actions --------------------------------------------------------- -- GTK main loop GTK.widgetAddEvents window [GDK.EventMaskKeyPressMask, GDK.EventMaskKeyReleaseMask] _ <- GTK.onWidgetKeyPressEvent window handleKeyboardPressEvent _ <- GTK.onWidgetKeyReleaseEvent window handleKeyboardReleaseEvent _ <- GTK.onWidgetDestroy window GTK.mainQuit GTK.widgetShowAll window GTK.main exitSuccess