hasufell/cga
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Refactor some function names for readability

Browse Source
This commit is contained in:
hasufell 2014-11-16 00:10:57 +01:00
parent bf596a5842
commit 3f3467cc44
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
4 changed files with 166 additions and 168 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

176
GUI/Gtk.hs
View File

@ -3,7 +3,7 @@
module GUI.Gtk (makeGUI) where
import Control.Applicative
import Control.Monad
import Control.Monad(unless)
import Control.Monad.IO.Class
import Diagrams.Prelude
import Diagrams.Backend.Cairo
@ -24,41 +24,41 @@ import Text.Read
-- runtime.
data MyGUI = MkMyGUI {
-- |main Window
win :: Window,
rootWin :: Window,
-- |Tree Window
winT :: Window,
treeWin :: Window,
-- |delete Button
dB :: Button,
delButton :: Button,
-- |save Button
sB :: Button,
saveButton :: Button,
-- |quit Button
qB :: Button,
quitButton :: Button,
-- |file chooser button
fB :: FileChooserButton,
fileButton :: FileChooserButton,
-- |drawing area
da :: DrawingArea,
mainDraw :: DrawingArea,
-- |drawing area for the tree
daT :: DrawingArea,
treeDraw :: DrawingArea,
-- |scaler for point thickness
hs :: HScale,
ptScale :: HScale,
-- |entry widget for lower x bound
xl :: Entry,
xminEntry :: Entry,
-- |entry widget for upper x bound
xu :: Entry,
xmaxEntry :: Entry,
-- |entry widget for lower y bound
yl :: Entry,
yminEntry :: Entry,
-- |entry widget for upper y bound
yu :: Entry,
ymaxEntry :: Entry,
-- |about dialog
aD :: AboutDialog,
aboutDialog :: AboutDialog,
-- |combo box for choosing the algorithm
cB :: ComboBox,
algoBox :: ComboBox,
-- |grid check button
gC :: CheckButton,
gridCheckBox :: CheckButton,
-- |coord check button
cC :: CheckButton,
coordCheckBox :: CheckButton,
-- |Path entry widget for the quad tree.
pE :: Entry,
quadPathEntry :: Entry,
-- |Horizontal box containing the path entry widget.
vbox7 :: Box
}
@ -112,58 +112,58 @@ makeGUI startFile = do
-- adjust properties
if startFile == ""
then do
_ <- fileChooserSetCurrentFolder (fB mygui) homedir
_ <- fileChooserSetCurrentFolder (fileButton mygui) homedir
return ()
else do
_ <- fileChooserSetFilename (fB mygui) startFile
_ <- fileChooserSetFilename (fileButton mygui) startFile
return ()
comboBoxSetActive (cB mygui) 0
comboBoxSetActive (algoBox mygui) 0
-- callbacks
_ <- onDestroy (win mygui) mainQuit
_ <- onClicked (dB mygui) $ drawDiag mygui
_ <- onClicked (sB mygui) $ saveDiag mygui
_ <- onClicked (qB mygui) mainQuit
_ <- onResponse (aD mygui) (\x -> case x of
ResponseCancel -> widgetHideAll (aD mygui)
_ <- onDestroy (rootWin mygui) mainQuit
_ <- onClicked (delButton mygui) $ drawDiag mygui
_ <- onClicked (saveButton mygui) $ saveDiag mygui
_ <- onClicked (quitButton mygui) mainQuit
_ <- onResponse (aboutDialog mygui) (\x -> case x of
ResponseCancel -> widgetHideAll (aboutDialog mygui)
_ -> return ())
-- have to redraw for window overlapping and resizing on expose
_ <- onExpose (da mygui) (\_ -> drawDiag mygui >>=
_ <- onExpose (mainDraw mygui) (\_ -> drawDiag mygui >>=
(\_ -> return True))
_ <- onExpose (daT mygui) (\_ -> drawDiag mygui >>=
_ <- onExpose (treeDraw mygui) (\_ -> drawDiag mygui >>=
(\_ -> return True))
_ <- on (cB mygui) changed (drawDiag mygui)
_ <- on (cB mygui) changed (onPathWidgetChange mygui)
_ <- on (gC mygui) toggled (drawDiag mygui)
_ <- on (cC mygui) toggled (drawDiag mygui)
_ <- on (algoBox mygui) changed (drawDiag mygui)
_ <- on (algoBox mygui) changed (onAlgoBoxChange mygui)
_ <- on (gridCheckBox mygui) toggled (drawDiag mygui)
_ <- on (coordCheckBox mygui) toggled (drawDiag mygui)
-- hotkeys
_ <- win mygui `on` keyPressEvent $ tryEvent $ do
_ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"q" <- eventKeyName
liftIO mainQuit
_ <- winT mygui `on` keyPressEvent $ tryEvent $ do
_ <- treeWin mygui `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"q" <- eventKeyName
liftIO (widgetHide $ winT mygui)
_ <- win mygui `on` keyPressEvent $ tryEvent $ do
liftIO (widgetHide $ treeWin mygui)
_ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"s" <- eventKeyName
liftIO $ saveDiag mygui
_ <- win mygui `on` keyPressEvent $ tryEvent $ do
_ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"d" <- eventKeyName
liftIO $ drawDiag mygui
_ <- win mygui `on` keyPressEvent $ tryEvent $ do
_ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
[Control] <- eventModifier
"a" <- eventKeyName
liftIO $ widgetShowAll (aD mygui)
liftIO $ widgetShowAll (aboutDialog mygui)
-- draw widgets and start main loop
widgetShowAll (win mygui)
widgetShowAll (winT mygui)
widgetShowAll (rootWin mygui)
widgetShowAll (treeWin mygui)
widgetHide (vbox7 mygui)
widgetHide (winT mygui)
widgetHide (treeWin mygui)
mainGUI
@ -181,14 +181,14 @@ showErrorDialog str = do
-- |May hide or show the widget that holds the quad tree path entry,
-- depending on the context and may also pop up the tree window.
onPathWidgetChange :: MyGUI
-> IO ()
onPathWidgetChange mygui = do
item <- comboBoxGetActive (cB mygui)
onAlgoBoxChange :: MyGUI
-> IO ()
onAlgoBoxChange mygui = do
item <- comboBoxGetActive (algoBox mygui)
if item == 4
then do
widgetShow (vbox7 mygui)
widgetShow (winT mygui)
widgetShow (treeWin mygui)
else widgetHide (vbox7 mygui)
return ()
@ -198,7 +198,7 @@ onPathWidgetChange mygui = do
drawDiag :: MyGUI
-> IO ()
drawDiag mygui = do
fp <- fileChooserGetFilename (fB mygui)
fp <- fileChooserGetFilename (fileButton mygui)
case fp of
Just x -> do
ret <- saveAndDrawDiag x "" mygui
@ -213,7 +213,7 @@ drawDiag mygui = do
saveDiag :: MyGUI
-> IO ()
saveDiag mygui = do
fp <- fileChooserGetFilename (fB mygui)
fp <- fileChooserGetFilename (fileButton mygui)
case fp of
Just x -> do
ret <- saveAndDrawDiag x "out.svg" mygui
@ -233,55 +233,53 @@ saveAndDrawDiag :: FilePath -- ^ obj file to parse
saveAndDrawDiag fp fps mygui =
if cmpExt "obj" fp
then do
mesh <- readFile fp
dw <- widgetGetDrawWindow (da mygui)
dwT <- widgetGetDrawWindow (daT mygui)
adjustment <- rangeGetAdjustment (hs mygui)
scaleVal <- adjustmentGetValue adjustment
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)
(daTW, daTH) <- widgetGetSize (daT mygui)
gd' <- toggleButtonGetActive (gC mygui)
ct' <- toggleButtonGetActive (cC mygui)
pE' <- entryGetText (pE mygui)
mesh <- readFile fp
mainDrawWindow <- widgetGetDrawWindow (mainDraw mygui)
treeDrawWindow <- widgetGetDrawWindow (treeDraw mygui)
adjustment <- rangeGetAdjustment (ptScale mygui)
scaleVal <- adjustmentGetValue adjustment
xminEntryText <- entryGetText (xminEntry mygui)
xmaxEntryText <- entryGetText (xmaxEntry mygui)
yminEntryText <- entryGetText (yminEntry mygui)
ymaxEntryText <- entryGetText (ymaxEntry mygui)
algoActive <- comboBoxGetActive (algoBox mygui)
(daW, daH) <- widgetGetSize (mainDraw mygui)
(daTW, daTH) <- widgetGetSize (treeDraw mygui)
gridActive <- toggleButtonGetActive (gridCheckBox mygui)
coordTextActive <- toggleButtonGetActive (coordCheckBox mygui)
quadPathEntry' <- entryGetText (quadPathEntry mygui)
let
xD = (,) <$>
readMaybe xlD' <*>
readMaybe xuD' :: Maybe (Double, Double)
yD = (,) <$>
readMaybe ylD' <*>
readMaybe yuD' :: Maybe (Double, Double)
renderDiag winWidth winHeight buildDiag xD' yD' =
xDim = (,) <$>
readMaybe xminEntryText <*>
readMaybe xmaxEntryText :: Maybe (Double, Double)
yDim = (,) <$>
readMaybe yminEntryText <*>
readMaybe ymaxEntryText :: Maybe (Double, Double)
renderDiag winWidth winHeight buildDiag xDim' yDim' =
renderDia Cairo
(CairoOptions fps
(Dims (fromIntegral winWidth) (fromIntegral winHeight))
SVG False)
(buildDiag (def{
t = scaleVal,
dX = xD',
dY = yD',
alg = alg',
gd = gd',
ct = ct',
pQt = pE'})
dotSize = scaleVal,
xDimension = xDim',
yDimension = yDim',
algo = algoActive,
haveGrid = gridActive,
showCoordText = coordTextActive,
quadPath = quadPathEntry'})
mesh)
case (xD, yD) of
(Just xD', Just yD') -> do
let (s, r) = renderDiag daW daH diagS xD' yD'
let (_, r') = renderDiag daTW daTH diagTreeS xD' yD'
case (xDim, yDim) of
(Just xDim', Just yDim') -> do
let (s, r) = renderDiag daW daH diagS xDim' yDim'
let (_, r') = renderDiag daTW daTH diagTreeS xDim' yDim'
renderWithDrawable dw r
renderWithDrawable dwT r'
renderWithDrawable mainDrawWindow r
renderWithDrawable treeDrawWindow r'
if null fps
then return ()
else s
unless (null fps) s
return 0
_ -> return 1

14
Graphics/Diagram/Gtk.hs
View File

@ -12,22 +12,22 @@ import Parser.Meshparser
-- |Create the Diagram from the points.
diag :: DiagProp -> Object -> Diagram Cairo R2
diag p obj@(Object _)
| alg p == 0 =
| algo p == 0 =
mkDiag (mconcat [coordPointsText, coordPoints, plotterBG])
p obj
| alg p == 1 =
| algo p == 1 =
mkDiag (mconcat [convexHPText, convexHP, convexHLs, coordPoints, plotterBG])
p obj
| alg p == 4 =
| algo p == 4 =
mkDiag (mconcat [quadPathSquare, squares, coordPointsText,
coordPoints, polyLines, plotterBG])
p obj
| otherwise = mempty
diag p objs@(Objects _)
| alg p == 2 =
| algo p == 2 =
mkDiag (mconcat [polyLines, coordPointsText, coordPoints, plotterBG])
p objs
| alg p == 3 =
| algo p == 3 =
mkDiag (mconcat [polyIntersectionText, polyIntersection,
coordPoints, polyLines, plotterBG])
p objs
@ -38,7 +38,7 @@ diag p objs@(Objects _)
-- of an obj file.
diagS :: DiagProp -> MeshString -> Diagram Cairo R2
diagS p mesh
| alg p == 2 || alg p == 3 = diag p. Objects . facesToArr $ mesh
| algo p == 2 || algo p == 3 = diag p. Objects . facesToArr $ mesh
| otherwise = (diag p . Object . meshToArr $ mesh) # bg white
@ -46,5 +46,5 @@ diagS p mesh
-- of an obj file.
diagTreeS :: DiagProp -> MeshString -> Diagram Cairo R2
diagTreeS p mesh
| alg p == 4 = mkDiag treePretty p (Object . meshToArr $mesh)
| algo p == 4 = mkDiag treePretty p (Object . meshToArr $mesh)
| otherwise = mempty

88
Graphics/Diagram/Plotter.hs
View File

@ -29,7 +29,7 @@ coordPoints = Diag cp
position (zip (filterValidPT p vt)
(repeat dot))
where
dot = (circle $ t p :: Diagram Cairo R2) # fc black
dot = (circle $ dotSize p :: Diagram Cairo R2) # fc black
-- |Creates a Diagram from a point that shows the coordinates
@ -52,7 +52,7 @@ coordPointsText = Diag cpt
cpt p (Objects vts) = drawT (concat vts) p
drawT [] _ = mempty
drawT vt p
| ct p =
| showCoordText p =
position $
zip vtf (pointToTextCoord <$> vtf) # translate (r2 (0, 10))
| otherwise = mempty
@ -86,7 +86,7 @@ polyIntersection = Diag pi'
where
paF = filterValidPT p x
pbF = filterValidPT p y
dot = (circle $ t p :: Diagram Cairo R2) # fc red # lc red
dot = (circle $ dotSize p :: Diagram Cairo R2) # fc red # lc red
vtpi = intersectionPoints
. sortLexPolys
$ (sortLexPoly paF, sortLexPoly pbF)
@ -98,7 +98,7 @@ polyIntersectionText :: Diag
polyIntersectionText = Diag pit'
where
pit' p (Objects (x:y:_))
| ct p =
| showCoordText p =
position $
zip vtpi
(pointToTextCoord # fc red <$> vtpi) # translate (r2 (0, 10))
@ -120,7 +120,7 @@ convexHP = Diag chp
position (zip vtch
(repeat dot))
where
dot = (circle $ t p :: Diagram Cairo R2) # fc red # lc red
dot = (circle $ dotSize p :: Diagram Cairo R2) # fc red # lc red
vtch = grahamCH $ filterValidPT p vt
chp _ _ = mempty
@ -130,7 +130,7 @@ convexHPText :: Diag
convexHPText = Diag chpt
where
chpt p (Object vt)
| ct p =
| showCoordText p =
position $
zip vtchf
(pointToTextCoord <$> vtchf) # translate (r2 (0, 10))
@ -182,7 +182,7 @@ squares = Diag f
mconcat
$ (\((xmin', xmax'), (ymin', ymax')) -> rect (xmax' - xmin') (ymax' - ymin')
# moveTo (p2 ((xmax' + xmin') / 2, (ymax' + ymin') / 2)) # lw ultraThin)
<$> (quadTreeSquares (dX p, dY p) . quadTree vtf $ (dX p, dY p))
<$> (quadTreeSquares (xDimension p, yDimension p) . quadTree vtf $ (xDimension p, yDimension p))
where
vtf = filterValidPT p vt
f _ _ = mempty
@ -191,11 +191,11 @@ squares = Diag f
-- |Get the quad tree corresponding to the given points and diagram properties.
qt :: [PT] -> DiagProp -> QuadTree PT
qt vt p = quadTree (filterValidPT p vt) (dX p, dY p)
qt vt p = quadTree (filterValidPT p vt) (xDimension p, yDimension p)
-- |Create a diagram that shows a single square of the RangeSearch algorithm
-- from the quad tree in red, according to the given path in pQt.
-- from the quad tree in red, according to the given path in quadPath.
quadPathSquare :: Diag
quadPathSquare = Diag f
where
@ -203,10 +203,10 @@ quadPathSquare = Diag f
f p (Object vt) =
(\((xmin', xmax'), (ymin', ymax')) -> rect (xmax' - xmin') (ymax' - ymin')
# moveTo (p2 ((xmax' + xmin') / 2,(ymax' + ymin') / 2)) # lw thin # lc red)
(getSquare (stringToQuads (pQt p)) (qt vt p, []))
(getSquare (stringToQuads (quadPath p)) (qt vt p, []))
where
getSquare :: [Either Quad Orient] -> Zipper PT -> Square
getSquare [] z = getSquareByZipper (dX p, dY p) z
getSquare [] z = getSquareByZipper (xDimension p, yDimension p) z
getSquare (q:qs) z = case q of
Right x -> getSquare qs (fromMaybe z (findNeighbor x z))
Left x -> getSquare qs (fromMaybe z (goQuad x z))
@ -221,14 +221,14 @@ gifQuadPath = GifDiag f
f p col _ vt =
(\((xmin', xmax'), (ymin', ymax')) -> rect (xmax' - xmin') (ymax' - ymin')
# moveTo (p2 ((xmax' + xmin') / 2,(ymax' + ymin') / 2)) # lw thick # lc col)
<$> getSquares (stringToQuads (pQt p)) (qt vt p, [])
<$> getSquares (stringToQuads (quadPath p)) (qt vt p, [])
where
getSquares :: [Either Quad Orient] -> Zipper PT -> [Square]
getSquares [] z = [getSquareByZipper (dX p, dY p) z]
getSquares [] z = [getSquareByZipper (xDimension p, yDimension p) z]
getSquares (q:qs) z = case q of
Right x -> getSquareByZipper (dX p, dY p) z :
Right x -> getSquareByZipper (xDimension p, yDimension p) z :
getSquares qs (fromMaybe z (findNeighbor x z))
Left x -> getSquareByZipper (dX p, dY p) z :
Left x -> getSquareByZipper (xDimension p, yDimension p) z :
getSquares qs (fromMaybe z (goQuad x z))
@ -238,7 +238,7 @@ treePretty = Diag f
where
f _ (Object []) = mempty
f p (Object vt) =
prettyRoseTree (quadTreeToRoseTree . flip getCurQT (qt vt p, []) . stringToQuads . pQt $ p)
prettyRoseTree (quadTreeToRoseTree . flip getCurQT (qt vt p, []) . stringToQuads . quadPath $ p)
where
getCurQT :: [Either Quad Orient] -> Zipper PT -> Zipper PT
getCurQT [] z = z
@ -269,23 +269,23 @@ xAxis =
Diag labels
where
hRule p _ =
arrowAt (p2 (xmin p, if ymin p <= 0 then 0 else ymin p))
(r2 (w' p, 0))
arrowAt (p2 (diagXmin p, if diagYmin p <= 0 then 0 else diagYmin p))
(r2 (diagWidth p, 0))
segments p _ =
hcat' (with & sep .~ sqS p)
(replicate (floor . (/) (w' p) $ sqS p)
hcat' (with & sep .~ squareSize p)
(replicate (floor . (/) (diagWidth p) $ squareSize p)
(vrule 10)) #
moveTo (p2 (xmin p, if ymin p <= 0 then 0 else ymin p))
moveTo (p2 (diagXmin p, if diagYmin p <= 0 then 0 else diagYmin p))
labels p _ =
position $
zip (mkPoint <$> xs)
((\x -> (text . show $ x) # scale 10) <$> xs)
where
xs :: [Int]
xs = take (floor . (/) (w' p) $ sqS p)
(iterate (+(floor . sqS $ p)) (floor . xmin $ p))
xs = take (floor . (/) (diagWidth p) $ squareSize p)
(iterate (+(floor . squareSize $ p)) (floor . diagXmin $ p))
mkPoint x = p2 (fromIntegral x,
-15 + (if ymin p <= 0 then 0 else ymin p))
-15 + (if diagYmin p <= 0 then 0 else diagYmin p))
-- |Creates a Diagram that shows an YAxis which is bound
@ -297,23 +297,23 @@ yAxis =
Diag labels
where
vRule p _ =
arrowAt (p2 (if xmin p <= 0 then 0 else xmin p, ymin p))
(r2 (0, h' p))
arrowAt (p2 (if diagXmin p <= 0 then 0 else diagXmin p, diagYmin p))
(r2 (0, diagHeight p))
segments p _ =
vcat' (with & sep .~ sqS p)
(replicate (floor . (/) (h' p) $ sqS p)
vcat' (with & sep .~ squareSize p)
(replicate (floor . (/) (diagHeight p) $ squareSize p)
(hrule 10)) #
alignB #
moveTo (p2 (if xmin p <= 0 then 0 else xmin p, ymin p))
moveTo (p2 (if diagXmin p <= 0 then 0 else diagXmin p, diagYmin p))
labels p _ =
position $
zip (mkPoint <$> ys)
((\x -> (text . show $ x) # scale 10) <$> ys)
where
ys :: [Int]
ys = take (floor . (/) (h' p) $ sqS p)
(iterate (+(floor . sqS $ p)) (floor . ymin $ p))
mkPoint y = p2 (-15 + (if xmin p <= 0 then 0 else xmin p),
ys = take (floor . (/) (diagHeight p) $ squareSize p)
(iterate (+(floor . squareSize $ p)) (floor . diagYmin $ p))
mkPoint y = p2 (-15 + (if diagXmin p <= 0 then 0 else diagXmin p),
fromIntegral y)
@ -323,8 +323,8 @@ whiteRectB :: Diag
whiteRectB = Diag rect'
where
rect' p _ =
whiteRect (w' p + (w' p / 10)) (h' p + (h' p / 10)) #
moveTo (p2 (wOff p, hOff p))
whiteRect (diagWidth p + (diagWidth p / 10)) (diagHeight p + (diagHeight p / 10)) #
moveTo (p2 (diagWidthOffset p, diagHeightOffset p))
where
@ -339,20 +339,20 @@ grid :: Diag
grid = Diag xGrid <> Diag yGrid
where
yGrid p _
| gd p =
hcat' (with & sep .~ sqS p)
(replicate (floor . (/) (w' p) $ sqS p)
(vrule $ h' p)) #
moveTo (p2 (xmin p, hOff p)) #
| haveGrid p =
hcat' (with & sep .~ squareSize p)
(replicate (floor . (/) (diagWidth p) $ squareSize p)
(vrule $ diagHeight p)) #
moveTo (p2 (diagXmin p, diagHeightOffset p)) #
lw ultraThin
| otherwise = mempty
xGrid p _
| gd p =
vcat' (with & sep .~ sqS p)
(replicate (floor . (/) (h' p) $ sqS p)
(hrule $ w' p)) #
| haveGrid p =
vcat' (with & sep .~ squareSize p)
(replicate (floor . (/) (diagHeight p) $ squareSize p)
(hrule $ diagWidth p)) #
alignB #
moveTo (p2 (wOff p, ymin p)) #
moveTo (p2 (diagWidthOffset p, diagYmin p)) #
lw ultraThin
| otherwise = mempty

56
Graphics/Diagram/Types.hs
View File

@ -41,26 +41,26 @@ data Object = Object [PT]
-- This can also be seen as a context when merging multiple diagrams.
data DiagProp = MkProp {
-- |The thickness of the dots.
t :: Double,
dotSize :: Double,
-- |The dimensions of the x-axis.
dX :: Coord,
xDimension :: Coord,
-- |The dimensions of the y-axis.
dY :: Coord,
yDimension :: Coord,
-- |Algorithm to use.
alg :: Int,
algo :: Int,
-- |If we want to show the grid.
gd :: Bool,
haveGrid :: Bool,
-- |If we want to show the coordinates as text.
ct :: Bool,
showCoordText :: Bool,
-- |Square size used to show the grid and x/y-axis.
sqS :: Double,
squareSize :: Double,
-- |The path to a quad in the quad tree.
pQt :: String
quadPath :: String
}
instance Def DiagProp where
def = defaultProp
def = diagDefaultProp
instance Monoid Diag where
@ -84,50 +84,50 @@ instance Monoid Diag where
-- |The default properties of the Diagram.
defaultProp :: DiagProp
defaultProp = MkProp 2 (0,500) (0,500) 0 False False 50 ""
diagDefaultProp :: DiagProp
diagDefaultProp = MkProp 2 (0,500) (0,500) 0 False False 50 ""
-- |Extract the lower bound of the x-axis dimension.
xmin :: DiagProp -> Double
xmin = fst . dX
diagXmin :: DiagProp -> Double
diagXmin = fst . xDimension
-- |Extract the upper bound of the x-axis dimension.
xmax :: DiagProp -> Double
xmax = snd . dX
diagXmax :: DiagProp -> Double
diagXmax = snd . xDimension
-- |Extract the lower bound of the y-axis dimension.
ymin :: DiagProp -> Double
ymin = fst . dY
diagYmin :: DiagProp -> Double
diagYmin = fst . yDimension
-- |Extract the upper bound of the y-axis dimension.
ymax :: DiagProp -> Double
ymax = snd . dY
diagYmax :: DiagProp -> Double
diagYmax = snd . yDimension
-- |The full width of the x dimension.
w' :: DiagProp -> Double
w' p = xmax p - xmin p
diagWidth :: DiagProp -> Double
diagWidth p = diagXmax p - diagXmin p
-- |The full height of the y dimension.
h' :: DiagProp -> Double
h' p = ymax p - ymin p
diagHeight :: DiagProp -> Double
diagHeight p = diagYmax p - diagYmin p
-- |The offset on the x-axis to move the grid and the white rectangle
-- to the right place.
wOff :: DiagProp -> Double
wOff p = xmin p + (w' p / 2)
diagWidthOffset :: DiagProp -> Double
diagWidthOffset p = diagXmin p + (diagWidth p / 2)
-- |The offset on the y-axis to move the grid and the white rectangle
-- to the right place.
hOff :: DiagProp -> Double
hOff p = ymin p + (h' p / 2)
diagHeightOffset :: DiagProp -> Double
diagHeightOffset p = diagYmin p + (diagWidth p / 2)
-- |Returns the specified diagram if True is passed,
@ -140,4 +140,4 @@ maybeDiag b d
filterValidPT :: DiagProp -> [PT] -> [PT]
filterValidPT p = filter (inRange (dX p, dY p))
filterValidPT p = filter (inRange (xDimension p, yDimension p))