Allow showing the coordinate points as text

Diagram.hs

@@ -5,6 +5,7 @@ module Diagram (t,
                 dY,
                 alg,
                 gd,
+                ct,
                 defaultProp,
                 diag,
                 diagS,
@@ -47,6 +48,8 @@ data DiagProp = MkProp {
   alg :: Int,
   -- |If we want to show the grid.
   gd :: Bool,
+  -- |If we want to show the coordinates as text.
+  ct :: Bool,
   -- |Square size used to show the grid and x/y-axis.
   sqS :: Double
 }
@@ -66,7 +69,7 @@ instance Monoid Diag where
 
 -- |The default properties of the Diagram.
 defaultProp :: DiagProp
-defaultProp = MkProp 2 (0,500) (0,500) 0 False 50
+defaultProp = MkProp 2 (0,500) (0,500) 0 False False 50
 
 
 -- |Extract the lower bound of the x-axis dimension.
@@ -102,6 +105,19 @@ coordPoints = Diag cp
         dot = (circle $ t p :: Diagram Cairo R2) # fc black
 
 
+coordPointsText :: Diag
+coordPointsText = Diag cpt
+  where
+    cpt _ vt =
+      position $
+        zip vt
+            ((\(x, y) -> (flip (<>) (square 1 # lw none) .
+              text $ ("(" ++ show x ++ ", " ++ show y ++ ")")) #
+              scale 10 # translate (r2 (0, 10))) <$>
+              unp2 <$>
+              vt)
+
+
 -- |Create a diagram which shows the points of the convex hull.
 convexHullPoints :: Diag
 convexHullPoints = Diag chp
@@ -114,6 +130,22 @@ convexHullPoints = Diag chp
         vtch = grahamGetCH vt
 
 
+-- |Create a diagram which shows the points of the convex hull.
+convexHullPointsText :: Diag
+convexHullPointsText = Diag chpt
+  where
+    chpt _ vt =
+      position $
+        zip vtch
+            ((\(x, y) -> (flip (<>) (square 1 # lw none) .
+              text $ ("(" ++ show x ++ ", " ++ show y ++ ")")) #
+              scale 10 # translate (r2 (0, 10))) <$>
+              unp2 <$>
+              vtch)
+      where
+        vtch = grahamGetCH vt
+
+
 -- |Create a diagram which shows the lines along the convex hull
 -- points.
 convexHullLines :: Diag
@@ -220,14 +252,17 @@ diag :: DiagProp -> [PT] -> Diagram Cairo R2
 diag p = case alg p of
   0 ->
     mkDiag
-      (mconcat [coordPoints, xAxis, yAxis,
+      (mconcat [if ct p then coordPointsText else mempty,
-        (if gd p then grid else mempty), whiteRectB])
+        coordPoints, xAxis, yAxis,
+        (if gd p then grid else mempty),whiteRectB])
       p
   1 ->
     mkDiag
       (mconcat
-        [convexHullPoints, convexHullLines, coordPoints,
+        [if ct p then convexHullPointsText else mempty,
-        xAxis, yAxis, (if gd p then grid else mempty), whiteRectB])
+        convexHullPoints, convexHullLines,
+        coordPoints, xAxis, yAxis,
+        (if gd p then grid else mempty), whiteRectB])
       p
   _ -> mempty
 

Gtk.hs

@@ -15,6 +15,7 @@ import System.Directory
 import Text.Read
 import OS.FileExt
 
+
 -- |Monolithic object passed to various GUI functions in order
 -- to keep the API stable and not alter the parameters too much.
 -- This only holds GUI widgets that are needed to be read during
@@ -47,7 +48,9 @@ data MyGUI = MkMyGUI {
   -- |combo box for choosing the algorithm
   cB  :: ComboBox,
   -- |grid check button
-  gC  :: CheckButton
+  gC  :: CheckButton,
+    -- |coord check button
+  cC  :: CheckButton
 }
 
 
@@ -76,13 +79,14 @@ makeMyGladeGUI = do
   aD'  <- xmlGetWidget xml castToAboutDialog "aboutdialog"
   cB'  <- xmlGetWidget xml castToComboBox "comboalgo"
   gC'  <- xmlGetWidget xml castToCheckButton "gridcheckbutton"
+  cC'  <- xmlGetWidget xml castToCheckButton "coordcheckbutton"
 
   return $ MkMyGUI win' dB' sB' qB' fB' da' hs'
-                   xl' xu' yl' yu' aD' cB' gC'
+                   xl' xu' yl' yu' aD' cB' gC' cC'
 
 
 gifCLI :: FilePath -> IO ()
-gifCLI startFile = do
+gifCLI _ = do
   mesh <- readFile "UB1_sonderfaelle.obj"
   gifMain (gifDiagS def mesh)
 
@@ -206,6 +210,7 @@ drawDiag' fp mygui =
       alg'       <- comboBoxGetActive (cB mygui)
       (daW, daH) <- widgetGetSize (da mygui)
       gd'        <- toggleButtonGetActive (gC mygui)
+      ct'        <- toggleButtonGetActive (cC mygui)
 
       let
         xD = (,)         <$>
@@ -226,7 +231,8 @@ drawDiag' fp mygui =
                     dX  = xD',
                     dY  = yD',
                     alg = alg',
-                    gd  = gd'})
+                    gd  = gd',
+                    ct  = ct'})
                   mesh)
           renderWithDrawable dw r
           return 0
@@ -252,6 +258,7 @@ saveDiag' fp mygui =
       alg'       <- comboBoxGetActive (cB mygui)
       (daW, daH) <- widgetGetSize (da mygui)
       gd'        <- toggleButtonGetActive (gC mygui)
+      ct'        <- toggleButtonGetActive (cC mygui)
 
       let
         xD = (,)         <$>
@@ -269,7 +276,8 @@ saveDiag' fp mygui =
                 dX  = xD',
                 dY  = yD',
                 alg = alg',
-                gd  = gd'})
+                gd  = gd',
+                ct  = ct'})
               mesh)
           return 0
         _ -> return 1

gtk2.glade

@@ -692,8 +692,7 @@ Malte Flender &lt;malte.flender@fh-bielefeld.de&gt;</property>
               </packing>
             </child>
             <child>
-              <widget class="GtkVBox" id="vbox7">
+              <widget class="GtkVBox" id="vbox8">
-                <property name="width_request">100</property>
                 <property name="visible">True</property>
                 <property name="can_focus">False</property>
                 <child>
@@ -709,23 +708,48 @@ Malte Flender &lt;malte.flender@fh-bielefeld.de&gt;</property>
                   </packing>
                 </child>
                 <child>
-                  <widget class="GtkCheckButton" id="gridcheckbutton">
+                  <widget class="GtkHBox" id="hbox6">
-                    <property name="label" translatable="yes">grid</property>
                     <property name="visible">True</property>
-                    <property name="can_focus">True</property>
+                    <property name="can_focus">False</property>
-                    <property name="receives_default">False</property>
+                    <child>
-                    <property name="draw_indicator">True</property>
+                      <widget class="GtkCheckButton" id="gridcheckbutton">
+                        <property name="label" translatable="yes">grid</property>
+                        <property name="visible">True</property>
+                        <property name="can_focus">True</property>
+                        <property name="receives_default">False</property>
+                        <property name="draw_indicator">True</property>
+                      </widget>
+                      <packing>
+                        <property name="expand">False</property>
+                        <property name="fill">False</property>
+                        <property name="position">0</property>
+                      </packing>
+                    </child>
+                    <child>
+                      <widget class="GtkCheckButton" id="coordcheckbutton">
+                        <property name="label" translatable="yes">coord</property>
+                        <property name="visible">True</property>
+                        <property name="can_focus">True</property>
+                        <property name="receives_default">False</property>
+                        <property name="draw_indicator">True</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="expand">True</property>
-                    <property name="fill">False</property>
+                    <property name="fill">True</property>
                     <property name="position">1</property>
                   </packing>
                 </child>
               </widget>
               <packing>
                 <property name="expand">False</property>
-                <property name="fill">True</property>
+                <property name="fill">False</property>
                 <property name="position">3</property>
               </packing>
             </child>