Refactor GUI API

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
+  -- get GUI object
-  Just xml   <- xmlNew gladeFile
+  mygui <- makeMyGladeGUI
-  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"
 
   -- 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
+  _ <- onDestroy (win mygui) mainQuit
-  _ <- onClicked drawButton $ onClickedDrawButton fileButton
+  _ <- onClicked (dB mygui) $ onClickedDrawButton mygui
-         da hscale (xlDE, xlUE) (ylDE, ylUE)
+  _ <- onClicked (sB mygui) $ onClickedSaveButton mygui
-  _ <- onClicked saveButton $ onClickedSaveButton fileButton
+  _ <- onClicked (qB mygui) mainQuit
-         hscale (xlDE, xlUE) (ylDE, ylUE)
-  _ <- onClicked quitButton 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
+         liftIO $ onClickedSaveButton mygui
-           hscale (xlDE, xlUE) (ylDE, ylUE)
+  _ <- win mygui `on` keyPressEvent $ tryEvent $ do
-  _ <- window `on` keyPressEvent $ tryEvent $ do
          [Control] <- eventModifier
          "d"       <- eventKeyName
-         liftIO $ onClickedDrawButton fileButton da hscale
+         liftIO $ onClickedDrawButton mygui
-           (xlDE, xlUE) (ylDE, ylUE)
 
   -- draw widgets and start main loop
-  widgetShowAll window
+  widgetShowAll (win mygui)
   mainGUI
 
 
 -- |Callback when the "Draw" Button is clicked.
-onClickedDrawButton :: (WidgetClass widget, RangeClass scale)
+onClickedDrawButton :: MyGUI
-                    => FileChooserButton
-                    -> widget
-                    -> scale
-                    -> (Entry, Entry)
-                    -> (Entry, Entry)
                     -> 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
+onClickedSaveButton :: MyGUI
-                    => FileChooserButton
-                    -> scale
-                    -> (Entry, Entry)
-                    -> (Entry, Entry)
                     -> IO ()
-onClickedSaveButton fcb scale' dXE dYE = do
+onClickedSaveButton mygui = do
-  filename <- fileChooserGetFilename fcb
+  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)
+drawDiag' :: FilePath
-          => FilePath
+          -> MyGUI
-          -> widget
-          -> scale
-          -> (Entry, Entry)
-          -> (Entry, Entry)
           -> IO Bool
-drawDiag' fp da scale' dXE dYE =
+drawDiag' fp mygui =
   if cmpExt "obj" fp
     then do
       mesh       <- readFile fp
-      dw         <- widgetGetDrawWindow da
+      dw         <- widgetGetDrawWindow (da mygui)
-      adjustment <- rangeGetAdjustment scale'
+      adjustment <- rangeGetAdjustment (hs mygui)
       scaleVal   <- adjustmentGetValue adjustment
-      xlD        <- entryGetText $ fst dXE
+      xlD        <- entryGetText (xl mygui)
-      xlU        <- entryGetText $ snd dXE
+      xuD        <- entryGetText (xu mygui)
-      ylD        <- entryGetText $ fst dYE
+      ylD        <- entryGetText (yl mygui)
-      ylU        <- entryGetText $ snd dYE
+      yuD        <- entryGetText (yu mygui)
 
       -- clear drawing area
-      clearDiag da
+      clearDiag mygui
 
-      let xD     = (read xlD, read xlU) :: (Double, Double)
+      let xD     = (read xlD, read xuD) :: (Double, Double)
-          yD     = (read ylD, read ylU) :: (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
+saveDiag' :: FilePath
-          => FilePath
+          -> MyGUI
-          -> scale
-          -> (Entry, Entry)
-          -> (Entry, Entry)
           -> 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
+      xlD        <- entryGetText (xl mygui)
-      xlU        <- entryGetText $ snd dXE
+      xuD        <- entryGetText (xu mygui)
-      ylD        <- entryGetText $ fst dYE
+      ylD        <- entryGetText (yl mygui)
-      ylU        <- entryGetText $ snd dYE
+      yuD        <- entryGetText (yu mygui)
 
-      let xD     = (read xlD, read xlU) :: (Double, Double)
+      let xD     = (read xlD, read xuD) :: (Double, Double)
-          yD     = (read ylD, read ylU) :: (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
+clearDiag :: MyGUI
-          => widget
           -> IO ()
-clearDiag da = do
+clearDiag mygui = do
-  dw <- widgetGetDrawWindow da
+  dw <- widgetGetDrawWindow (da mygui)
 
   let (_, r) = renderDia Cairo
                (CairoOptions "" (Width 600) SVG False)

gtk2.glade

@@ -153,7 +153,7 @@
                       </packing>
                     </child>
                     <child>
-                      <widget class="GtkEntry" id="xlU">
+                      <widget class="GtkEntry" id="xuD">
                         <property name="width_request">5</property>
                         <property name="visible">True</property>
                         <property name="can_focus">True</property>
@@ -248,7 +248,7 @@
                       </packing>
                     </child>
                     <child>
-                      <widget class="GtkEntry" id="ylU">
+                      <widget class="GtkEntry" id="yuD">
                         <property name="width_request">5</property>
                         <property name="visible">True</property>
                         <property name="can_focus">True</property>