From 85a00951ba96cf88f7bf6ba603bf8a339caf7880 Mon Sep 17 00:00:00 2001
From: hasufell <hasufell@hasufell.de>
Date: Wed, 8 Oct 2014 19:23:15 +0200
Subject: [PATCH] Fix alignments/origins and correctly expand for the drawing
 widget

---
 Diagram.hs | 28 ++++++++++------------------
 Gtk.hs     | 36 +++++++++++++-----------------------
 2 files changed, 23 insertions(+), 41 deletions(-)

diff --git a/Diagram.hs b/Diagram.hs
index 673cc87..c3ac9b3 100644
--- a/Diagram.hs
+++ b/Diagram.hs
@@ -77,17 +77,6 @@ yuD :: DiagProp -> Double
 yuD = snd . dY
 
 
--- |The X offset to move coordinates to the right
--- position depending on the X dimensions.
-xOffset :: DiagProp -> Double
-xOffset p = (negate (xlD p) / 2) - (xuD p / 2)
-
-
--- |The Y offset to move coordinates to the right
--- position depending on the X dimensions.
-yOffset :: DiagProp -> Double
-yOffset p = (negate (ylD p) / 2) - (yuD p / 2)
-
 
 -- |Creates a Diagram that shows the coordinates from the VTable
 -- as dots. The VTable and thickness of the dots can be controlled
@@ -97,7 +86,7 @@ showCoordinates = Diag f
   where
     f p vt
       = position (zip (filter (inRange (dX p) (dY p)) $ vt)
-                      (repeat dot))   # moveTo (p2(xOffset p, yOffset p))
+                      (repeat dot))
             where
               -- a dot itself is a diagram
               dot = (circle $ t p :: Diagram Cairo R2) # fc black
@@ -109,7 +98,7 @@ showConvexHullPoints = Diag f
   where
     f p vt
       = position (zip (filter (inRange (dX p) (dY p)) $ vtch)
-                      (repeat dot))   # moveTo (p2(xOffset p, yOffset p))
+                      (repeat dot))
             where
               -- a dot itself is a diagram
               dot = (circle $ t p :: Diagram Cairo R2) # fc red # lc red
@@ -121,7 +110,7 @@ showConvexHullPoints = Diag f
 showXAxis :: Diag
 showXAxis = Diag f
   where
-    f p _ = hrule (xuD p - xlD p) # moveTo (p2(0, yOffset p))
+    f p _ = (strokeTrail . fromVertices $ [p2 (xlD p,0), p2 (xuD p, 0)]) # moveTo (p2 (xlD p,0))
 
 
 -- |Creates a Diagram that shows an YAxis which is bound
@@ -129,7 +118,7 @@ showXAxis = Diag f
 showYAxis :: Diag
 showYAxis = Diag f
   where
-    f p _ = vrule (yuD p - ylD p) # moveTo (p2(xOffset p, 0))
+    f p _ = strokeTrail . fromVertices $ [p2 (0, ylD p), p2 (0, yuD p)] # moveTo (p2 (0, ylD p))
 
 
 -- |Creates a Diagram that shows a white rectangle which is a little
@@ -137,7 +126,10 @@ showYAxis = Diag f
 showWhiteRectB :: Diag
 showWhiteRectB = Diag f
   where
-    f p _ = whiteRect (xuD p - xlD p + 50) (yuD p - ylD p + 50)
+    f p _ = whiteRect (w' + 50) (h' + 50) # moveTo (p2 (w' / 2, h' / 2))
+      where
+        w' = xuD p - xlD p
+        h' = yuD p - ylD p
 
 
 -- |Create the Diagram from the VTable.
@@ -157,9 +149,9 @@ diag p = case alg p of
 -- of an obj file.
 diagS :: DiagProp -> String -> Diagram Cairo R2
 diagS p mesh
-  = diag p      .
+  = (diag p      .
       meshToArr $
-      mesh
+      mesh) # bg white
 
 
 -- |Create a white rectangle with the given width and height.
diff --git a/Gtk.hs b/Gtk.hs
index f86b2d3..51c45a3 100644
--- a/Gtk.hs
+++ b/Gtk.hs
@@ -192,9 +192,7 @@ drawDiag' fp mygui =
       ylD'       <- entryGetText (yl mygui)
       yuD'       <- entryGetText (yu mygui)
       alg'       <- comboBoxGetActive (cB mygui)
-
-      -- clear drawing area
-      clearDiag mygui
+      (daW, daH) <- widgetGetSize (da mygui)
 
       let xD = (,) <$> readMaybe xlD' <*> readMaybe xuD' :: Maybe (Double,
                                                                  Double)
@@ -203,12 +201,14 @@ drawDiag' fp mygui =
       case (xD, yD) of
         (Just xD', Just yD') -> do
           let (_, r) = renderDia Cairo
-                         (CairoOptions "" (Width 600) SVG False)
+                         (CairoOptions ""
+                           (Dims (fromIntegral daW) (fromIntegral daH))
+                           SVG False)
                          (diagS (def{t  = scaleVal,
                                           dX = xD',
                                           dY = yD',
                                           alg = alg'})
-                                 mesh)
+                           mesh)
           renderWithDrawable dw r
           return 0
         _ -> return 1
@@ -226,11 +226,12 @@ saveDiag' fp mygui =
       mesh       <- readFile fp
       adjustment <- rangeGetAdjustment (hs mygui)
       scaleVal   <- adjustmentGetValue adjustment
-      xlD'        <- entryGetText (xl mygui)
-      xuD'        <- entryGetText (xu mygui)
-      ylD'        <- entryGetText (yl mygui)
-      yuD'        <- entryGetText (yu mygui)
+      xlD'       <- entryGetText (xl mygui)
+      xuD'       <- entryGetText (xu mygui)
+      ylD'       <- entryGetText (yl mygui)
+      yuD'       <- entryGetText (yu mygui)
       alg'       <- comboBoxGetActive (cB mygui)
+      (daW, daH) <- widgetGetSize (da mygui)
 
       let xD = (,) <$> readMaybe xlD' <*> readMaybe xuD' :: Maybe (Double,
                                                                  Double)
@@ -238,25 +239,14 @@ saveDiag' fp mygui =
                                                                  Double)
       case (xD, yD) of
         (Just xD', Just yD') -> do
-          renderCairo "out.svg" (Width 600)
+          renderCairo "out.svg"
+            (Dims (fromIntegral daW) (fromIntegral daH))
             (diagS (def{t  = scaleVal,
                              dX = xD',
                              dY = yD',
                              alg = alg'})
-                    mesh)
+              mesh)
           return 0
         _ -> return 1
 
     else return 2
-
-
--- |Clears the drawing area by painting a white rectangle.
-clearDiag :: MyGUI
-          -> IO ()
-clearDiag mygui = do
-  dw <- widgetGetDrawWindow (da mygui)
-
-  let (_, r) = renderDia Cairo
-               (CairoOptions "" (Width 600) SVG False)
-               (whiteRect 600 600)
-  renderWithDrawable dw r