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 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 -- |Creates a Diagram that shows the coordinates from the VTable
-- as dots. The VTable and thickness of the dots can be controlled -- as dots. The VTable and thickness of the dots can be controlled
@ -97,7 +86,7 @@ showCoordinates = Diag f
where where
f p vt f p vt
= position (zip (filter (inRange (dX p) (dY p)) $ vt) = position (zip (filter (inRange (dX p) (dY p)) $ vt)
(repeat dot)) # moveTo (p2(xOffset p, yOffset p)) (repeat dot))
where where
-- a dot itself is a diagram -- a dot itself is a diagram
dot = (circle $ t p :: Diagram Cairo R2) # fc black dot = (circle $ t p :: Diagram Cairo R2) # fc black
@ -109,7 +98,7 @@ showConvexHullPoints = Diag f
where where
f p vt f p vt
= position (zip (filter (inRange (dX p) (dY p)) $ vtch) = position (zip (filter (inRange (dX p) (dY p)) $ vtch)
(repeat dot)) # moveTo (p2(xOffset p, yOffset p)) (repeat dot))
where where
-- a dot itself is a diagram -- a dot itself is a diagram
dot = (circle $ t p :: Diagram Cairo R2) # fc red # lc red dot = (circle $ t p :: Diagram Cairo R2) # fc red # lc red
@ -121,7 +110,7 @@ showConvexHullPoints = Diag f
showXAxis :: Diag showXAxis :: Diag
showXAxis = Diag f showXAxis = Diag f
where 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 -- |Creates a Diagram that shows an YAxis which is bound
@ -129,7 +118,7 @@ showXAxis = Diag f
showYAxis :: Diag showYAxis :: Diag
showYAxis = Diag f showYAxis = Diag f
where 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 -- |Creates a Diagram that shows a white rectangle which is a little
@ -137,7 +126,10 @@ showYAxis = Diag f
showWhiteRectB :: Diag showWhiteRectB :: Diag
showWhiteRectB = Diag f showWhiteRectB = Diag f
where 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. -- |Create the Diagram from the VTable.
@ -157,9 +149,9 @@ diag p = case alg p of
-- of an obj file. -- of an obj file.
diagS :: DiagProp -> String -> Diagram Cairo R2 diagS :: DiagProp -> String -> Diagram Cairo R2
diagS p mesh diagS p mesh
= diag p . = (diag p .
meshToArr $ meshToArr $
mesh mesh) # bg white
-- |Create a white rectangle with the given width and height. -- |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) ylD' <- entryGetText (yl mygui)
yuD' <- entryGetText (yu mygui) yuD' <- entryGetText (yu mygui)
alg' <- comboBoxGetActive (cB mygui) alg' <- comboBoxGetActive (cB mygui)
(daW, daH) <- widgetGetSize (da mygui)
-- clear drawing area
clearDiag mygui
let xD = (,) <$> readMaybe xlD' <*> readMaybe xuD' :: Maybe (Double, let xD = (,) <$> readMaybe xlD' <*> readMaybe xuD' :: Maybe (Double,
Double) Double)
@ -203,12 +201,14 @@ drawDiag' fp mygui =
case (xD, yD) of case (xD, yD) of
(Just xD', Just yD') -> do (Just xD', Just yD') -> do
let (_, r) = renderDia Cairo let (_, r) = renderDia Cairo
(CairoOptions "" (Width 600) SVG False) (CairoOptions ""
(Dims (fromIntegral daW) (fromIntegral daH))
SVG False)
(diagS (def{t = scaleVal, (diagS (def{t = scaleVal,
dX = xD', dX = xD',
dY = yD', dY = yD',
alg = alg'}) alg = alg'})
mesh) mesh)
renderWithDrawable dw r renderWithDrawable dw r
return 0 return 0
_ -> return 1 _ -> return 1
@ -226,11 +226,12 @@ saveDiag' fp mygui =
mesh <- readFile fp mesh <- readFile fp
adjustment <- rangeGetAdjustment (hs mygui) adjustment <- rangeGetAdjustment (hs mygui)
scaleVal <- adjustmentGetValue adjustment scaleVal <- adjustmentGetValue adjustment
xlD' <- entryGetText (xl mygui) xlD' <- entryGetText (xl mygui)
xuD' <- entryGetText (xu mygui) xuD' <- entryGetText (xu mygui)
ylD' <- entryGetText (yl mygui) ylD' <- entryGetText (yl mygui)
yuD' <- entryGetText (yu mygui) yuD' <- entryGetText (yu mygui)
alg' <- comboBoxGetActive (cB mygui) alg' <- comboBoxGetActive (cB mygui)
(daW, daH) <- widgetGetSize (da mygui)
let xD = (,) <$> readMaybe xlD' <*> readMaybe xuD' :: Maybe (Double, let xD = (,) <$> readMaybe xlD' <*> readMaybe xuD' :: Maybe (Double,
Double) Double)
@ -238,25 +239,14 @@ saveDiag' fp mygui =
Double) Double)
case (xD, yD) of case (xD, yD) of
(Just xD', Just yD') -> do (Just xD', Just yD') -> do
renderCairo "out.svg" (Width 600) renderCairo "out.svg"
(Dims (fromIntegral daW) (fromIntegral daH))
(diagS (def{t = scaleVal, (diagS (def{t = scaleVal,
dX = xD', dX = xD',
dY = yD', dY = yD',
alg = alg'}) alg = alg'})
mesh) mesh)
return 0 return 0
_ -> return 1 _ -> return 1
else return 2 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