{-- HSFM, a filemanager written in Haskell. Copyright (C) 2016 Julian Ospald This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License version 2 as published by the Free Software Foundation. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. --} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_HADDOCK ignore-exports #-} module HSFM.GUI.Gtk.MyGUI where import Control.Concurrent.STM ( newTVarIO ) import Graphics.UI.Gtk import HSFM.FileSystem.UtilTypes import HSFM.GUI.Gtk.Data import Paths_hsfm ( getDataFileName ) ------------------------- --[ Main Window Setup ]-- ------------------------- -- |Set up the GUI. This only creates the permanent widgets. createMyGUI :: IO MyGUI createMyGUI = do let settings' = MkFMSettings False True 24 settings <- newTVarIO settings' operationBuffer <- newTVarIO None builder <- builderNew builderAddFromFile builder =<< getDataFileName "data/Gtk/builder.xml" -- get the pre-defined gui widgets rootWin <- builderGetObject builder castToWindow "rootWin" menubarFileQuit <- builderGetObject builder castToImageMenuItem "menubarFileQuit" menubarHelpAbout <- builderGetObject builder castToImageMenuItem "menubarHelpAbout" statusBar <- builderGetObject builder castToStatusbar "statusBar" clearStatusBar <- builderGetObject builder castToButton "clearStatusBar" fpropGrid <- builderGetObject builder castToGrid "fpropGrid" fpropFnEntry <- builderGetObject builder castToEntry "fpropFnEntry" fpropLocEntry <- builderGetObject builder castToEntry "fpropLocEntry" fpropTsEntry <- builderGetObject builder castToEntry "fpropTsEntry" fpropModEntry <- builderGetObject builder castToEntry "fpropModEntry" fpropAcEntry <- builderGetObject builder castToEntry "fpropAcEntry" fpropFTEntry <- builderGetObject builder castToEntry "fpropFTEntry" fpropPermEntry <- builderGetObject builder castToEntry "fpropPermEntry" fpropLDEntry <- builderGetObject builder castToEntry "fpropLDEntry" notebook1 <- builderGetObject builder castToNotebook "notebook1" notebook2 <- builderGetObject builder castToNotebook "notebook2" leftNbIcon <- builderGetObject builder castToImage "leftNbIcon" rightNbIcon <- builderGetObject builder castToImage "rightNbIcon" leftNbBtn <- builderGetObject builder castToToggleButton "leftNbBtn" rightNbBtn <- builderGetObject builder castToToggleButton "rightNbBtn" -- this is required so that hotkeys work as expected, because -- we then can connect to signals from `viewBox` more reliably widgetSetCanFocus notebook1 False widgetSetCanFocus notebook2 False -- notebook toggle buttons buttonSetImage leftNbBtn leftNbIcon buttonSetImage rightNbBtn rightNbIcon widgetSetSensitive leftNbIcon False widgetSetSensitive rightNbIcon False toggleButtonSetActive leftNbBtn True toggleButtonSetActive rightNbBtn True -- construct the gui object let menubar = MkMenuBar {..} let fprop = MkFilePropertyGrid {..} let mygui = MkMyGUI {..} -- sets the default icon _ <- windowSetDefaultIconFromFile =<< getDataFileName "data/Gtk/icons/hsfm.png" return mygui