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 <malte.flender@fh-bielefeld.de>
True
True
- 1 0.10000000000000001 10 0.5 0.5 0
+ 2 0.10000000000000001 10 0.5 0.5 0
1
left
@@ -691,6 +691,44 @@ Malte Flender <malte.flender@fh-bielefeld.de>
2
+
+
+ 100
+ True
+ False
+
+
+ True
+ False
+ options
+
+
+ True
+ True
+ 0
+
+
+
+
+ grid
+ True
+ True
+ False
+ True
+
+
+ False
+ False
+ 1
+
+
+
+
+ False
+ True
+ 3
+
+
False