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