Fix alignments/origins and correctly expand for the drawing widget

This commit is contained in:
hasufell 2014-10-08 19:23:15 +02:00
parent 8458841182
commit 85a00951ba
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
2 changed files with 23 additions and 41 deletions

View File

@ -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.

36
Gtk.hs
View File

@ -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