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