diff --git a/Gtk.hs b/Gtk.hs
index 4e48e08..4e22758 100644
--- a/Gtk.hs
+++ b/Gtk.hs
@@ -13,9 +13,46 @@ import System.Directory
import Util
+data MyGUI = MkMyGUI {
+ win :: Window,
+ dB :: Button,
+ sB :: Button,
+ qB :: Button,
+ fB :: FileChooserButton,
+ da :: DrawingArea,
+ hs :: HScale,
+ xl :: Entry,
+ xu :: Entry,
+ yl :: Entry,
+ yu :: Entry
+}
+
+
gladeFile :: FilePath
gladeFile = "gtk2.glade"
+
+-- |Loads the glade file and creates the MyGUI object.
+makeMyGladeGUI :: IO MyGUI
+makeMyGladeGUI = do
+ -- load glade file
+ Just xml <- xmlNew gladeFile
+ win' <- xmlGetWidget xml castToWindow "window1"
+ dB' <- xmlGetWidget xml castToButton "drawButton"
+ sB' <- xmlGetWidget xml castToButton "saveButton"
+ qB' <- xmlGetWidget xml castToButton "quitButton"
+ fB' <- xmlGetWidget xml castToFileChooserButton
+ "filechooserButton"
+ da' <- xmlGetWidget xml castToDrawingArea "drawingarea"
+ hs' <- xmlGetWidget xml castToHScale "hscale"
+ xl' <- xmlGetWidget xml castToEntry "xlD"
+ xu' <- xmlGetWidget xml castToEntry "xuD"
+ yl' <- xmlGetWidget xml castToEntry "ylD"
+ yu' <- xmlGetWidget xml castToEntry "yuD"
+
+ return $ MkMyGUI win' dB' sB' qB' fB' da' hs' xl' xu' yl' yu'
+
+
-- |Handle the whole GTK gui.
makeGUI :: FilePath -> IO ()
makeGUI startFile = do
@@ -24,90 +61,66 @@ makeGUI startFile = do
-- init gui
_ <- initGUI
- -- load glade file
- Just xml <- xmlNew gladeFile
- window <- xmlGetWidget xml castToWindow "window1"
- drawButton <- xmlGetWidget xml castToButton "drawButton"
- saveButton <- xmlGetWidget xml castToButton "saveButton"
- quitButton <- xmlGetWidget xml castToButton "quitButton"
- fileButton <- xmlGetWidget xml castToFileChooserButton
- "filechooserButton"
- da <- xmlGetWidget xml castToDrawingArea "drawingarea"
- hscale <- xmlGetWidget xml castToHScale "hscale"
- xlDE <- xmlGetWidget xml castToEntry "xlD"
- xlUE <- xmlGetWidget xml castToEntry "xlU"
- ylDE <- xmlGetWidget xml castToEntry "ylD"
- ylUE <- xmlGetWidget xml castToEntry "ylU"
+ -- get GUI object
+ mygui <- makeMyGladeGUI
-- adjust properties
if startFile == ""
then do
- _ <- fileChooserSetCurrentFolder fileButton homedir
+ _ <- fileChooserSetCurrentFolder (fB mygui) homedir
return ()
else do
- _ <- fileChooserSetFilename fileButton startFile
+ _ <- fileChooserSetFilename (fB mygui) startFile
return ()
-- callbacks
- _ <- onDestroy window mainQuit
- _ <- onClicked drawButton $ onClickedDrawButton fileButton
- da hscale (xlDE, xlUE) (ylDE, ylUE)
- _ <- onClicked saveButton $ onClickedSaveButton fileButton
- hscale (xlDE, xlUE) (ylDE, ylUE)
- _ <- onClicked quitButton mainQuit
+ _ <- onDestroy (win mygui) mainQuit
+ _ <- onClicked (dB mygui) $ onClickedDrawButton mygui
+ _ <- onClicked (sB mygui) $ onClickedSaveButton mygui
+ _ <- onClicked (qB mygui) mainQuit
-- hotkeys
- _ <- window `on` keyPressEvent $ tryEvent $ do
+ _ <- win mygui `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"q" <- eventKeyName
liftIO mainQuit
- _ <- window `on` keyPressEvent $ tryEvent $ do
+ _ <- win mygui `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"s" <- eventKeyName
- liftIO $ onClickedSaveButton fileButton
- hscale (xlDE, xlUE) (ylDE, ylUE)
- _ <- window `on` keyPressEvent $ tryEvent $ do
+ liftIO $ onClickedSaveButton mygui
+ _ <- win mygui `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"d" <- eventKeyName
- liftIO $ onClickedDrawButton fileButton da hscale
- (xlDE, xlUE) (ylDE, ylUE)
+ liftIO $ onClickedDrawButton mygui
-- draw widgets and start main loop
- widgetShowAll window
+ widgetShowAll (win mygui)
mainGUI
-- |Callback when the "Draw" Button is clicked.
-onClickedDrawButton :: (WidgetClass widget, RangeClass scale)
- => FileChooserButton
- -> widget
- -> scale
- -> (Entry, Entry)
- -> (Entry, Entry)
+onClickedDrawButton :: MyGUI
-> IO ()
-onClickedDrawButton fcb da scale' dXE dYE = do
+onClickedDrawButton mygui = do
+ let fcb = fB mygui
filename <- fileChooserGetFilename fcb
case filename of
Just x -> do
- cId <- onExpose da (\_ -> drawDiag' x da scale' dXE dYE)
+ cId <- onExpose (da mygui) (\_ -> drawDiag' x mygui)
_ <- on fcb fileActivated (signalDisconnect cId)
- ret <- drawDiag' x da scale' dXE dYE
+ ret <- drawDiag' x mygui
unless ret $ showErrorDialog "No valid Mesh file!"
Nothing -> showErrorDialog "No valid Mesh file!"
-- |Callback when the "Save" Button is clicked.
-onClickedSaveButton :: RangeClass scale
- => FileChooserButton
- -> scale
- -> (Entry, Entry)
- -> (Entry, Entry)
+onClickedSaveButton :: MyGUI
-> IO ()
-onClickedSaveButton fcb scale' dXE dYE = do
- filename <- fileChooserGetFilename fcb
+onClickedSaveButton mygui = do
+ filename <- fileChooserGetFilename (fB mygui)
case filename of
Just x -> do
- ret <- saveDiag' x scale' dXE dYE
+ ret <- saveDiag' x mygui
unless ret $ showErrorDialog "No valid Mesh file!"
Nothing -> showErrorDialog "No valid Mesh file!"
@@ -126,30 +139,26 @@ showErrorDialog str = do
-- |Draws a Diagram which is built from a given file to
-- the gtk DrawingArea.
-drawDiag' :: (WidgetClass widget, RangeClass scale)
- => FilePath
- -> widget
- -> scale
- -> (Entry, Entry)
- -> (Entry, Entry)
+drawDiag' :: FilePath
+ -> MyGUI
-> IO Bool
-drawDiag' fp da scale' dXE dYE =
+drawDiag' fp mygui =
if cmpExt "obj" fp
then do
mesh <- readFile fp
- dw <- widgetGetDrawWindow da
- adjustment <- rangeGetAdjustment scale'
+ dw <- widgetGetDrawWindow (da mygui)
+ adjustment <- rangeGetAdjustment (hs mygui)
scaleVal <- adjustmentGetValue adjustment
- xlD <- entryGetText $ fst dXE
- xlU <- entryGetText $ snd dXE
- ylD <- entryGetText $ fst dYE
- ylU <- entryGetText $ snd dYE
+ xlD <- entryGetText (xl mygui)
+ xuD <- entryGetText (xu mygui)
+ ylD <- entryGetText (yl mygui)
+ yuD <- entryGetText (yu mygui)
-- clear drawing area
- clearDiag da
+ clearDiag mygui
- let xD = (read xlD, read xlU) :: (Double, Double)
- yD = (read ylD, read ylU) :: (Double, Double)
+ let xD = (read xlD, read xuD) :: (Double, Double)
+ yD = (read ylD, read yuD) :: (Double, Double)
(_, r) = renderDia Cairo
(CairoOptions "" (Width 600) SVG False)
(diagFromString (def{t = scaleVal,
@@ -162,25 +171,22 @@ drawDiag' fp da scale' dXE dYE =
-- |Saves a Diagram which is built from a given file as an SVG.
-saveDiag' :: RangeClass scale
- => FilePath
- -> scale
- -> (Entry, Entry)
- -> (Entry, Entry)
+saveDiag' :: FilePath
+ -> MyGUI
-> IO Bool
-saveDiag' fp scale' dXE dYE =
+saveDiag' fp mygui =
if cmpExt "obj" fp
then do
mesh <- readFile fp
- adjustment <- rangeGetAdjustment scale'
+ adjustment <- rangeGetAdjustment (hs mygui)
scaleVal <- adjustmentGetValue adjustment
- xlD <- entryGetText $ fst dXE
- xlU <- entryGetText $ snd dXE
- ylD <- entryGetText $ fst dYE
- ylU <- entryGetText $ snd dYE
+ xlD <- entryGetText (xl mygui)
+ xuD <- entryGetText (xu mygui)
+ ylD <- entryGetText (yl mygui)
+ yuD <- entryGetText (yu mygui)
- let xD = (read xlD, read xlU) :: (Double, Double)
- yD = (read ylD, read ylU) :: (Double, Double)
+ let xD = (read xlD, read xuD) :: (Double, Double)
+ yD = (read ylD, read yuD) :: (Double, Double)
renderCairo "out.svg" (Width 600)
(diagFromString (def{t = scaleVal,
dX = xD,
@@ -191,11 +197,10 @@ saveDiag' fp scale' dXE dYE =
-- |Clears the drawing area by painting a white rectangle.
-clearDiag :: WidgetClass widget
- => widget
+clearDiag :: MyGUI
-> IO ()
-clearDiag da = do
- dw <- widgetGetDrawWindow da
+clearDiag mygui = do
+ dw <- widgetGetDrawWindow (da mygui)
let (_, r) = renderDia Cairo
(CairoOptions "" (Width 600) SVG False)
diff --git a/gtk2.glade b/gtk2.glade
index e84434c..b9f16e5 100644
--- a/gtk2.glade
+++ b/gtk2.glade
@@ -153,7 +153,7 @@
-
+
5
True
True
@@ -248,7 +248,7 @@
-
+
5
True
True