From 3f3467cc44ba29ffac331f988c2b63d3c9cb7706 Mon Sep 17 00:00:00 2001 From: hasufell Date: Sun, 16 Nov 2014 00:10:57 +0100 Subject: [PATCH] Refactor some function names for readability --- GUI/Gtk.hs | 176 ++++++++++++++++++------------------ Graphics/Diagram/Gtk.hs | 14 +-- Graphics/Diagram/Plotter.hs | 88 +++++++++--------- Graphics/Diagram/Types.hs | 56 ++++++------ 4 files changed, 166 insertions(+), 168 deletions(-) diff --git a/GUI/Gtk.hs b/GUI/Gtk.hs index 8e49e79..0d8c090 100644 --- a/GUI/Gtk.hs +++ b/GUI/Gtk.hs @@ -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 diff --git a/Graphics/Diagram/Gtk.hs b/Graphics/Diagram/Gtk.hs index 14b74e5..f349caf 100644 --- a/Graphics/Diagram/Gtk.hs +++ b/Graphics/Diagram/Gtk.hs @@ -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 diff --git a/Graphics/Diagram/Plotter.hs b/Graphics/Diagram/Plotter.hs index 2ffc1e7..0e4a62d 100644 --- a/Graphics/Diagram/Plotter.hs +++ b/Graphics/Diagram/Plotter.hs @@ -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 diff --git a/Graphics/Diagram/Types.hs b/Graphics/Diagram/Types.hs index 7d529fd..3c5bf9b 100644 --- a/Graphics/Diagram/Types.hs +++ b/Graphics/Diagram/Types.hs @@ -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))