Switch to glade
This commit is contained in:
parent
3bfb84e1c7
commit
1ca38186e8
@ -60,7 +60,7 @@ executable CG2
|
|||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
|
|
||||||
-- Other library packages from which modules are imported.
|
-- Other library packages from which modules are imported.
|
||||||
build-depends: base >=4.7 && <4.8, diagrams-lib >=1.2 && <1.3, diagrams-cairo >=1.2 && <1.3, transformers >=0.4 && <0.5, gtk >=0.12 && <0.13, directory >=1.2 && <1.3
|
build-depends: base >=4.7 && <4.8, diagrams-lib >=1.2 && <1.3, diagrams-cairo >=1.2 && <1.3, transformers >=0.4 && <0.5, glade >=0.12 && <0.13, gtk >=0.12 && <0.13, directory >=1.2 && <1.3
|
||||||
|
|
||||||
-- Directories containing source files.
|
-- Directories containing source files.
|
||||||
-- hs-source-dirs:
|
-- hs-source-dirs:
|
||||||
|
|||||||
50
Gtk.hs
50
Gtk.hs
@ -6,11 +6,15 @@ import Diagrams.Prelude
|
|||||||
import Diagrams.Backend.Cairo
|
import Diagrams.Backend.Cairo
|
||||||
import Diagrams.Backend.Cairo.Internal
|
import Diagrams.Backend.Cairo.Internal
|
||||||
import Graphics.UI.Gtk
|
import Graphics.UI.Gtk
|
||||||
|
import Graphics.UI.Gtk.Glade
|
||||||
import Graphics.UI.Gtk.Windows.MessageDialog
|
import Graphics.UI.Gtk.Windows.MessageDialog
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import Util
|
import Util
|
||||||
|
|
||||||
|
|
||||||
|
gladeFile :: FilePath
|
||||||
|
gladeFile = "gtk2.glade"
|
||||||
|
|
||||||
-- |Handle the whole GTK gui.
|
-- |Handle the whole GTK gui.
|
||||||
makeGUI :: FilePath -> IO ()
|
makeGUI :: FilePath -> IO ()
|
||||||
makeGUI startFile = do
|
makeGUI startFile = do
|
||||||
@ -19,46 +23,20 @@ makeGUI startFile = do
|
|||||||
-- init gui
|
-- init gui
|
||||||
_ <- initGUI
|
_ <- initGUI
|
||||||
|
|
||||||
-- create window and widgets
|
-- load glade file
|
||||||
window <- windowNew
|
Just xml <- xmlNew gladeFile
|
||||||
da <- drawingAreaNew
|
window <- xmlGetWidget xml castToWindow "window1"
|
||||||
fileButton <- fileChooserButtonNew "Select mesh"
|
drawButton <- xmlGetWidget xml castToButton "drawButton"
|
||||||
FileChooserActionOpen
|
saveButton <- xmlGetWidget xml castToButton "saveButton"
|
||||||
drawButton <- buttonNew
|
quitButton <- xmlGetWidget xml castToButton "quitButton"
|
||||||
saveButton <- buttonNew
|
fileButton <- xmlGetWidget xml castToFileChooserButton
|
||||||
quitButton <- buttonNew
|
"filechooserButton"
|
||||||
box1 <- vBoxNew False 0
|
da <- xmlGetWidget xml castToDrawingArea "drawingarea"
|
||||||
box2 <- hButtonBoxNew
|
hscale <- xmlGetWidget xml castToHScale "hscale"
|
||||||
box3 <- hBoxNew False 0
|
|
||||||
hscale <- hScaleNewWithRange 0.1 10 0.5
|
|
||||||
drawButtonLabel <- labelNew $ Just "Draw"
|
|
||||||
saveButtonLabel <- labelNew $ Just "Save"
|
|
||||||
quitButtonLabel <- labelNew $ Just "Quit"
|
|
||||||
|
|
||||||
-- containers and boxing
|
|
||||||
containerAdd drawButton drawButtonLabel
|
|
||||||
containerAdd saveButton saveButtonLabel
|
|
||||||
containerAdd quitButton quitButtonLabel
|
|
||||||
containerAdd window box1
|
|
||||||
boxPackStart box1 da PackGrow 0
|
|
||||||
boxPackStart box1 box2 PackNatural 0
|
|
||||||
boxPackStart box1 box3 PackNatural 0
|
|
||||||
boxPackStart box2 drawButton PackNatural 0
|
|
||||||
boxPackStart box2 saveButton PackNatural 0
|
|
||||||
boxPackStart box2 quitButton PackNatural 0
|
|
||||||
boxPackStart box3 fileButton PackGrow 5
|
|
||||||
boxPackStart box3 hscale PackGrow 5
|
|
||||||
|
|
||||||
-- adjust properties
|
-- adjust properties
|
||||||
set window [windowDefaultWidth := 600, windowDefaultHeight := 700,
|
|
||||||
windowTitle := "Computergrafik"]
|
|
||||||
set box2 [buttonBoxLayoutStyle := ButtonboxCenter]
|
|
||||||
containerSetBorderWidth box2 10
|
|
||||||
_ <- windowSetTypeHint window WindowTypeHintDialog
|
|
||||||
_ <- fileChooserSetCurrentFolder fileButton homedir
|
_ <- fileChooserSetCurrentFolder fileButton homedir
|
||||||
_ <- fileChooserSetFilename fileButton startFile
|
_ <- fileChooserSetFilename fileButton startFile
|
||||||
adjustment <- rangeGetAdjustment hscale
|
|
||||||
_ <- adjustmentSetValue adjustment 2
|
|
||||||
|
|
||||||
-- callbacks
|
-- callbacks
|
||||||
_ <- onDestroy window mainQuit
|
_ <- onDestroy window mainQuit
|
||||||
|
|||||||
117
gtk2.glade
Normal file
117
gtk2.glade
Normal file
@ -0,0 +1,117 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<glade-interface>
|
||||||
|
<!-- interface-requires gtk+ 2.24 -->
|
||||||
|
<!-- interface-naming-policy project-wide -->
|
||||||
|
<widget class="GtkWindow" id="window1">
|
||||||
|
<property name="width_request">600</property>
|
||||||
|
<property name="height_request">700</property>
|
||||||
|
<property name="can_focus">False</property>
|
||||||
|
<property name="type_hint">dialog</property>
|
||||||
|
<child>
|
||||||
|
<widget class="GtkVBox" id="vbox1">
|
||||||
|
<property name="visible">True</property>
|
||||||
|
<property name="can_focus">False</property>
|
||||||
|
<child>
|
||||||
|
<widget class="GtkDrawingArea" id="drawingarea">
|
||||||
|
<property name="width_request">600</property>
|
||||||
|
<property name="height_request">600</property>
|
||||||
|
<property name="visible">True</property>
|
||||||
|
<property name="can_focus">False</property>
|
||||||
|
</widget>
|
||||||
|
<packing>
|
||||||
|
<property name="expand">True</property>
|
||||||
|
<property name="fill">True</property>
|
||||||
|
<property name="position">0</property>
|
||||||
|
</packing>
|
||||||
|
</child>
|
||||||
|
<child>
|
||||||
|
<widget class="GtkHBox" id="hbox1">
|
||||||
|
<property name="visible">True</property>
|
||||||
|
<property name="can_focus">False</property>
|
||||||
|
<child>
|
||||||
|
<widget class="GtkButton" id="drawButton">
|
||||||
|
<property name="label" translatable="yes">Draw</property>
|
||||||
|
<property name="visible">True</property>
|
||||||
|
<property name="can_focus">True</property>
|
||||||
|
<property name="receives_default">True</property>
|
||||||
|
</widget>
|
||||||
|
<packing>
|
||||||
|
<property name="expand">True</property>
|
||||||
|
<property name="fill">True</property>
|
||||||
|
<property name="position">0</property>
|
||||||
|
</packing>
|
||||||
|
</child>
|
||||||
|
<child>
|
||||||
|
<widget class="GtkButton" id="saveButton">
|
||||||
|
<property name="label" translatable="yes">Save</property>
|
||||||
|
<property name="visible">True</property>
|
||||||
|
<property name="can_focus">True</property>
|
||||||
|
<property name="receives_default">True</property>
|
||||||
|
</widget>
|
||||||
|
<packing>
|
||||||
|
<property name="expand">True</property>
|
||||||
|
<property name="fill">True</property>
|
||||||
|
<property name="position">1</property>
|
||||||
|
</packing>
|
||||||
|
</child>
|
||||||
|
<child>
|
||||||
|
<widget class="GtkButton" id="quitButton">
|
||||||
|
<property name="label" translatable="yes">Quit</property>
|
||||||
|
<property name="visible">True</property>
|
||||||
|
<property name="can_focus">True</property>
|
||||||
|
<property name="receives_default">True</property>
|
||||||
|
</widget>
|
||||||
|
<packing>
|
||||||
|
<property name="expand">True</property>
|
||||||
|
<property name="fill">True</property>
|
||||||
|
<property name="position">2</property>
|
||||||
|
</packing>
|
||||||
|
</child>
|
||||||
|
</widget>
|
||||||
|
<packing>
|
||||||
|
<property name="expand">False</property>
|
||||||
|
<property name="fill">False</property>
|
||||||
|
<property name="position">1</property>
|
||||||
|
</packing>
|
||||||
|
</child>
|
||||||
|
<child>
|
||||||
|
<widget class="GtkHBox" id="hbox2">
|
||||||
|
<property name="visible">True</property>
|
||||||
|
<property name="can_focus">False</property>
|
||||||
|
<child>
|
||||||
|
<widget class="GtkFileChooserButton" id="filechooserButton">
|
||||||
|
<property name="visible">True</property>
|
||||||
|
<property name="can_focus">False</property>
|
||||||
|
<property name="create_folders">False</property>
|
||||||
|
</widget>
|
||||||
|
<packing>
|
||||||
|
<property name="expand">True</property>
|
||||||
|
<property name="fill">True</property>
|
||||||
|
<property name="position">0</property>
|
||||||
|
</packing>
|
||||||
|
</child>
|
||||||
|
<child>
|
||||||
|
<widget class="GtkHScale" id="hscale">
|
||||||
|
<property name="visible">True</property>
|
||||||
|
<property name="can_focus">True</property>
|
||||||
|
<property name="adjustment">1 0.10000000000000001 10 0.5 0.5 0</property>
|
||||||
|
<property name="round_digits">1</property>
|
||||||
|
<property name="value_pos">left</property>
|
||||||
|
</widget>
|
||||||
|
<packing>
|
||||||
|
<property name="expand">True</property>
|
||||||
|
<property name="fill">True</property>
|
||||||
|
<property name="position">1</property>
|
||||||
|
</packing>
|
||||||
|
</child>
|
||||||
|
</widget>
|
||||||
|
<packing>
|
||||||
|
<property name="expand">False</property>
|
||||||
|
<property name="fill">False</property>
|
||||||
|
<property name="position">2</property>
|
||||||
|
</packing>
|
||||||
|
</child>
|
||||||
|
</widget>
|
||||||
|
</child>
|
||||||
|
</widget>
|
||||||
|
</glade-interface>
|
||||||
Loading…
Reference in New Issue
Block a user