diff --git a/Diagram.hs b/Diagram.hs index 8bbcfb2..d2dd393 100644 --- a/Diagram.hs +++ b/Diagram.hs @@ -5,6 +5,7 @@ module Diagram (t, dY, alg, gd, + ct, defaultProp, diag, diagS, @@ -47,6 +48,8 @@ data DiagProp = MkProp { alg :: Int, -- |If we want to show the grid. gd :: Bool, + -- |If we want to show the coordinates as text. + ct :: Bool, -- |Square size used to show the grid and x/y-axis. sqS :: Double } @@ -66,7 +69,7 @@ instance Monoid Diag where -- |The default properties of the Diagram. defaultProp :: DiagProp -defaultProp = MkProp 2 (0,500) (0,500) 0 False 50 +defaultProp = MkProp 2 (0,500) (0,500) 0 False False 50 -- |Extract the lower bound of the x-axis dimension. @@ -102,6 +105,19 @@ coordPoints = Diag cp dot = (circle $ t p :: Diagram Cairo R2) # fc black +coordPointsText :: Diag +coordPointsText = Diag cpt + where + cpt _ vt = + position $ + zip vt + ((\(x, y) -> (flip (<>) (square 1 # lw none) . + text $ ("(" ++ show x ++ ", " ++ show y ++ ")")) # + scale 10 # translate (r2 (0, 10))) <$> + unp2 <$> + vt) + + -- |Create a diagram which shows the points of the convex hull. convexHullPoints :: Diag convexHullPoints = Diag chp @@ -114,6 +130,22 @@ convexHullPoints = Diag chp vtch = grahamGetCH vt +-- |Create a diagram which shows the points of the convex hull. +convexHullPointsText :: Diag +convexHullPointsText = Diag chpt + where + chpt _ vt = + position $ + zip vtch + ((\(x, y) -> (flip (<>) (square 1 # lw none) . + text $ ("(" ++ show x ++ ", " ++ show y ++ ")")) # + scale 10 # translate (r2 (0, 10))) <$> + unp2 <$> + vtch) + where + vtch = grahamGetCH vt + + -- |Create a diagram which shows the lines along the convex hull -- points. convexHullLines :: Diag @@ -220,14 +252,17 @@ diag :: DiagProp -> [PT] -> Diagram Cairo R2 diag p = case alg p of 0 -> mkDiag - (mconcat [coordPoints, xAxis, yAxis, - (if gd p then grid else mempty), whiteRectB]) + (mconcat [if ct p then coordPointsText else mempty, + coordPoints, xAxis, yAxis, + (if gd p then grid else mempty),whiteRectB]) p 1 -> mkDiag (mconcat - [convexHullPoints, convexHullLines, coordPoints, - xAxis, yAxis, (if gd p then grid else mempty), whiteRectB]) + [if ct p then convexHullPointsText else mempty, + convexHullPoints, convexHullLines, + coordPoints, xAxis, yAxis, + (if gd p then grid else mempty), whiteRectB]) p _ -> mempty diff --git a/Gtk.hs b/Gtk.hs index 58ac983..617da7b 100644 --- a/Gtk.hs +++ b/Gtk.hs @@ -15,6 +15,7 @@ import System.Directory import Text.Read import OS.FileExt + -- |Monolithic object passed to various GUI functions in order -- to keep the API stable and not alter the parameters too much. -- This only holds GUI widgets that are needed to be read during @@ -47,7 +48,9 @@ data MyGUI = MkMyGUI { -- |combo box for choosing the algorithm cB :: ComboBox, -- |grid check button - gC :: CheckButton + gC :: CheckButton, + -- |coord check button + cC :: CheckButton } @@ -76,13 +79,14 @@ makeMyGladeGUI = do aD' <- xmlGetWidget xml castToAboutDialog "aboutdialog" cB' <- xmlGetWidget xml castToComboBox "comboalgo" gC' <- xmlGetWidget xml castToCheckButton "gridcheckbutton" + cC' <- xmlGetWidget xml castToCheckButton "coordcheckbutton" return $ MkMyGUI win' dB' sB' qB' fB' da' hs' - xl' xu' yl' yu' aD' cB' gC' + xl' xu' yl' yu' aD' cB' gC' cC' gifCLI :: FilePath -> IO () -gifCLI startFile = do +gifCLI _ = do mesh <- readFile "UB1_sonderfaelle.obj" gifMain (gifDiagS def mesh) @@ -206,6 +210,7 @@ drawDiag' fp mygui = alg' <- comboBoxGetActive (cB mygui) (daW, daH) <- widgetGetSize (da mygui) gd' <- toggleButtonGetActive (gC mygui) + ct' <- toggleButtonGetActive (cC mygui) let xD = (,) <$> @@ -226,7 +231,8 @@ drawDiag' fp mygui = dX = xD', dY = yD', alg = alg', - gd = gd'}) + gd = gd', + ct = ct'}) mesh) renderWithDrawable dw r return 0 @@ -252,6 +258,7 @@ saveDiag' fp mygui = alg' <- comboBoxGetActive (cB mygui) (daW, daH) <- widgetGetSize (da mygui) gd' <- toggleButtonGetActive (gC mygui) + ct' <- toggleButtonGetActive (cC mygui) let xD = (,) <$> @@ -269,7 +276,8 @@ saveDiag' fp mygui = dX = xD', dY = yD', alg = alg', - gd = gd'}) + gd = gd', + ct = ct'}) mesh) return 0 _ -> return 1 diff --git a/gtk2.glade b/gtk2.glade index 031534d..6607468 100644 --- a/gtk2.glade +++ b/gtk2.glade @@ -692,8 +692,7 @@ Malte Flender <malte.flender@fh-bielefeld.de> - - 100 + True False @@ -709,23 +708,48 @@ Malte Flender <malte.flender@fh-bielefeld.de> - - grid + True - True - False - True + False + + + grid + True + True + False + True + + + False + False + 0 + + + + + coord + True + True + False + True + + + True + True + 1 + + - False - False + True + True 1 False - True + False 3