From de5aba792e92e4c4f5056529de34a86d14412008 Mon Sep 17 00:00:00 2001
From: hasufell <hasufell@hasufell.de>
Date: Thu, 9 Oct 2014 18:45:37 +0200
Subject: [PATCH] Allow showing a grid

---
 Diagram.hs | 29 +++++++++++++++++++++++++----
 Gtk.hs     | 15 +++++++++++----
 gtk2.glade | 40 +++++++++++++++++++++++++++++++++++++++-
 3 files changed, 75 insertions(+), 9 deletions(-)

diff --git a/Diagram.hs b/Diagram.hs
index d7437b0..499cd7c 100644
--- a/Diagram.hs
+++ b/Diagram.hs
@@ -4,6 +4,7 @@ module Diagram (t,
                 dX,
                 dY,
                 alg,
+                gd,
                 defaultProp,
                 diag,
                 diagS,
@@ -39,7 +40,9 @@ data DiagProp = MkProp {
   -- |The dimensions of the y-axis.
   dY :: Coord,
   -- |Algorithm to use.
-  alg :: Int
+  alg :: Int,
+  -- |If we want to show the grid.
+  gd :: Bool
 }
 
 
@@ -57,7 +60,7 @@ instance Monoid Diag where
 
 -- |The default properties of the Diagram.
 defaultProp :: DiagProp
-defaultProp = MkProp 2 (0,500) (0,500) 0
+defaultProp = MkProp 2 (0,500) (0,500) 0 False
 
 
 -- |Extract the lower bound of the x-axis dimension.
@@ -177,12 +180,13 @@ whiteRectB = Diag f
 diag :: DiagProp -> [PT] -> Diagram Cairo R2
 diag p = case alg p of
   0 -> mkDiag
-         (mconcat [coordPoints, xAxis, yAxis, whiteRectB])
+         (mconcat [coordPoints, xAxis, yAxis,
+                   (if gd p then grid else mempty), whiteRectB])
          p
   1 -> mkDiag
          (mconcat $
            [convexHullPoints, convexHullLines, coordPoints,
-            xAxis, yAxis, whiteRectB])
+            xAxis, yAxis, (if gd p then grid else mempty), whiteRectB])
          p
   _ -> mempty
 
@@ -223,3 +227,20 @@ gifDiagS p = gifDiag p .
 -- |Create a white rectangle with the given width and height.
 whiteRect :: Double -> Double -> Diagram Cairo R2
 whiteRect x y = rect x y # lwG 0.00 # bg white
+
+
+-- |Create a grid across the whole diagram with 50*50 squares.
+grid :: Diag
+grid = Diag f `mappend` Diag g
+  where
+    f p _ = hcat' (with & sep .~ 50)
+              (take (floor . (/) (xuD p - xlD p) $ 50) .
+                repeat $ (vrule $ xuD p - xlD p))      #
+              moveTo (p2 (xlD p, (yuD p - ylD p) / 2)) #
+              lw ultraThin
+    g p _ = vcat' (with & sep .~ 50)
+              (take (floor . (/) (yuD p - ylD p) $ 50) .
+                repeat $ (hrule $ yuD p - ylD p))      #
+              alignB                                   #
+              moveTo (p2 ((xuD p - xlD p) / 2, ylD p)) #
+              lw ultraThin
diff --git a/Gtk.hs b/Gtk.hs
index a72fedf..2a438d5 100644
--- a/Gtk.hs
+++ b/Gtk.hs
@@ -45,7 +45,9 @@ data MyGUI = MkMyGUI {
   -- |about dialog
   aD  :: AboutDialog,
   -- |combo box for choosing the algorithm
-  cB  :: ComboBox
+  cB  :: ComboBox,
+  -- |grid check button
+  gC  :: CheckButton
 }
 
 
@@ -73,8 +75,9 @@ makeMyGladeGUI = do
   yu'  <- xmlGetWidget xml castToEntry "yuD"
   aD'  <- xmlGetWidget xml castToAboutDialog "aboutdialog"
   cB'  <- xmlGetWidget xml castToComboBox "comboalgo"
+  gC'  <- xmlGetWidget xml castToCheckButton "gridcheckbutton"
 
-  return $ MkMyGUI win' dB' sB' qB' fB' da' hs' xl' xu' yl' yu' aD' cB'
+  return $ MkMyGUI win' dB' sB' qB' fB' da' hs' xl' xu' yl' yu' aD' cB' gC'
 
 
 gifCLI :: FilePath -> IO ()
@@ -201,6 +204,7 @@ drawDiag' fp mygui =
       yuD'       <- entryGetText (yu mygui)
       alg'       <- comboBoxGetActive (cB mygui)
       (daW, daH) <- widgetGetSize (da mygui)
+      gd'        <- toggleButtonGetActive (gC mygui)
 
       let xD = (,) <$> readMaybe xlD' <*> readMaybe xuD' :: Maybe (Double,
                                                                  Double)
@@ -215,7 +219,8 @@ drawDiag' fp mygui =
                          (diagS (def{t  = scaleVal,
                                           dX = xD',
                                           dY = yD',
-                                          alg = alg'})
+                                          alg = alg',
+                                          gd = gd'})
                            mesh)
           renderWithDrawable dw r
           return 0
@@ -240,6 +245,7 @@ saveDiag' fp mygui =
       yuD'       <- entryGetText (yu mygui)
       alg'       <- comboBoxGetActive (cB mygui)
       (daW, daH) <- widgetGetSize (da mygui)
+      gd'        <- toggleButtonGetActive (gC mygui)
 
       let xD = (,) <$> readMaybe xlD' <*> readMaybe xuD' :: Maybe (Double,
                                                                  Double)
@@ -252,7 +258,8 @@ saveDiag' fp mygui =
             (diagS (def{t  = scaleVal,
                              dX = xD',
                              dY = yD',
-                             alg = alg'})
+                             alg = alg',
+                             gd = gd'})
               mesh)
           return 0
         _ -> return 1
diff --git a/gtk2.glade b/gtk2.glade
index 47ea24f..031534d 100644
--- a/gtk2.glade
+++ b/gtk2.glade
@@ -674,7 +674,7 @@ Malte Flender &lt;malte.flender@fh-bielefeld.de&gt;</property>
                   <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="adjustment">2 0.10000000000000001 10 0.5 0.5 0</property>
                     <property name="round_digits">1</property>
                     <property name="value_pos">left</property>
                   </widget>
@@ -691,6 +691,44 @@ Malte Flender &lt;malte.flender@fh-bielefeld.de&gt;</property>
                 <property name="position">2</property>
               </packing>
             </child>
+            <child>
+              <widget class="GtkVBox" id="vbox7">
+                <property name="width_request">100</property>
+                <property name="visible">True</property>
+                <property name="can_focus">False</property>
+                <child>
+                  <widget class="GtkLabel" id="label6">
+                    <property name="visible">True</property>
+                    <property name="can_focus">False</property>
+                    <property name="label" translatable="yes">options</property>
+                  </widget>
+                  <packing>
+                    <property name="expand">True</property>
+                    <property name="fill">True</property>
+                    <property name="position">0</property>
+                  </packing>
+                </child>
+                <child>
+                  <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">1</property>
+                  </packing>
+                </child>
+              </widget>
+              <packing>
+                <property name="expand">False</property>
+                <property name="fill">True</property>
+                <property name="position">3</property>
+              </packing>
+            </child>
           </widget>
           <packing>
             <property name="expand">False</property>